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