Add 2012 to FSF copyright years for Emacs files
[bpt/emacs.git] / lisp / net / tramp.el
index 274bc72..afb7ab4 100644 (file)
@@ -1,6 +1,6 @@
 ;;; tramp.el --- Transparent Remote Access, Multiple Protocol
 
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
 
 ;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
 ;;         Michael Albinus <michael.albinus@gmx.de>
@@ -152,7 +152,7 @@ local host, so if you want to use `~' in those commands, you should
 choose a shell here which groks tilde expansion.  `/bin/sh' normally
 does not understand tilde expansion.
 
-For encoding and deocding, commands like the following are executed:
+For encoding and decoding, commands like the following are executed:
 
     /bin/sh -c COMMAND < INPUT > OUTPUT
 
@@ -190,13 +190,17 @@ See the variable `tramp-encoding-shell' for more information."
 This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
 Each NAME stands for a remote access method.  Each PARAM is a
 pair of the form (KEY VALUE).  The following KEYs are defined:
-  * `tramp-remote-sh'
-    This specifies the Bourne shell to use on the remote host.  This
-    MUST be a Bourne-like shell.  It is normally not necessary to set
-    this to any value other than \"/bin/sh\": Tramp wants to use a shell
-    which groks tilde expansion, but it can search for it.  Also note
-    that \"/bin/sh\" exists on all Unixen, this might not be true for
-    the value that you decide to use.  You Have Been Warned.
+  * `tramp-remote-shell'
+    This specifies the shell to use on the remote host.  This
+    MUST be a Bourne-like shell.  It is normally not necessary to
+    set this to any value other than \"/bin/sh\": Tramp wants to
+    use a shell which groks tilde expansion, but it can search
+    for it.  Also note that \"/bin/sh\" exists on all Unixen,
+    this might not be true for the value that you decide to use.
+    You Have Been Warned.
+  * `tramp-remote-shell-args'
+    For implementation of `shell-command', this specifies the
+    arguments to let `tramp-remote-shell' run a single command.
   * `tramp-login-program'
     This specifies the name of the program to use for logging in to the
     remote host.  This may be the name of rsh or a workalike program,
@@ -251,6 +255,9 @@ pair of the form (KEY VALUE).  The following KEYs are defined:
     not have to be newline or carriage return characters.  Other login
     programs are happy with just one character, the newline character.
     We use \"xy\" as the value for methods using \"plink\".
+  * `tramp-tmpdir'
+    A directory on the remote host for temporary files.  If not
+    specified, \"/tmp\" is taken as default.
 
 What does all this mean?  Well, you should specify `tramp-login-program'
 for all methods; this program is used to log in to the remote site.  Then,
@@ -291,8 +298,8 @@ shouldn't return t when it isn't."
       (search-forward-regexp "Missing ControlMaster argument" nil t))))
 
 (defcustom tramp-default-method
-  ;; An external copy method seems to be preferred, because it is much
-  ;; more performant for large files, and it hasn't too serious delays
+  ;; An external copy method seems to be preferred, because it performs
+  ;; much better for large files, and it hasn't too serious delays
   ;; for small files.  But it must be ensured that there aren't
   ;; permanent password queries.  Either a password agent like
   ;; "ssh-agent" or "Pageant" shall run, or the optional
@@ -1324,7 +1331,7 @@ ARGS to actually emit the message (if applicable)."
                (setq fn nil)))
            (setq btn (1+ btn))))
        ;; The following code inserts filename and line number.
-       ;; Should be deactivated by default, because it is time
+       ;; Should be inactive by default, because it is time
        ;; consuming.
 ;      (let ((ffn (find-function-noselect (intern fn))))
 ;        (insert
@@ -1599,24 +1606,28 @@ This is intended to be used as a minibuffer `post-command-hook' for
 `file-name-shadow-mode'; the minibuffer should have already
 been set up by `rfn-eshadow-setup-minibuffer'."
   ;; In remote files name, there is a shadowing just for the local part.
