(eval-when-compile
(require 'cl))
(require 'vc)
(unless (boundp 'vc-rcs-release)
(require 'vc-rcs))
(require 'tramp)
(eval-when-compile
(when (fboundp 'byte-compiler-options)
(let (unused-vars) (defalias 'warnings 'identity) (byte-compiler-options (warnings (- unused-vars))))))
(defun tramp-vc-do-command (buffer okstatus command file last &rest flags)
"Like `vc-do-command' but invoked for tramp files.
See `vc-do-command' for more information."
(save-match-data
(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))
(let ((obuf (current-buffer)) (camefrom (current-buffer))
(squeezed nil)
(olddir default-directory)
vc-file status)
(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))
(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
(function
(lambda (s) (and s (setq squeezed (append squeezed (list s))))))
flags)
(if (and (eq last 'MASTER) file
(setq vc-file (vc-name file)))
(setq squeezed
(append squeezed
(list (tramp-file-name-localname
(tramp-dissect-file-name vc-file))))))
(if (and file (eq last 'WORKFILE))
(progn
(let* ((pwd (expand-file-name default-directory))
(preflen (length pwd)))
(if (string= (substring file 0 preflen) pwd)
(setq file (substring file preflen))))
(setq squeezed (append squeezed (list file)))))
(save-excursion
(save-window-excursion
(tramp-handle-shell-command
(mapconcat 'tramp-shell-quote-argument
(cons command squeezed) " ") t)
(tramp-send-command multi-method method user host "echo $?")
(tramp-wait-for-output)
(goto-char (point-max)) (forward-line -1)
(setq status (read (current-buffer)))
(message "Command %s returned status %d." command status)))
(goto-char (point-max))
(set-buffer-modified-p nil)
(forward-line -1)
(if (or (not (integerp status))
(and (integerp okstatus) (< okstatus status)))
(progn
(pop-to-buffer buffer)
(goto-char (point-min))
(shrink-window-if-larger-than-buffer)
(error "Running `%s'...FAILED (%s)" command
(if (integerp status)
(format "status %d" status)
status))
)
(if vc-command-messages
(message "Running %s...OK" command))
)
(set-buffer obuf)
status))
))
(defun tramp-vc-do-command-new (buffer okstatus command file &rest flags)
"Like `vc-do-command' but for TRAMP files.
This function is for the new VC which comes with Emacs 21.
Since TRAMP doesn't do async commands yet, this function doesn't, either."
(and file (setq file (expand-file-name file)))
(if vc-command-messages
(message "Running %s on %s..." command file))
(save-current-buffer
(unless (eq buffer t)
(funcall (symbol-function 'vc-setup-buffer) buffer))
(let ((squeezed nil)
(inhibit-read-only t)
(status 0))
(let* ((v (when file (tramp-dissect-file-name file)))
(multi-method (when file (tramp-file-name-multi-method v)))
(method (when file (tramp-file-name-method v)))
(user (when file (tramp-file-name-user v)))
(host (when file (tramp-file-name-host v)))
(localname (when file (tramp-file-name-localname v))))
(setq squeezed (delq nil (copy-sequence flags)))
(when file
(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."))
(setq status (tramp-handle-shell-command
(mapconcat 'tramp-shell-quote-argument
(cons command squeezed) " ") t))
(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)
(error "Running %s...FAILED (%s)" command
(if (integerp status) (format "status %d" status) status))))
(if vc-command-messages
(message "Running %s...OK" command))
(funcall (symbol-function 'vc-exec-after)
`(run-hook-with-args
'vc-post-command-functions ',command ',localname ',flags))
status))))
(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))) (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 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))) (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))))
(defun tramp-vc-simple-command (okstatus command file &rest args)
(save-match-data
(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))
(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
(process-environment
(cons (concat "PATH=" (getenv "PATH")
path-separator
(mapconcat 'identity vc-path path-separator))
process-environment)))
(save-excursion
(save-window-excursion
(tramp-handle-shell-command
(mapconcat 'tramp-shell-quote-argument
(append (list command) args (list localname)) " ")
(get-buffer-create"*vc-info*"))
(tramp-send-command multi-method method user host "echo $?")
(tramp-wait-for-output)
(setq exec-status (read (current-buffer)))
(message "Command %s returned status %d." command exec-status)))
(cond ((> exec-status okstatus)
(switch-to-buffer (get-file-buffer file))
(shrink-window-if-larger-than-buffer
(display-buffer "*vc-info*"))
(error "Couldn't find version control information")))
exec-status))))
(defadvice vc-simple-command
(around tramp-advice-vc-simple-command
(okstatus command file &rest args)
activate)
"Invoke tramp-vc-simple-command for tramp files."
(let ((file (symbol-value 'file))) (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
(or file (buffer-file-name)) args))
ad-do-it)))
(add-hook 'tramp-unload-hook
'(lambda () (ad-unadvise 'vc-simple-command)))
(defun tramp-vc-workfile-unchanged-p
(filename &optional want-differences-if-changed)
(if (fboundp 'vc-backend-diff)
(let ((status (funcall (symbol-function 'vc-backend-diff)
filename nil nil
(not want-differences-if-changed))))
(zerop status))
(funcall (symbol-function 'vc-default-workfile-unchanged-p)
(vc-backend filename) filename)))
(defadvice vc-workfile-unchanged-p
(around tramp-advice-vc-workfile-unchanged-p
(filename &optional want-differences-if-changed)
activate)
"Invoke tramp-vc-workfile-unchanged-p for tramp files."
(if (and (stringp filename)
(tramp-tramp-file-p filename)
(not
(let ((v (tramp-dissect-file-name filename)))
(tramp-get-remote-perl (tramp-file-name-multi-method v)
(tramp-file-name-method v)
(tramp-file-name-user v)
(tramp-file-name-host v)))))
(setq ad-return-value
(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)))
(if (not (fboundp 'vc-backend-checkout))
() (defun vc-checkout (filename &optional writable rev)
"Retrieve a copy of the latest version of the given file."
(funcall (symbol-function 'vc-backend-checkout) filename writable rev)
(vc-resynch-buffer filename t t))
)
(defun tramp-handle-vc-user-login-name (&optional uid)
"Return the default user name on the remote machine.
Whenever VC calls this function, `file' is bound to the file name
in question. If no uid is provided or the uid is equal to the uid
owning the file, then we return the user name given in the file name.
This should only be called when `file' is bound to the
filename we are thinking about..."
(let* ((file (symbol-value 'file))
(remote-uid
(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 (expand-file-name file)))
(u (tramp-file-name-user v)))
(cond ((stringp u) u)
((vectorp u) (elt u (1- (length u))))
((null u) (user-login-name))
(t (error "tramp-handle-vc-user-login-name cannot cope!")))))))
(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."
(let ((file (when (boundp 'file)
(symbol-value 'file)))) (or (and (stringp file)
(tramp-tramp-file-p file) (setq ad-return-value
(save-match-data
(tramp-handle-vc-user-login-name uid)))) ad-do-it)))
(add-hook 'tramp-unload-hook
'(lambda () (ad-unadvise 'vc-user-login-name))))
(defun tramp-file-owner (filename)
"Return who owns FILE (user name, as a string)."
(let ((v (tramp-dissect-file-name
(expand-file-name filename))))
(if (not (file-exists-p filename))
nil (save-excursion
(tramp-send-command
(tramp-file-name-multi-method v) (tramp-file-name-method v)
(tramp-file-name-user v) (tramp-file-name-host v)
(format "%s -Lld %s"
(tramp-get-ls-command (tramp-file-name-multi-method v)
(tramp-file-name-method v)
(tramp-file-name-user v)
(tramp-file-name-host v))
(tramp-shell-quote-argument (tramp-file-name-localname v))))
(tramp-wait-for-output)
(read (current-buffer))
(read (current-buffer))
(symbol-name (read (current-buffer)))))))
(defadvice vc-file-owner
(around tramp-vc-file-owner activate)
"Support for files on remote machines accessed by TRAMP."
(let ((filename (ad-get-arg 0)))
(or (and (tramp-file-name-p filename) (setq ad-return-value
(save-match-data
(tramp-file-owner filename)))) ad-do-it)))
(add-hook 'tramp-unload-hook
'(lambda () (ad-unadvise 'vc-file-owner)))
(defun tramp-vc-setup-for-remote ()
"Make the backend release variables buffer local.
This makes remote VC work correctly at the cost of some processing time."
(when (and (buffer-file-name)
(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)))
(provide 'tramp-vc)