]> code.delx.au - gnu-emacs/blobdiff - lisp/net/tramp-vc.el
Make `make-auto-save-file-name' a magic operation.
[gnu-emacs] / lisp / net / tramp-vc.el
index 4e96303a0fee7fdefdfa03f7869fca09c5fd6c11..c1806a4be2409175ba75fe212ae9bdf4a0efccf9 100644 (file)
@@ -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 <daniel@danann.net>
 ;; 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:
 
   (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 +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,12 +86,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 +108,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,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))
@@ -172,7 +184,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,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 ',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 +220,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
 ;; 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
+(unless (fboundp 'process-file)
 (if (fboundp 'vc-call-backend)
     (defadvice vc-do-command
       (around tramp-advice-vc-do-command
@@ -231,7 +246,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 +261,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 +288,10 @@ 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 path)) " ")
+                       (append (list command) args (list localname)) " ")
             (get-buffer-create"*vc-info*"))
                                        ;(tramp-wait-for-output)
            ;; Get status from command
@@ -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
@@ -336,6 +353,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 +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))))
@@ -422,8 +450,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 +463,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 +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