-  (let ((end (or (tramp-compat-funcall
-                 'overlay-end (symbol-value 'rfn-eshadow-overlay))
-                (tramp-compat-funcall 'minibuffer-prompt-end))))
-    (when
-       (file-remote-p
-        (tramp-compat-funcall 'buffer-substring-no-properties end (point-max)))
-      (save-excursion
-       (save-restriction
-         (narrow-to-region
-          (1+ (or (string-match
-                   tramp-rfn-eshadow-update-overlay-regexp (buffer-string) end)
-                  end))
-          (point-max))
-         (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
-               (rfn-eshadow-update-overlay-hook nil))
-           (tramp-compat-funcall
-            'move-overlay rfn-eshadow-overlay (point-max) (point-max))
-           (tramp-compat-funcall 'rfn-eshadow-update-overlay)))))))
+  (ignore-errors
+    (let ((end (or (tramp-compat-funcall
+                   'overlay-end (symbol-value 'rfn-eshadow-overlay))
+                  (tramp-compat-funcall 'minibuffer-prompt-end))))
+      (when
+         (file-remote-p
+          (tramp-compat-funcall
+           'buffer-substring-no-properties end (point-max)))
+       (save-excursion
+         (save-restriction
+           (narrow-to-region
+            (1+ (or (string-match
+                     tramp-rfn-eshadow-update-overlay-regexp
+                     (buffer-string) end)
+                    end))
+            (point-max))
+           (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
+                 (rfn-eshadow-update-overlay-hook nil)
+                 file-name-handler-alist)
+             (tramp-compat-funcall
+              'move-overlay rfn-eshadow-overlay (point-max) (point-max))
+             (tramp-compat-funcall 'rfn-eshadow-update-overlay))))))))
 
 (when (boundp 'rfn-eshadow-update-overlay-hook)
   (add-hook 'rfn-eshadow-update-overlay-hook
@@ -1875,11 +1886,11 @@ Falls back to normal file name handler if no Tramp file name handler exists."
                      (when (and (listp sf) (eq (car sf) 'autoload))
                        (let ((default-directory
                                (tramp-compat-temporary-file-directory)))
-                         (load (cadr sf) 'noerror)))
+                         (load (cadr sf) 'noerror 'nomessage)))
                      (apply foreign operation args))
 
                  ;; Trace that somebody has interrupted the operation.
-                 (quit
+                 ((debug quit)
                   (let (tramp-message-show-message)
                     (tramp-message
                      v 1 "Interrupt received in operation %s"
@@ -1891,6 +1902,9 @@ Falls back to normal file name handler if no Tramp file name handler exists."
                  ;; operations shall return at least a default value
                  ;; in order to give the user a chance to correct the
                  ;; file name in the minibuffer.
+                 ;; We cannot use 'debug as error handler.  In order
+                 ;; to get a full backtrace, one could apply
+                 ;;   (setq debug-on-error t debug-on-signal t)
                  (error
                   (cond
                    ((and completion (zerop (length localname))
@@ -2089,8 +2103,9 @@ This is true, if either the remote host is already connected, or if we are
 not in completion mode."
   (and (tramp-tramp-file-p filename)
        (with-parsed-tramp-file-name filename nil
-        (or (get-buffer (tramp-buffer-name v))
-            (not (tramp-completion-mode-p))))))
+        (or (not (tramp-completion-mode-p))
+            (let ((p (tramp-get-connection-process v)))
+              (and p (processp p) (memq (process-status p) '(run open))))))))
 
 ;; Method, host name and user name completion.
 ;; `tramp-completion-dissect-file-name' returns a list of
@@ -2959,6 +2974,94 @@ User is always nil."
              (delete-file local-copy)))))
       t)))
 
+(defun tramp-handle-shell-command
+  (command &optional output-buffer error-buffer)
+  "Like `shell-command' for Tramp files."
+  (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
+        ;; We cannot use `shell-file-name' and `shell-command-switch',
+        ;; they are variables of the local host.
+        (args (append
+               (cons
+                (tramp-get-method-parameter
+                 (tramp-file-name-method
+                  (tramp-dissect-file-name default-directory))
+                 'tramp-remote-shell)
+                (tramp-get-method-parameter
+                 (tramp-file-name-method
+                  (tramp-dissect-file-name default-directory))
+                 'tramp-remote-shell-args))
+               (list (substring command 0 asynchronous))))
+        current-buffer-p
+        (output-buffer
+         (cond
+          ((bufferp output-buffer) output-buffer)
+          ((stringp output-buffer) (get-buffer-create output-buffer))
+          (output-buffer
+           (setq current-buffer-p t)
+           (current-buffer))
+          (t (get-buffer-create
+              (if asynchronous
+                  "*Async Shell Command*"
+                "*Shell Command Output*")))))
+        (error-buffer
+         (cond
+          ((bufferp error-buffer) error-buffer)
+          ((stringp error-buffer) (get-buffer-create error-buffer))))
+        (buffer
+         (if (and (not asynchronous) error-buffer)
+             (with-parsed-tramp-file-name default-directory nil
+               (list output-buffer (tramp-make-tramp-temp-file v)))
+           output-buffer))
+        (p (get-buffer-process output-buffer)))
+
+    ;; Check whether there is another process running.  Tramp does not
+    ;; support 2 (asynchronous) processes in parallel.
+    (when p
+      (if (yes-or-no-p "A command is running.  Kill it? ")
+         (ignore-errors (kill-process p))
+       (error "Shell command in progress")))
+
+    (if current-buffer-p
+       (progn
+         (barf-if-buffer-read-only)
+         (push-mark nil t))
+      (with-current-buffer output-buffer
+       (setq buffer-read-only nil)
+       (erase-buffer)))
+
+    (if (and (not current-buffer-p) (integerp asynchronous))
+       (prog1
+           ;; Run the process.
+           (setq p (apply 'start-file-process "*Async Shell*" buffer args))
+         ;; Display output.
+         (pop-to-buffer output-buffer)
+         (setq mode-line-process '(":%s"))
+         (shell-mode)
+         (set-process-sentinel p 'shell-command-sentinel)
+         (set-process-filter p 'comint-output-filter))
+
+      (prog1
+         ;; Run the process.
+         (apply 'process-file (car args) nil buffer nil (cdr args))
+       ;; Insert error messages if they were separated.
+       (when (listp buffer)
+         (with-current-buffer error-buffer
+           (insert-file-contents (cadr buffer)))
+         (delete-file (cadr buffer)))
+       (if current-buffer-p
+           ;; This is like exchange-point-and-mark, but doesn't
+           ;; activate the mark.  It is cleaner to avoid activation,
+           ;; even though the command loop would deactivate the mark
+           ;; because we inserted text.
+           (goto-char (prog1 (mark t)
+                        (set-marker (mark-marker) (point)
+                                    (current-buffer))))
+         ;; There's some output, display it.
+         (when (with-current-buffer output-buffer (> (point-max) (point-min)))
+           (if (functionp 'display-message-or-buffer)
+               (tramp-compat-funcall 'display-message-or-buffer output-buffer)
+             (pop-to-buffer output-buffer))))))))
+
 (defun tramp-handle-substitute-in-file-name (filename)
   "Like `substitute-in-file-name' for Tramp files.
 \"//\" and \"/~\" substitute only in the local filename part.
@@ -3403,7 +3506,7 @@ If the `tramp-methods' entry does not exist, return nil."
        (cond
          ((char-equal other-write ?w) (tramp-compat-octal-to-decimal "00002"))
         ((char-equal other-write ?-) 0)
-         (t (error "Nineth char `%c' must be one of `w-'" other-write)))
+         (t (error "Ninth char `%c' must be one of `w-'" other-write)))
        (cond
        ((char-equal other-execute-or-sticky ?x)
         (tramp-compat-octal-to-decimal "00001"))
@@ -3441,20 +3544,26 @@ If the `tramp-methods' entry does not exist, return nil."
         ;; loaded already.
         (zerop (tramp-compat-funcall 'tramp-get-remote-uid vec 'integer))))))
 
+(defun tramp-get-remote-tmpdir (vec)
+  "Return directory for temporary files on the remote host identified by VEC."
+  (with-connection-property vec "tmpdir"
+    (let ((dir (tramp-make-tramp-file-name
+               (tramp-file-name-method vec)
+               (tramp-file-name-user vec)
+               (tramp-file-name-host vec)
+               (or
+                (tramp-get-method-parameter
+                 (tramp-file-name-method vec) 'tramp-tmpdir)
+                "/tmp"))))
+      (if (and (file-directory-p dir) (file-writable-p dir))
+         dir
+       (tramp-error vec 'file-error "Directory %s not accessible" dir)))))
+
 (defun tramp-make-tramp-temp-file (vec)
   "Create a temporary file on the remote host identified by VEC.
 Return the local name of the temporary file."
-  (let ((prefix
-        (tramp-make-tramp-file-name
-         (tramp-file-name-method vec)
-         (tramp-file-name-user vec)
-         (tramp-file-name-host vec)
-         (tramp-drop-volume-letter
-          (expand-file-name
-           tramp-temp-name-prefix
-           ;; This is defined in tramp-sh.el.  Let's assume this is
-           ;; loaded already.
-           (tramp-compat-funcall 'tramp-get-remote-tmpdir vec)))))
+  (let ((prefix (expand-file-name
+                tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))
        result)
     (while (not result)
       ;; `make-temp-file' would be the natural choice for
@@ -3477,7 +3586,7 @@ Return the local name of the temporary file."
     (ignore-errors (delete-file tramp-temp-buffer-file-name))))
 
 (add-hook 'kill-buffer-hook 'tramp-delete-temp-file-function)
-(add-hook 'tramp-cache-unload-hook
+(add-hook 'tramp-unload-hook
          (lambda ()
            (remove-hook 'kill-buffer-hook
                         'tramp-delete-temp-file-function)))
@@ -3742,16 +3851,16 @@ Only works for Bourne-like shells."
 ;;   expects English?  Or just to set LC_MESSAGES to "C" if Tramp
 ;;   expects only English messages?  (Juri Linkov)
 ;; * Make shadowfile.el grok Tramp filenames.  (Bug#4526, Bug#4846)
-;; * I was wondering it it would be possible to use tramp even if I'm
+;; * I was wondering if it would be possible to use tramp even if I'm
 ;;   actually using sshfs.  But when I launch a command I would like
 ;;   to get it executed on the remote machine where the files really
 ;;   are.  (Andrea Crotti)
 ;; * Run emerge on two remote files.  Bug is described here:
 ;;   <http://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>.
 ;;   (Bug#6850)
-
-;; Functions for file-name-handler-alist:
-;; diff-latest-backup-file -- in diff.el
+;; * It would be very useful if it were possible to load or save a
+;;   buffer using Tramp in a non-blocking way so that use of Emacs on
+;;   other buffers could continue.  (Bug#9617)
 
 ;;; tramp.el ends here