;;; tramp-vc.el --- Version control integration for TRAMP.el
-;; Copyright (C) 2000 by Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Daniel Pittman <daniel@danann.net>
;; Keywords: comm, processes
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(require 'vc-rcs))
(require 'tramp)
+;; Avoid byte-compiler warnings if the byte-compiler supports this.
+;; Currently, XEmacs supports this.
+(eval-when-compile
+ (when (fboundp 'byte-compiler-options)
+ (let (unused-vars) ; Pacify Emacs byte-compiler
+ (defalias 'warnings 'identity) ; Pacify Emacs byte-compiler
+ (byte-compiler-options (warnings (- unused-vars))))))
+
;; -- vc --
;; This used to blow away the file-name-handler-alist and reinstall
;; TRAMP into it. This was intended to let VC work remotely. It didn't,
;; at least not in my XEmacs 21.2 install.
-;;
+;;
;; In any case, tramp-run-real-handler now deals correctly with disabling
;; the things that should be, making this a no-op.
;;
"Like `vc-do-command' but invoked for tramp files.
See `vc-do-command' for more information."
(save-match-data
- (and file (setq file (tramp-handle-expand-file-name file)))
+ (and file (setq file (expand-file-name file)))
(if (not buffer) (setq buffer "*vc*"))
(if vc-command-messages
(message "Running `%s' on `%s'..." command file))
(squeezed nil)
(olddir default-directory)
vc-file status)
- (let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name file)))
+ (let* ((v (tramp-dissect-file-name (expand-file-name file)))
(multi-method (tramp-file-name-multi-method v))
(method (tramp-file-name-method v))
(user (tramp-file-name-user v))
(host (tramp-file-name-host v))
- (path (tramp-file-name-path v)))
+ (localname (tramp-file-name-localname v)))
(set-buffer (get-buffer-create buffer))
(set (make-local-variable 'vc-parent-buffer) camefrom)
(set (make-local-variable 'vc-parent-buffer-name)
(concat " from " (buffer-name camefrom)))
(setq default-directory olddir)
-
+
(erase-buffer)
(mapcar
(setq vc-file (vc-name file)))
(setq squeezed
(append squeezed
- (list (tramp-file-name-path
+ (list (tramp-file-name-localname
(tramp-dissect-file-name vc-file))))))
(if (and file (eq last 'WORKFILE))
(progn
(save-excursion
(save-window-excursion
;; Actually execute remote command
+ ;; `shell-command' cannot be used; it isn't magic in XEmacs.
(tramp-handle-shell-command
(mapconcat 'tramp-shell-quote-argument
(cons command squeezed) " ") t)
(goto-char (point-max))
(set-buffer-modified-p nil)
(forward-line -1)
- (if (or (not (integerp status)) (and okstatus (< okstatus status)))
+ (if (or (not (integerp status))
+ (and (integerp okstatus) (< okstatus status)))
(progn
(pop-to-buffer buffer)
(goto-char (point-min))
(if vc-command-messages
(message "Running %s on %s..." command file))
(save-current-buffer
- (unless (eq buffer t) (vc-setup-buffer buffer))
+ (unless (eq buffer t)
+ ; Pacify byte-compiler
+ (funcall (symbol-function 'vc-setup-buffer) buffer))
(let ((squeezed nil)
(inhibit-read-only t)
(status 0))
(method (when file (tramp-file-name-method v)))
(user (when file (tramp-file-name-user v)))
(host (when file (tramp-file-name-host v)))
- (path (when file (tramp-file-name-path v))))
+ (localname (when file (tramp-file-name-localname v))))
(setq squeezed (delq nil (copy-sequence flags)))
(when file
- (setq squeezed (append squeezed (list path))))
+ (setq squeezed (append squeezed (list (file-relative-name
+ file default-directory)))))
(let ((w32-quote-process-args t))
(when (eq okstatus 'async)
(message "Tramp doesn't do async commands, running synchronously."))
+ ;; `shell-command' cannot be used; it isn't magic in XEmacs.
(setq status (tramp-handle-shell-command
(mapconcat 'tramp-shell-quote-argument
(cons command squeezed) " ") t))
- (when (or (not (integerp status)) (and okstatus (< okstatus status)))
+ (when (or (not (integerp status))
+ (and (integerp okstatus) (< okstatus status)))
(pop-to-buffer (current-buffer))
(goto-char (point-min))
(shrink-window-if-larger-than-buffer)
(if (integerp status) (format "status %d" status) status))))
(if vc-command-messages
(message "Running %s...OK" command))
- (vc-exec-after
- `(run-hook-with-args
- 'vc-post-command-functions ',command ',path ',flags))
+ ; Pacify byte-compiler
+ (funcall (symbol-function 'vc-exec-after)
+ `(run-hook-with-args
+ 'vc-post-command-functions ',command ',localname ',flags))
status))))
;; Daniel Pittman <daniel@danann.net>
;;-(if (fboundp 'vc-call-backend)
;;- () ;; This is the new VC for which we don't have an appropriate advice yet
-(if (fboundp 'vc-call-backend)
+;;-)
+(unless (fboundp 'process-file)
+ (if (fboundp 'vc-call-backend)
+ (defadvice vc-do-command
+ (around tramp-advice-vc-do-command
+ (buffer okstatus command file &rest flags)
+ activate)
+ "Invoke tramp-vc-do-command for tramp files."
+ (let ((file (symbol-value 'file))) ;pacify byte-compiler
+ (if (or (and (stringp file) (tramp-tramp-file-p file))
+ (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))))
+ (setq ad-return-value
+ (apply 'tramp-vc-do-command-new buffer okstatus command
+ file ;(or file (buffer-file-name))
+ flags))
+ ad-do-it)))
(defadvice vc-do-command
(around tramp-advice-vc-do-command
- (buffer okstatus command file &rest flags)
- activate)
+ (buffer okstatus command file last &rest flags)
+ activate)
"Invoke tramp-vc-do-command for tramp files."
- (let ((file (symbol-value 'file))) ;pacify byte-compiler
- (if (or (and (stringp file) (tramp-tramp-file-p file))
- (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))))
- (setq ad-return-value
- (apply 'tramp-vc-do-command-new buffer okstatus command
- file ;(or file (buffer-file-name))
- flags))
- ad-do-it)))
- (defadvice vc-do-command
- (around tramp-advice-vc-do-command
- (buffer okstatus command file last &rest flags)
- activate)
- "Invoke tramp-vc-do-command for tramp files."
- (let ((file (symbol-value 'file))) ;pacify byte-compiler
- (if (or (and (stringp file) (tramp-tramp-file-p file))
- (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))))
- (setq ad-return-value
- (apply 'tramp-vc-do-command buffer okstatus command
- (or file (buffer-file-name)) last flags))
- ad-do-it))))
-;;-)
+ (let ((file (symbol-value 'file))) ;pacify byte-compiler
+ (if (or (and (stringp file) (tramp-tramp-file-p file))
+ (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))))
+ (setq ad-return-value
+ (apply 'tramp-vc-do-command buffer okstatus command
+ (or file (buffer-file-name)) last flags))
+ ad-do-it))))
+
+ (add-hook 'tramp-unload-hook
+ '(lambda () (ad-unadvise 'vc-do-command))))
;; XEmacs uses this to do some of its work. Like vc-do-command, we
;; Don't switch to the *vc-info* buffer before running the
;; command, because that would change its default directory
(save-match-data
- (let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name file)))
+ (let* ((v (tramp-dissect-file-name (expand-file-name file)))
(multi-method (tramp-file-name-multi-method v))
(method (tramp-file-name-method v))
(user (tramp-file-name-user v))
(host (tramp-file-name-host v))
- (path (tramp-file-name-path v)))
+ (localname (tramp-file-name-localname v)))
(save-excursion (set-buffer (get-buffer-create "*vc-info*"))
(erase-buffer))
(let ((exec-path (append vc-path exec-path)) exec-status
(save-excursion
(save-window-excursion
;; Actually execute remote command
+ ;; `shell-command' cannot be used; it isn't magic in XEmacs.
(tramp-handle-shell-command
(mapconcat 'tramp-shell-quote-argument
- (append (list command) args (list path)) " ")
+ (append (list command) args (list localname)) " ")
(get-buffer-create"*vc-info*"))
;(tramp-wait-for-output)
;; Get status from command
(tramp-wait-for-output)
(setq exec-status (read (current-buffer)))
(message "Command %s returned status %d." command exec-status)))
-
+
+ ;; Maybe okstatus can be `async' here. But then, maybe the
+ ;; async thing is new in Emacs 21, but this function is only
+ ;; used in Emacs 20.
(cond ((> exec-status okstatus)
(switch-to-buffer (get-file-buffer file))
(shrink-window-if-larger-than-buffer
(if (or (and (stringp file) (tramp-tramp-file-p file))
(and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))))
(setq ad-return-value
- (apply 'tramp-vc-simple-command okstatus command
+ (apply 'tramp-vc-simple-command okstatus command
(or file (buffer-file-name)) args))
ad-do-it)))
+(add-hook 'tramp-unload-hook
+ '(lambda () (ad-unadvise 'vc-simple-command)))
+
;; `vc-workfile-unchanged-p'
;; This function does not deal well with remote files, so we do the
(not want-differences-if-changed))))
(zerop status))
;; New VC. Call `vc-default-workfile-unchanged-p'.
- (vc-default-workfile-unchanged-p (vc-backend file) filename)))
+ (funcall (symbol-function 'vc-default-workfile-unchanged-p)
+ (vc-backend filename) filename)))
(defadvice vc-workfile-unchanged-p
(around tramp-advice-vc-workfile-unchanged-p
(tramp-tramp-file-p filename)
(not
(let ((v (tramp-dissect-file-name filename)))
+ ;; The following check is probably to test whether
+ ;; file-attributes returns correct last modification
+ ;; times. This check needs to be changed.
(tramp-get-remote-perl (tramp-file-name-multi-method v)
(tramp-file-name-method v)
(tramp-file-name-user v)
(tramp-vc-workfile-unchanged-p filename want-differences-if-changed))
ad-do-it))
+(add-hook 'tramp-unload-hook
+ '(lambda () (ad-unadvise 'vc-workfile-unchanged-p)))
+
;; Redefine a function from vc.el -- allow tramp files.
;; `save-match-data' seems not to be required -- it isn't in
;; Do we need to advise the vc-user-login-name function anyway?
-;; This will return the correct login name for the owner of a
+;; This will return the correct login name for the owner of a
;; file. It does not deal with the default remote user name...
;;
-;; That is, when vc calls (vc-user-login-name), we return the
+;; That is, when vc calls (vc-user-login-name), we return the
;; local login name, something that may be different to the remote
-;; default.
+;; default.
;;
;; The remote VC operations will occur as the user that we logged
;; in with however - not always the same as the local user.
;;
-;; In the end, I did advise the function. This is because, well,
+;; In the end, I did advise the function. This is because, well,
;; the thing didn't work right otherwise ;)
;;
;; Daniel Pittman <daniel@danann.net>
;; Pacify byte-compiler; this symbol is bound in the calling
;; function. CCC: Maybe it would be better to move the
;; boundness-checking into this function?
- (let ((file (symbol-value 'file)))
- (if (and uid (/= uid (nth 2 (file-attributes file))))
+ (let* ((file (symbol-value 'file))
+ (remote-uid
+ ;; With Emacs 22, `file-attributes' has got an optional parameter
+ ;; ID-FORMAT. Handle this case backwards compatible.
+ (if (and (functionp 'subr-arity)
+ (= 2 (cdr (funcall (symbol-function 'subr-arity)
+ (symbol-function 'file-attributes)))))
+ (nth 2 (file-attributes file 'integer))
+ (nth 2 (file-attributes file)))))
+ (if (and uid (/= uid remote-uid))
(error "tramp-handle-vc-user-login-name cannot map a uid to a name")
- (let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name file)))
+ (let* ((v (tramp-dissect-file-name (expand-file-name file)))
(u (tramp-file-name-user v)))
(cond ((stringp u) u)
((vectorp u) (elt u (1- (length u))))
(t (error "tramp-handle-vc-user-login-name cannot cope!")))))))
-(defadvice vc-user-login-name
- (around tramp-vc-user-login-name activate)
- "Support for files on remote machines accessed by TRAMP."
- ;; We rely on the fact that `file' is bound when this is called.
- ;; This appears to be the case everywhere in vc.el and vc-hooks.el
- ;; as of Emacs 20.5.
- ;;
- ;; CCC TODO there should be a real solution! Talk to Andre Spiegel
- ;; about this.
- (let ((file (when (boundp 'file)
- (symbol-value 'file)))) ;pacify byte-compiler
- (or (and (stringp file)
- (tramp-tramp-file-p file) ; tramp file
- (setq ad-return-value
- (save-match-data
- (tramp-handle-vc-user-login-name uid)))) ; get the owner name
- ad-do-it))) ; else call the original
+;; The following defadvice is no longer necessary after changes in VC
+;; on 2006-01-25, Andre.
+
+(unless (fboundp 'process-file)
+ (defadvice vc-user-login-name
+ (around tramp-vc-user-login-name activate)
+ "Support for files on remote machines accessed by TRAMP."
+ ;; We rely on the fact that `file' is bound when this is called.
+ ;; This appears to be the case everywhere in vc.el and vc-hooks.el
+ ;; as of Emacs 20.5.
+ ;;
+ ;; With Emacs 22, the definition of `vc-user-login-name' has been
+ ;; changed. It doesn't need to be adviced any longer.
+ (let ((file (when (boundp 'file)
+ (symbol-value 'file)))) ;pacify byte-compiler
+ (or (and (stringp file)
+ (tramp-tramp-file-p file) ; tramp file
+ (setq ad-return-value
+ (save-match-data
+ (tramp-handle-vc-user-login-name uid)))) ; get the owner name
+ ad-do-it))) ; else call the original
+
+ (add-hook 'tramp-unload-hook
+ '(lambda () (ad-unadvise 'vc-user-login-name))))
+
-
;; Determine the name of the user owning a file.
(defun tramp-file-owner (filename)
"Return who owns FILE (user name, as a string)."
- (let ((v (tramp-dissect-file-name
- (tramp-handle-expand-file-name filename))))
- (if (not (tramp-handle-file-exists-p filename))
+ (let ((v (tramp-dissect-file-name
+ (expand-file-name filename))))
+ (if (not (file-exists-p filename))
nil ; file cannot be opened
;; file exists, find out stuff
(save-excursion
(tramp-file-name-method v)
(tramp-file-name-user v)
(tramp-file-name-host v))
- (tramp-shell-quote-argument (tramp-file-name-path v))))
+ (tramp-shell-quote-argument (tramp-file-name-localname v))))
(tramp-wait-for-output)
;; parse `ls -l' output ...
;; ... file mode flags
(tramp-file-owner filename)))) ; get the owner name
ad-do-it))) ; else call the original
+(add-hook 'tramp-unload-hook
+ '(lambda () (ad-unadvise 'vc-file-owner)))
+
;; We need to make the version control software backend version
;; information local to the current buffer. This is because each TRAMP
(tramp-tramp-file-p (buffer-file-name)))
(make-local-variable 'vc-rcs-release)
(setq vc-rcs-release nil)))
+
(add-hook 'find-file-hooks 'tramp-vc-setup-for-remote t)
+(add-hook 'tramp-unload-hook
+ '(lambda ()
+ (remove-hook 'find-file-hooks 'tramp-vc-setup-for-remote)))
;; No need to load this again if anyone asks.
(provide 'tramp-vc)
+;;; arch-tag: 27cc42ce-da19-468d-ad5c-a2690558db60
;;; tramp-vc.el ends here