Commit | Line | Data |
---|---|---|
fb7933a3 KG |
1 | ;;; tramp-vc.el --- Version control integration for TRAMP.el |
2 | ||
5fd6d89f | 3 | ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, |
d7a0267c | 4 | ;; 2005, 2006, 2007 Free Software Foundation, Inc. |
fb7933a3 KG |
5 | |
6 | ;; Author: Daniel Pittman <daniel@danann.net> | |
7 | ;; Keywords: comm, processes | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
ceaeecb0 | 13 | ;; the Free Software Foundation; either version 3, or (at your option) |
fb7933a3 KG |
14 | ;; any later version. |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
3a35cf56 LK |
23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 | ;; Boston, MA 02110-1301, USA. | |
fb7933a3 KG |
25 | |
26 | ;;; Commentary: | |
27 | ||
28 | ;; See the main module, 'tramp.el' for discussion of the purpose of TRAMP. | |
29 | ;; This module provides integration between remote files accessed by TRAMP and | |
30 | ;; the Emacs version control system. | |
31 | ||
32 | ;;; Code: | |
33 | ||
fb7933a3 KG |
34 | (require 'vc) |
35 | ;; Old VC defines vc-rcs-release in vc.el, new VC requires extra module. | |
36 | (unless (boundp 'vc-rcs-release) | |
37 | (require 'vc-rcs)) | |
38 | (require 'tramp) | |
39 | ||
38c65fca KG |
40 | ;; Avoid byte-compiler warnings if the byte-compiler supports this. |
41 | ;; Currently, XEmacs supports this. | |
42 | (eval-when-compile | |
43 | (when (fboundp 'byte-compiler-options) | |
44 | (let (unused-vars) ; Pacify Emacs byte-compiler | |
45 | (defalias 'warnings 'identity) ; Pacify Emacs byte-compiler | |
46 | (byte-compiler-options (warnings (- unused-vars)))))) | |
47 | ||
fb7933a3 KG |
48 | ;; -- vc -- |
49 | ||
50 | ;; This used to blow away the file-name-handler-alist and reinstall | |
51 | ;; TRAMP into it. This was intended to let VC work remotely. It didn't, | |
52 | ;; at least not in my XEmacs 21.2 install. | |
bf247b6e | 53 | ;; |
fb7933a3 KG |
54 | ;; In any case, tramp-run-real-handler now deals correctly with disabling |
55 | ;; the things that should be, making this a no-op. | |
56 | ;; | |
57 | ;; I have removed it from the tramp-file-name-handler-alist because the | |
58 | ;; shortened version does nothing. This is for reference only now. | |
59 | ;; | |
60 | ;; Daniel Pittman <daniel@danann.net> | |
61 | ;; | |
62 | ;; (defun tramp-handle-vc-registered (file) | |
63 | ;; "Like `vc-registered' for tramp files." | |
64 | ;; (tramp-run-real-handler 'vc-registered (list file))) | |
65 | ||
66 | ;; `vc-do-command' | |
67 | ;; This function does not deal well with remote files, so we define | |
68 | ;; our own version and make a backup of the original function and | |
69 | ;; call our version for tramp files and the original version for | |
70 | ;; normal files. | |
71 | ||
72 | ;; The following function is pretty much copied from vc.el, but | |
73 | ;; the part that actually executes a command is changed. | |
74 | ;; CCC: this probably works for Emacs 21, too. | |
75 | (defun tramp-vc-do-command (buffer okstatus command file last &rest flags) | |
76 | "Like `vc-do-command' but invoked for tramp files. | |
77 | See `vc-do-command' for more information." | |
78 | (save-match-data | |
07dfe738 | 79 | (and file (setq file (expand-file-name file))) |
fb7933a3 KG |
80 | (if (not buffer) (setq buffer "*vc*")) |
81 | (if vc-command-messages | |
82 | (message "Running `%s' on `%s'..." command file)) | |
83 | (let ((obuf (current-buffer)) (camefrom (current-buffer)) | |
84 | (squeezed nil) | |
85 | (olddir default-directory) | |
86 | vc-file status) | |
07dfe738 | 87 | (let* ((v (tramp-dissect-file-name (expand-file-name file))) |
fb7933a3 KG |
88 | (multi-method (tramp-file-name-multi-method v)) |
89 | (method (tramp-file-name-method v)) | |
90 | (user (tramp-file-name-user v)) | |
91 | (host (tramp-file-name-host v)) | |
7432277c | 92 | (localname (tramp-file-name-localname v))) |
fb7933a3 KG |
93 | (set-buffer (get-buffer-create buffer)) |
94 | (set (make-local-variable 'vc-parent-buffer) camefrom) | |
95 | (set (make-local-variable 'vc-parent-buffer-name) | |
96 | (concat " from " (buffer-name camefrom))) | |
97 | (setq default-directory olddir) | |
bf247b6e | 98 | |
fb7933a3 KG |
99 | (erase-buffer) |
100 | ||
101 | (mapcar | |
102 | (function | |
103 | (lambda (s) (and s (setq squeezed (append squeezed (list s)))))) | |
104 | flags) | |
105 | (if (and (eq last 'MASTER) file | |
106 | (setq vc-file (vc-name file))) | |
107 | (setq squeezed | |
108 | (append squeezed | |
7432277c | 109 | (list (tramp-file-name-localname |
fb7933a3 KG |
110 | (tramp-dissect-file-name vc-file)))))) |
111 | (if (and file (eq last 'WORKFILE)) | |
112 | (progn | |
113 | (let* ((pwd (expand-file-name default-directory)) | |
114 | (preflen (length pwd))) | |
115 | (if (string= (substring file 0 preflen) pwd) | |
116 | (setq file (substring file preflen)))) | |
117 | (setq squeezed (append squeezed (list file))))) | |
118 | ;; Unless we (save-window-excursion) the layout of windows in | |
119 | ;; the current frame changes. This is painful, at best. | |
120 | ;; | |
121 | ;; As a point of note, (save-excursion) is still here only because | |
122 | ;; it preserves (point) in the current buffer. (save-window-excursion) | |
123 | ;; does not, at least under XEmacs 21.2. | |
124 | ;; | |
125 | ;; I trust that the FSF support this as well. I can't find useful | |
126 | ;; documentation to check :( | |
127 | ;; | |
128 | ;; Daniel Pittman <daniel@danann.net> | |
129 | (save-excursion | |
130 | (save-window-excursion | |
131 | ;; Actually execute remote command | |
01917a18 MA |
132 | ;; `shell-command' cannot be used; it isn't magic in XEmacs. |
133 | (tramp-handle-shell-command | |
fb7933a3 KG |
134 | (mapconcat 'tramp-shell-quote-argument |
135 | (cons command squeezed) " ") t) | |
136 | ;;(tramp-wait-for-output) | |
137 | ;; Get status from command | |
138 | (tramp-send-command multi-method method user host "echo $?") | |
139 | (tramp-wait-for-output) | |
140 | ;; Make sure to get status from last line of output. | |
141 | (goto-char (point-max)) (forward-line -1) | |
142 | (setq status (read (current-buffer))) | |
143 | (message "Command %s returned status %d." command status))) | |
144 | (goto-char (point-max)) | |
145 | (set-buffer-modified-p nil) | |
146 | (forward-line -1) | |
4007ba5b KG |
147 | (if (or (not (integerp status)) |
148 | (and (integerp okstatus) (< okstatus status))) | |
fb7933a3 KG |
149 | (progn |
150 | (pop-to-buffer buffer) | |
151 | (goto-char (point-min)) | |
152 | (shrink-window-if-larger-than-buffer) | |
153 | (error "Running `%s'...FAILED (%s)" command | |
154 | (if (integerp status) | |
155 | (format "status %d" status) | |
156 | status)) | |
157 | ) | |
158 | (if vc-command-messages | |
159 | (message "Running %s...OK" command)) | |
160 | ) | |
161 | (set-buffer obuf) | |
162 | status)) | |
163 | )) | |
164 | ||
165 | ;; Following code snarfed from Emacs 21 vc.el and slightly tweaked. | |
166 | (defun tramp-vc-do-command-new (buffer okstatus command file &rest flags) | |
167 | "Like `vc-do-command' but for TRAMP files. | |
168 | This function is for the new VC which comes with Emacs 21. | |
169 | Since TRAMP doesn't do async commands yet, this function doesn't, either." | |
170 | (and file (setq file (expand-file-name file))) | |
171 | (if vc-command-messages | |
172 | (message "Running %s on %s..." command file)) | |
173 | (save-current-buffer | |
38c65fca KG |
174 | (unless (eq buffer t) |
175 | ; Pacify byte-compiler | |
176 | (funcall (symbol-function 'vc-setup-buffer) buffer)) | |
fb7933a3 KG |
177 | (let ((squeezed nil) |
178 | (inhibit-read-only t) | |
179 | (status 0)) | |
180 | (let* ((v (when file (tramp-dissect-file-name file))) | |
181 | (multi-method (when file (tramp-file-name-multi-method v))) | |
182 | (method (when file (tramp-file-name-method v))) | |
183 | (user (when file (tramp-file-name-user v))) | |
184 | (host (when file (tramp-file-name-host v))) | |
7432277c | 185 | (localname (when file (tramp-file-name-localname v)))) |
fb7933a3 KG |
186 | (setq squeezed (delq nil (copy-sequence flags))) |
187 | (when file | |
4007ba5b KG |
188 | (setq squeezed (append squeezed (list (file-relative-name |
189 | file default-directory))))) | |
fb7933a3 KG |
190 | (let ((w32-quote-process-args t)) |
191 | (when (eq okstatus 'async) | |
192 | (message "Tramp doesn't do async commands, running synchronously.")) | |
01917a18 MA |
193 | ;; `shell-command' cannot be used; it isn't magic in XEmacs. |
194 | (setq status (tramp-handle-shell-command | |
fb7933a3 KG |
195 | (mapconcat 'tramp-shell-quote-argument |
196 | (cons command squeezed) " ") t)) | |
4007ba5b KG |
197 | (when (or (not (integerp status)) |
198 | (and (integerp okstatus) (< okstatus status))) | |
fb7933a3 KG |
199 | (pop-to-buffer (current-buffer)) |
200 | (goto-char (point-min)) | |
201 | (shrink-window-if-larger-than-buffer) | |
202 | (error "Running %s...FAILED (%s)" command | |
203 | (if (integerp status) (format "status %d" status) status)))) | |
204 | (if vc-command-messages | |
205 | (message "Running %s...OK" command)) | |
38c65fca KG |
206 | ; Pacify byte-compiler |
207 | (funcall (symbol-function 'vc-exec-after) | |
208 | `(run-hook-with-args | |
209 | 'vc-post-command-functions ',command ',localname ',flags)) | |
fb7933a3 KG |
210 | status)))) |
211 | ||
212 | ||
213 | ;; The context for a VC command is the current buffer. | |
214 | ;; That makes a test on the buffers file more reliable than a test on the | |
215 | ;; arguments. | |
216 | ;; This is needed to handle remote VC correctly - else we test against the | |
217 | ;; local VC system and get things wrong... | |
218 | ;; Daniel Pittman <daniel@danann.net> | |
219 | ;;-(if (fboundp 'vc-call-backend) | |
220 | ;;- () ;; This is the new VC for which we don't have an appropriate advice yet | |
a69c01a0 | 221 | ;;-) |
0457dd55 | 222 | (unless (fboundp 'process-file) |
a69c01a0 MA |
223 | (if (fboundp 'vc-call-backend) |
224 | (defadvice vc-do-command | |
225 | (around tramp-advice-vc-do-command | |
226 | (buffer okstatus command file &rest flags) | |
227 | activate) | |
228 | "Invoke tramp-vc-do-command for tramp files." | |
229 | (let ((file (symbol-value 'file))) ;pacify byte-compiler | |
230 | (if (or (and (stringp file) (tramp-tramp-file-p file)) | |
231 | (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name)))) | |
232 | (setq ad-return-value | |
233 | (apply 'tramp-vc-do-command-new buffer okstatus command | |
234 | file ;(or file (buffer-file-name)) | |
235 | flags)) | |
236 | ad-do-it))) | |
fb7933a3 KG |
237 | (defadvice vc-do-command |
238 | (around tramp-advice-vc-do-command | |
a69c01a0 MA |
239 | (buffer okstatus command file last &rest flags) |
240 | activate) | |
fb7933a3 | 241 | "Invoke tramp-vc-do-command for tramp files." |
a69c01a0 MA |
242 | (let ((file (symbol-value 'file))) ;pacify byte-compiler |
243 | (if (or (and (stringp file) (tramp-tramp-file-p file)) | |
244 | (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name)))) | |
245 | (setq ad-return-value | |
246 | (apply 'tramp-vc-do-command buffer okstatus command | |
247 | (or file (buffer-file-name)) last flags)) | |
248 | ad-do-it)))) | |
249 | ||
250 | (add-hook 'tramp-unload-hook | |
251 | '(lambda () (ad-unadvise 'vc-do-command)))) | |
fb7933a3 KG |
252 | |
253 | ||
254 | ;; XEmacs uses this to do some of its work. Like vc-do-command, we | |
255 | ;; need to enhance it to make VC work via TRAMP-mode. | |
256 | ;; | |
257 | ;; Like the previous function, this is a cut-and-paste job from the VC | |
258 | ;; file. It's based on the vc-do-command code. | |
259 | ;; CCC: this isn't used in Emacs 21, so do as before. | |
260 | (defun tramp-vc-simple-command (okstatus command file &rest args) | |
261 | ;; Simple version of vc-do-command, for use in vc-hooks only. | |
262 | ;; Don't switch to the *vc-info* buffer before running the | |
263 | ;; command, because that would change its default directory | |
264 | (save-match-data | |
07dfe738 | 265 | (let* ((v (tramp-dissect-file-name (expand-file-name file))) |
fb7933a3 KG |
266 | (multi-method (tramp-file-name-multi-method v)) |
267 | (method (tramp-file-name-method v)) | |
268 | (user (tramp-file-name-user v)) | |
269 | (host (tramp-file-name-host v)) | |
7432277c | 270 | (localname (tramp-file-name-localname v))) |
fb7933a3 KG |
271 | (save-excursion (set-buffer (get-buffer-create "*vc-info*")) |
272 | (erase-buffer)) | |
273 | (let ((exec-path (append vc-path exec-path)) exec-status | |
274 | ;; Add vc-path to PATH for the execution of this command. | |
275 | (process-environment | |
276 | (cons (concat "PATH=" (getenv "PATH") | |
277 | path-separator | |
278 | (mapconcat 'identity vc-path path-separator)) | |
279 | process-environment))) | |
280 | ;; Call the actual process. See tramp-vc-do-command for discussion of | |
281 | ;; why this does both (save-window-excursion) and (save-excursion). | |
282 | ;; | |
283 | ;; As a note, I don't think that the process-environment stuff above | |
284 | ;; has any effect on the remote system. This is a hard one though as | |
285 | ;; there is no real reason to expect local and remote paths to be | |
286 | ;; identical... | |
287 | ;; | |
288 | ;; Daniel Pittman <daniel@danann.net> | |
289 | (save-excursion | |
290 | (save-window-excursion | |
291 | ;; Actually execute remote command | |
01917a18 MA |
292 | ;; `shell-command' cannot be used; it isn't magic in XEmacs. |
293 | (tramp-handle-shell-command | |
fb7933a3 | 294 | (mapconcat 'tramp-shell-quote-argument |
7432277c | 295 | (append (list command) args (list localname)) " ") |
fb7933a3 KG |
296 | (get-buffer-create"*vc-info*")) |
297 | ;(tramp-wait-for-output) | |
298 | ;; Get status from command | |
299 | (tramp-send-command multi-method method user host "echo $?") | |
300 | (tramp-wait-for-output) | |
301 | (setq exec-status (read (current-buffer))) | |
302 | (message "Command %s returned status %d." command exec-status))) | |
bf247b6e | 303 | |
4007ba5b KG |
304 | ;; Maybe okstatus can be `async' here. But then, maybe the |
305 | ;; async thing is new in Emacs 21, but this function is only | |
306 | ;; used in Emacs 20. | |
fb7933a3 KG |
307 | (cond ((> exec-status okstatus) |
308 | (switch-to-buffer (get-file-buffer file)) | |
309 | (shrink-window-if-larger-than-buffer | |
310 | (display-buffer "*vc-info*")) | |
311 | (error "Couldn't find version control information"))) | |
312 | exec-status)))) | |
313 | ||
314 | ;; This function does not exist any more in Emacs-21's VC | |
315 | (defadvice vc-simple-command | |
316 | (around tramp-advice-vc-simple-command | |
317 | (okstatus command file &rest args) | |
318 | activate) | |
319 | "Invoke tramp-vc-simple-command for tramp files." | |
320 | (let ((file (symbol-value 'file))) ;pacify byte-compiler | |
321 | (if (or (and (stringp file) (tramp-tramp-file-p file)) | |
322 | (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name)))) | |
323 | (setq ad-return-value | |
bf247b6e | 324 | (apply 'tramp-vc-simple-command okstatus command |
fb7933a3 KG |
325 | (or file (buffer-file-name)) args)) |
326 | ad-do-it))) | |
327 | ||
a69c01a0 MA |
328 | (add-hook 'tramp-unload-hook |
329 | '(lambda () (ad-unadvise 'vc-simple-command))) | |
330 | ||
fb7933a3 KG |
331 | |
332 | ;; `vc-workfile-unchanged-p' | |
333 | ;; This function does not deal well with remote files, so we do the | |
334 | ;; same as for `vc-do-command'. | |
335 | ||
336 | ;; `vc-workfile-unchanged-p' checks the modification time, we cannot | |
337 | ;; do that for remote files, so here's a version which relies on diff. | |
338 | ;; CCC: this one probably works for Emacs 21, too. | |
339 | (defun tramp-vc-workfile-unchanged-p | |
340 | (filename &optional want-differences-if-changed) | |
341 | (if (fboundp 'vc-backend-diff) | |
342 | ;; Old VC. Call `vc-backend-diff'. | |
343 | (let ((status (funcall (symbol-function 'vc-backend-diff) | |
344 | filename nil nil | |
345 | (not want-differences-if-changed)))) | |
346 | (zerop status)) | |
347 | ;; New VC. Call `vc-default-workfile-unchanged-p'. | |
38c65fca KG |
348 | (funcall (symbol-function 'vc-default-workfile-unchanged-p) |
349 | (vc-backend filename) filename))) | |
fb7933a3 KG |
350 | |
351 | (defadvice vc-workfile-unchanged-p | |
352 | (around tramp-advice-vc-workfile-unchanged-p | |
353 | (filename &optional want-differences-if-changed) | |
354 | activate) | |
355 | "Invoke tramp-vc-workfile-unchanged-p for tramp files." | |
356 | (if (and (stringp filename) | |
357 | (tramp-tramp-file-p filename) | |
358 | (not | |
359 | (let ((v (tramp-dissect-file-name filename))) | |
90f8dc03 KG |
360 | ;; The following check is probably to test whether |
361 | ;; file-attributes returns correct last modification | |
362 | ;; times. This check needs to be changed. | |
fb7933a3 KG |
363 | (tramp-get-remote-perl (tramp-file-name-multi-method v) |
364 | (tramp-file-name-method v) | |
365 | (tramp-file-name-user v) | |
366 | (tramp-file-name-host v))))) | |
367 | (setq ad-return-value | |
368 | (tramp-vc-workfile-unchanged-p filename want-differences-if-changed)) | |
369 | ad-do-it)) | |
370 | ||
a69c01a0 MA |
371 | (add-hook 'tramp-unload-hook |
372 | '(lambda () (ad-unadvise 'vc-workfile-unchanged-p))) | |
373 | ||
fb7933a3 KG |
374 | |
375 | ;; Redefine a function from vc.el -- allow tramp files. | |
376 | ;; `save-match-data' seems not to be required -- it isn't in | |
377 | ;; the original version, either. | |
378 | ;; CCC: this might need some work -- how does the Emacs 21 version | |
379 | ;; work, anyway? Does it work over ange-ftp? Hm. | |
380 | (if (not (fboundp 'vc-backend-checkout)) | |
381 | () ;; our replacement won't work and is unnecessary anyway | |
382 | (defun vc-checkout (filename &optional writable rev) | |
383 | "Retrieve a copy of the latest version of the given file." | |
384 | ;; If ftp is on this system and the name matches the ange-ftp format | |
385 | ;; for a remote file, the user is trying something that won't work. | |
386 | (funcall (symbol-function 'vc-backend-checkout) filename writable rev) | |
387 | (vc-resynch-buffer filename t t)) | |
388 | ) | |
389 | ||
390 | ||
391 | ;; Do we need to advise the vc-user-login-name function anyway? | |
bf247b6e | 392 | ;; This will return the correct login name for the owner of a |
fb7933a3 KG |
393 | ;; file. It does not deal with the default remote user name... |
394 | ;; | |
bf247b6e | 395 | ;; That is, when vc calls (vc-user-login-name), we return the |
fb7933a3 | 396 | ;; local login name, something that may be different to the remote |
bf247b6e | 397 | ;; default. |
fb7933a3 KG |
398 | ;; |
399 | ;; The remote VC operations will occur as the user that we logged | |
400 | ;; in with however - not always the same as the local user. | |
401 | ;; | |
bf247b6e | 402 | ;; In the end, I did advise the function. This is because, well, |
fb7933a3 KG |
403 | ;; the thing didn't work right otherwise ;) |
404 | ;; | |
405 | ;; Daniel Pittman <daniel@danann.net> | |
406 | ||
407 | (defun tramp-handle-vc-user-login-name (&optional uid) | |
408 | "Return the default user name on the remote machine. | |
409 | Whenever VC calls this function, `file' is bound to the file name | |
410 | in question. If no uid is provided or the uid is equal to the uid | |
411 | owning the file, then we return the user name given in the file name. | |
412 | ||
413 | This should only be called when `file' is bound to the | |
414 | filename we are thinking about..." | |
415 | ;; Pacify byte-compiler; this symbol is bound in the calling | |
416 | ;; function. CCC: Maybe it would be better to move the | |
417 | ;; boundness-checking into this function? | |
38c65fca KG |
418 | (let* ((file (symbol-value 'file)) |
419 | (remote-uid | |
340b8d4f | 420 | ;; With Emacs 22, `file-attributes' has got an optional parameter |
38c65fca KG |
421 | ;; ID-FORMAT. Handle this case backwards compatible. |
422 | (if (and (functionp 'subr-arity) | |
423 | (= 2 (cdr (funcall (symbol-function 'subr-arity) | |
424 | (symbol-function 'file-attributes))))) | |
425 | (nth 2 (file-attributes file 'integer)) | |
426 | (nth 2 (file-attributes file))))) | |
c951aecb | 427 | (if (and uid (/= uid remote-uid)) |
fb7933a3 | 428 | (error "tramp-handle-vc-user-login-name cannot map a uid to a name") |
07dfe738 | 429 | (let* ((v (tramp-dissect-file-name (expand-file-name file))) |
fb7933a3 KG |
430 | (u (tramp-file-name-user v))) |
431 | (cond ((stringp u) u) | |
432 | ((vectorp u) (elt u (1- (length u)))) | |
433 | ((null u) (user-login-name)) | |
434 | (t (error "tramp-handle-vc-user-login-name cannot cope!"))))))) | |
435 | ||
436 | ||
3204f203 AS |
437 | ;; The following defadvice is no longer necessary after changes in VC |
438 | ;; on 2006-01-25, Andre. | |
439 | ||
209bb3be MA |
440 | (unless (fboundp 'process-file) |
441 | (defadvice vc-user-login-name | |
442 | (around tramp-vc-user-login-name activate) | |
443 | "Support for files on remote machines accessed by TRAMP." | |
444 | ;; We rely on the fact that `file' is bound when this is called. | |
445 | ;; This appears to be the case everywhere in vc.el and vc-hooks.el | |
446 | ;; as of Emacs 20.5. | |
447 | ;; | |
448 | ;; With Emacs 22, the definition of `vc-user-login-name' has been | |
449 | ;; changed. It doesn't need to be adviced any longer. | |
450 | (let ((file (when (boundp 'file) | |
451 | (symbol-value 'file)))) ;pacify byte-compiler | |
452 | (or (and (stringp file) | |
453 | (tramp-tramp-file-p file) ; tramp file | |
454 | (setq ad-return-value | |
455 | (save-match-data | |
456 | (tramp-handle-vc-user-login-name uid)))) ; get the owner name | |
457 | ad-do-it))) ; else call the original | |
fb7933a3 | 458 | |
209bb3be MA |
459 | (add-hook 'tramp-unload-hook |
460 | '(lambda () (ad-unadvise 'vc-user-login-name)))) | |
a69c01a0 | 461 | |
bf247b6e | 462 | |
fb7933a3 KG |
463 | ;; Determine the name of the user owning a file. |
464 | (defun tramp-file-owner (filename) | |
465 | "Return who owns FILE (user name, as a string)." | |
bf247b6e | 466 | (let ((v (tramp-dissect-file-name |
07dfe738 KG |
467 | (expand-file-name filename)))) |
468 | (if (not (file-exists-p filename)) | |
fb7933a3 KG |
469 | nil ; file cannot be opened |
470 | ;; file exists, find out stuff | |
471 | (save-excursion | |
472 | (tramp-send-command | |
473 | (tramp-file-name-multi-method v) (tramp-file-name-method v) | |
474 | (tramp-file-name-user v) (tramp-file-name-host v) | |
475 | (format "%s -Lld %s" | |
476 | (tramp-get-ls-command (tramp-file-name-multi-method v) | |
477 | (tramp-file-name-method v) | |
478 | (tramp-file-name-user v) | |
479 | (tramp-file-name-host v)) | |
7432277c | 480 | (tramp-shell-quote-argument (tramp-file-name-localname v)))) |
fb7933a3 KG |
481 | (tramp-wait-for-output) |
482 | ;; parse `ls -l' output ... | |
483 | ;; ... file mode flags | |
484 | (read (current-buffer)) | |
485 | ;; ... number links | |
486 | (read (current-buffer)) | |
487 | ;; ... uid (as a string) | |
488 | (symbol-name (read (current-buffer))))))) | |
489 | ||
490 | ;; Wire ourselves into the VC infrastructure... | |
491 | ;; This function does not exist any more in Emacs-21's VC | |
492 | ;; CCC: it appears that no substitute is needed for Emacs 21. | |
493 | (defadvice vc-file-owner | |
494 | (around tramp-vc-file-owner activate) | |
495 | "Support for files on remote machines accessed by TRAMP." | |
496 | (let ((filename (ad-get-arg 0))) | |
497 | (or (and (tramp-file-name-p filename) ; tramp file | |
498 | (setq ad-return-value | |
499 | (save-match-data | |
500 | (tramp-file-owner filename)))) ; get the owner name | |
501 | ad-do-it))) ; else call the original | |
502 | ||
a69c01a0 MA |
503 | (add-hook 'tramp-unload-hook |
504 | '(lambda () (ad-unadvise 'vc-file-owner))) | |
505 | ||
fb7933a3 KG |
506 | |
507 | ;; We need to make the version control software backend version | |
508 | ;; information local to the current buffer. This is because each TRAMP | |
509 | ;; buffer can (theoretically) have a different VC version and I am | |
510 | ;; *way* too lazy to try and push the correct value into each new | |
511 | ;; buffer. | |
512 | ;; | |
513 | ;; Remote VC costs will just have to be paid, at least for the moment. | |
514 | ;; Well, at least, they will right until I feel guilty about doing a | |
515 | ;; botch job here and fix it. :/ | |
516 | ;; | |
517 | ;; Daniel Pittman <daniel@danann.net> | |
518 | ;; CCC: this is probably still needed for Emacs 21. | |
519 | (defun tramp-vc-setup-for-remote () | |
520 | "Make the backend release variables buffer local. | |
521 | This makes remote VC work correctly at the cost of some processing time." | |
522 | (when (and (buffer-file-name) | |
523 | (tramp-tramp-file-p (buffer-file-name))) | |
524 | (make-local-variable 'vc-rcs-release) | |
525 | (setq vc-rcs-release nil))) | |
a69c01a0 | 526 | |
fb7933a3 | 527 | (add-hook 'find-file-hooks 'tramp-vc-setup-for-remote t) |
a69c01a0 MA |
528 | (add-hook 'tramp-unload-hook |
529 | '(lambda () | |
530 | (remove-hook 'find-file-hooks 'tramp-vc-setup-for-remote))) | |
fb7933a3 KG |
531 | |
532 | ;; No need to load this again if anyone asks. | |
533 | (provide 'tramp-vc) | |
534 | ||
ab5796a9 | 535 | ;;; arch-tag: 27cc42ce-da19-468d-ad5c-a2690558db60 |
fb7933a3 | 536 | ;;; tramp-vc.el ends here |