X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/90f8dc03085e08b1eba333f4cb943474024c5f44..c1105d052e58569a0136c4501dc584358e13b24d:/lisp/net/tramp-vc.el diff --git a/lisp/net/tramp-vc.el b/lisp/net/tramp-vc.el index cee13308d3..c1806a4be2 100644 --- a/lisp/net/tramp-vc.el +++ b/lisp/net/tramp-vc.el @@ -1,6 +1,7 @@ ;;; 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 Free Software Foundation, Inc. ;; Author: Daniel Pittman ;; Keywords: comm, processes @@ -19,8 +20,8 @@ ;; 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: @@ -38,12 +39,20 @@ (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. ;; @@ -69,7 +78,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,7 +86,7 @@ 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)) @@ -88,7 +97,7 @@ See `vc-do-command' for more information." (set (make-local-variable 'vc-parent-buffer-name) (concat " from " (buffer-name camefrom))) (setq default-directory olddir) - + (erase-buffer) (mapcar @@ -122,6 +131,7 @@ See `vc-do-command' for more information." (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) @@ -163,7 +173,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)) @@ -180,6 +192,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.")) + ;; `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)) @@ -192,9 +205,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 ',localname ',flags)) + ; Pacify byte-compiler + (funcall (symbol-function 'vc-exec-after) + `(run-hook-with-args + 'vc-post-command-functions ',command ',localname ',flags)) status)))) @@ -206,6 +220,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 @@ -216,7 +231,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." (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 + (apply 'tramp-vc-do-command-new buffer okstatus command file ;(or file (buffer-file-name)) flags)) ad-do-it))) @@ -229,9 +244,9 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." (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 + (apply 'tramp-vc-do-command buffer okstatus command (or file (buffer-file-name)) last flags)) - ad-do-it)))) + ad-do-it))))) ;;-) @@ -246,7 +261,7 @@ 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)) @@ -273,6 +288,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." (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 localname)) " ") @@ -283,7 +299,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." (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. @@ -304,7 +320,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." (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))) @@ -325,7 +341,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 @@ -365,17 +382,17 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." ;; 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 @@ -391,10 +408,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 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)))) @@ -420,13 +445,13 @@ filename we are thinking about..." (tramp-handle-vc-user-login-name uid)))) ; get the owner name ad-do-it))) ; else call the original - + ;; 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 @@ -486,4 +511,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