X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4007ba5bfb1152d1b77b212bf881be58fe5fe23a..937640a621a4ce2e5e56eaecca37a2a28a584318:/lisp/net/tramp-vc.el diff --git a/lisp/net/tramp-vc.el b/lisp/net/tramp-vc.el index d59269680e..3cc54eda65 100644 --- a/lisp/net/tramp-vc.el +++ b/lisp/net/tramp-vc.el @@ -1,6 +1,6 @@ ;;; tramp-vc.el --- Version control integration for TRAMP.el -;; Copyright (C) 2000 by Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003, 2004 by Free Software Foundation, Inc. ;; Author: Daniel Pittman ;; Keywords: comm, processes @@ -38,6 +38,14 @@ (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 @@ -69,7 +77,7 @@ "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)) @@ -77,12 +85,12 @@ See `vc-do-command' for more information." (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) @@ -99,7 +107,7 @@ See `vc-do-command' for more information." (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 @@ -122,7 +130,7 @@ See `vc-do-command' for more information." (save-excursion (save-window-excursion ;; Actually execute remote command - (tramp-handle-shell-command + (shell-command (mapconcat 'tramp-shell-quote-argument (cons command squeezed) " ") t) ;;(tramp-wait-for-output) @@ -163,7 +171,9 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." (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)) @@ -172,7 +182,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." (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 (file-relative-name @@ -180,7 +190,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." (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 + (setq status (shell-command (mapconcat 'tramp-shell-quote-argument (cons command squeezed) " ") t)) (when (or (not (integerp status)) @@ -192,9 +202,10 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." (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)))) @@ -206,6 +217,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." ;; Daniel Pittman ;;-(if (fboundp 'vc-call-backend) ;;- () ;; This is the new VC for which we don't have an appropriate advice yet +(unless (fboundp 'process-file) (if (fboundp 'vc-call-backend) (defadvice vc-do-command (around tramp-advice-vc-do-command @@ -231,7 +243,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." (setq ad-return-value (apply 'tramp-vc-do-command buffer okstatus command (or file (buffer-file-name)) last flags)) - ad-do-it)))) + ad-do-it))))) ;;-) @@ -246,12 +258,12 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." ;; 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 @@ -273,9 +285,9 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." (save-excursion (save-window-excursion ;; Actually execute remote command - (tramp-handle-shell-command + (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 @@ -325,7 +337,8 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." (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 @@ -336,6 +349,9 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." (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) @@ -388,10 +404,18 @@ filename we are thinking about..." ;; 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 21.4, `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)))) @@ -422,8 +446,8 @@ filename we are thinking about..." (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)) + (expand-file-name filename)))) + (if (not (file-exists-p filename)) nil ; file cannot be opened ;; file exists, find out stuff (save-excursion @@ -435,7 +459,7 @@ filename we are thinking about..." (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 @@ -483,4 +507,5 @@ This makes remote VC work correctly at the cost of some processing time." ;; No need to load this again if anyone asks. (provide 'tramp-vc) +;;; arch-tag: 27cc42ce-da19-468d-ad5c-a2690558db60 ;;; tramp-vc.el ends here