master e135f15: Tramp code cleanup

[Michael Albinus]

branch: master
commit e135f15aac84bcc1357fe98aea56d9e198f51e8f
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Tramp code cleanup
    
    * lisp/net/tramp.el (tramp-get-default-directory)
    (tramp-get-buffer-string): New defsubsts.
    (tramp-message, tramp-error-with-buffer)
    (tramp-file-name-for-operation, tramp-command-completion-p)
    (tramp-action-login, tramp-action-yesno, tramp-action-yn)
    (tramp-action-terminal, tramp-action-confirm-message)
    (tramp-wait-for-regexp, tramp-call-process)
    (tramp-call-process-region, tramp-read-passwd):
    * lisp/net/tramp-cmds.el (tramp-list-remote-buffers)
    (tramp-reporter-dump-variable):
    * lisp/net/tramp-gvfs.el (tramp-gvfs-monitor-process-filter):
    * lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory)
    (tramp-sh-handle-process-file, tramp-sh-handle-write-region)
    (tramp-sh-gio-monitor-process-filter):
    * lisp/net/tramp-smb.el (tramp-smb-action-set-acl):
    * lisp/net/tramp-sudoedit.el
    (tramp-sudoedit-handle-file-name-all-completions):
    * test/lisp/net/tramp-tests.el (tramp--test-instrument-test-case)
    (tramp-test32-shell-command): Use them.
---
 lisp/net/tramp-cmds.el       |  7 ++--
 lisp/net/tramp-gvfs.el       |  2 +-
 lisp/net/tramp-sh.el         | 11 +++---
 lisp/net/tramp-smb.el        |  6 ++--
 lisp/net/tramp-sudoedit.el   | 13 +++----
 lisp/net/tramp.el            | 86 +++++++++++++++++++++++++++-----------------
 test/lisp/net/tramp-tests.el |  7 ++--
 7 files changed, 74 insertions(+), 58 deletions(-)

diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 63eab1b..2eaebeb 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -67,7 +67,7 @@ SYNTAX can be one of the symbols `default' (default),
    nil
    (mapcar
     (lambda (x)
-      (with-current-buffer x (when (tramp-tramp-file-p default-directory) x)))
+      (when (tramp-tramp-file-p (tramp-get-default-directory x)) x))
     (buffer-list))))
 
 ;;;###tramp-autoload
@@ -593,9 +593,8 @@ buffer in your bug report.
 
 (defun tramp-reporter-dump-variable (varsym mailbuf)
   "Pretty-print the value of the variable in symbol VARSYM."
-  (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
-        (val (with-current-buffer reporter-eval-buffer
-               (symbol-value varsym))))
+  (when-let ((reporter-eval-buffer reporter-eval-buffer)
+            (val (buffer-local-value varsym reporter-eval-buffer)))
 
     (if (hash-table-p val)
        ;; Pretty print the cache.
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 6d83ae5..d7af0d3 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1456,7 +1456,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
 `file-notify' events."
   (let* ((events (process-get proc 'events))
         (rest-string (process-get proc 'rest-string))
-        (dd (with-current-buffer (process-buffer proc) default-directory))
+        (dd (tramp-get-default-directory (process-buffer proc)))
         (ddu (regexp-quote (tramp-gvfs-url-file-name dd))))
     (when rest-string
       (tramp-message proc 10 "Previous string:\n%s" rest-string))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 8e66363..c2a0231 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2601,7 +2601,7 @@ The method used must be an out-of-band method."
        ;; We cannot use `insert-buffer-substring' because the Tramp
        ;; buffer changes its contents before insertion due to calling
        ;; `expand-file-name' and alike.
-       (insert (with-current-buffer (tramp-get-buffer v) (buffer-string)))
+       (insert (tramp-get-buffer-string (tramp-get-buffer v)))
 
        ;; We must enable unibyte strings, because the "--dired"
        ;; output counts in bytes.
@@ -3160,8 +3160,7 @@ implementation will be used."
            (when outbuf
              (with-current-buffer outbuf
                 (insert
-                 (with-current-buffer (tramp-get-connection-buffer v)
-                   (buffer-string))))
+                (tramp-get-buffer-string (tramp-get-connection-buffer v))))
              (when (and display (get-buffer-window outbuf t)) (redisplay))))
        ;; When the user did interrupt, we should do it also.  We use
        ;; return code -1 as marker.
@@ -3475,8 +3474,7 @@ implementation will be used."
                         (not
                          (string-equal
                           (buffer-string)
-                          (with-current-buffer (tramp-get-buffer v)
-                            (buffer-string))))
+                          (tramp-get-buffer-string (tramp-get-buffer v))))
                         (tramp-error
                          v 'file-error
                          (concat "Couldn't write region to `%s',"
@@ -3770,8 +3768,7 @@ Fall back to normal file name handler if no Tramp handler 
exists."
   "Read output from \"gio monitor\" and add corresponding `file-notify' 
events."
   (let ((events (process-get proc 'events))
        (remote-prefix
-        (with-current-buffer (process-buffer proc)
-          (file-remote-p default-directory)))
+        (file-remote-p (tramp-get-default-directory (process-buffer proc))))
        (rest-string (process-get proc 'rest-string))
        pos)
     (when rest-string
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 2411953..3420307 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1436,9 +1436,9 @@ component is used as the target of the symlink."
   (unless (process-live-p proc)
     ;; Accept pending output.
     (while (tramp-accept-process-output proc))
-    (with-current-buffer (tramp-get-connection-buffer vec)
-      (tramp-message vec 10 "\n%s" (buffer-string))
-      (throw 'tramp-action 'ok))))
+    (tramp-message
+     vec 10 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
+    (throw 'tramp-action 'ok)))
 
 (defun tramp-smb-handle-set-file-acl (filename acl-string)
   "Like `set-file-acl' for Tramp files."
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 6da00f8..0309b6b 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -453,12 +453,13 @@ the result will be a local, non-Tramp, file name."
          (if (file-directory-p (expand-file-name f directory))
              (file-name-as-directory f)
            f))
-       (with-current-buffer (tramp-get-connection-buffer v)
-         (delq
-          nil
-          (mapcar
-           (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l))
-           (split-string (buffer-string) "\n" 'omit)))))))))
+       (delq
+        nil
+        (mapcar
+         (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l))
+         (split-string
+          (tramp-get-buffer-string (tramp-get-connection-buffer v))
+          "\n" 'omit))))))))
 
 (defun tramp-sudoedit-handle-file-readable-p (filename)
   "Like `file-readable-p' for Tramp files."
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 552788b..7dddd84 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1866,6 +1866,20 @@ version, the function does nothing."
        :user        ,(file-remote-p default-directory 'user)
        :machine     ,(file-remote-p default-directory 'host)))))
 
+(defsubst tramp-get-default-directory (buffer)
+  "Return `default-directory' of BUFFER."
+  (buffer-local-value 'default-directory buffer))
+
+(put #'tramp-get-default-directory 'tramp-suppress-trace t)
+
+(defsubst tramp-get-buffer-string (&optional buffer)
+  "Return contents of BUFFER.
+If BUFFER is not a buffer, return the contents of `current-buffer'."
+  (with-current-buffer (if (bufferp buffer) buffer (current-buffer))
+    (substring-no-properties (buffer-string))))
+
+(put #'tramp-get-buffer-string 'tramp-suppress-trace t)
+
 (defun tramp-debug-buffer-name (vec)
   "A name for the debug buffer for VEC."
   (let ((method (tramp-file-name-method vec))
@@ -2084,12 +2098,15 @@ applicable)."
          ;; Append connection buffer for error messages, if exists.
          (when (= level 1)
            (ignore-errors
-             (with-current-buffer
-                 (if (processp vec-or-proc)
-                     (process-buffer vec-or-proc)
-                   (tramp-get-connection-buffer vec-or-proc 'dont-create))
-               (setq fmt-string (concat fmt-string "\n%s")
-                     arguments (append arguments (list (buffer-string)))))))
+             (setq fmt-string (concat fmt-string "\n%s")
+                   arguments
+                   (append
+                    arguments
+                    `(,(tramp-get-buffer-string
+                        (if (processp vec-or-proc)
+                            (process-buffer vec-or-proc)
+                          (tramp-get-connection-buffer
+                           vec-or-proc 'dont-create))))))))
          ;; Translate proc to vec.
          (when (processp vec-or-proc)
            (setq vec-or-proc (process-get vec-or-proc 'vector))))
@@ -2151,8 +2168,8 @@ an input event arrives.  The other arguments are passed 
to `tramp-error'."
                    (and (tramp-file-name-p vec-or-proc)
                         (tramp-get-connection-buffer vec-or-proc))))
           (vec (or (and (tramp-file-name-p vec-or-proc) vec-or-proc)
-                   (and buf (with-current-buffer buf
-                              (tramp-dissect-file-name default-directory))))))
+                   (and buf (tramp-dissect-file-name
+                             (tramp-get-default-directory buf))))))
       (unwind-protect
          (apply #'tramp-error vec-or-proc signal fmt-string arguments)
        ;; Save exit.
@@ -2567,8 +2584,7 @@ Must be handled by the callers."
    ;; PROC.
    ((member operation '(file-notify-rm-watch file-notify-valid-p))
     (when (processp (nth 0 args))
-      (with-current-buffer (process-buffer (nth 0 args))
-       default-directory)))
+      (tramp-get-default-directory (process-buffer (nth 0 args)))))
    ;; VEC.
    ((member operation '(tramp-get-remote-gid tramp-get-remote-uid))
     (tramp-make-tramp-file-name (nth 0 args)))
@@ -2845,7 +2861,7 @@ whether HANDLER is to be called.  Add operations defined 
in
 (defun tramp-command-completion-p (_symbol buffer)
   "A predicate for Tramp interactive commands.
 They are completed by \"M-x TAB\" only if the current buffer is remote."
-  (with-current-buffer buffer (tramp-tramp-file-p default-directory)))
+  (tramp-tramp-file-p (tramp-get-default-directory buffer)))
 
 (defun tramp-connectable-p (vec-or-filename)
   "Check, whether it is possible to connect the remote host w/o side-effects.
@@ -4705,8 +4721,8 @@ of."
                    (save-window-excursion
                      (pop-to-buffer (tramp-get-connection-buffer vec))
                      (read-string (match-string 0)))))))
-    (with-current-buffer (tramp-get-connection-buffer vec)
-      (tramp-message vec 6 "\n%s" (buffer-string)))
+    (tramp-message
+     vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
     (tramp-message vec 3 "Sending login name `%s'" user)
     (tramp-send-string vec (concat user tramp-local-end-of-line)))
   t)
@@ -4749,8 +4765,8 @@ See also `tramp-action-yn'."
     (unless (yes-or-no-p (match-string 0))
       (kill-process proc)
       (throw 'tramp-action 'permission-denied))
-    (with-current-buffer (tramp-get-connection-buffer vec)
-      (tramp-message vec 6 "\n%s" (buffer-string)))
+    (tramp-message
+     vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
     (tramp-send-string vec (concat "yes" tramp-local-end-of-line)))
   t)
 
@@ -4763,8 +4779,8 @@ See also `tramp-action-yesno'."
     (unless (y-or-n-p (match-string 0))
       (kill-process proc)
       (throw 'tramp-action 'permission-denied))
-    (with-current-buffer (tramp-get-connection-buffer vec)
-      (tramp-message vec 6 "\n%s" (buffer-string)))
+    (tramp-message
+     vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
     (tramp-send-string vec (concat "y" tramp-local-end-of-line)))
   t)
 
@@ -4772,15 +4788,15 @@ See also `tramp-action-yesno'."
   "Tell the remote host which terminal type to use.
 The terminal type can be configured with `tramp-terminal-type'."
   (tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type)
-  (with-current-buffer (tramp-get-connection-buffer vec)
-    (tramp-message vec 6 "\n%s" (buffer-string)))
+  (tramp-message
+   vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
   (tramp-send-string vec (concat tramp-terminal-type tramp-local-end-of-line))
   t)
 
 (defun tramp-action-confirm-message (_proc vec)
   "Return RET in order to confirm the message."
-  (with-current-buffer (tramp-get-connection-buffer vec)
-    (tramp-message vec 6 "\n%s" (buffer-string)))
+  (tramp-message
+   vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
   (tramp-send-string vec tramp-local-end-of-line)
   t)
 
@@ -5068,8 +5084,8 @@ nil."
     ;; The process could have timed out, for example due to session
     ;; timeout of sudo.  The process buffer does not exist any longer then.
     (ignore-errors
-      (with-current-buffer (process-buffer proc)
-       (tramp-message proc 6 "\n%s" (buffer-string))))
+      (tramp-message
+       proc 6 "\n%s" (tramp-get-buffer-string (process-buffer proc))))
     (unless found
       (if timeout
          (tramp-error
@@ -5590,14 +5606,12 @@ are written with verbosity of 6."
        (with-temp-buffer
          (setq result
                (apply
-                #'call-process program infile (or destination t) display args))
+                #'call-process program infile (or destination t) display args)
+               output (tramp-get-buffer-string destination))
          ;; `result' could also be an error string.
          (when (stringp result)
            (setq error result
-                 result 1))
-         (with-current-buffer
-             (if (bufferp destination) destination (current-buffer))
-           (setq output (buffer-string))))
+                 result 1)))
       (error
        (setq error (error-message-string err)
             result 1)))
@@ -5628,10 +5642,10 @@ are written with verbosity of 6."
          ;; `result' could also be an error string.
          (when (stringp result)
            (signal 'file-error (list result)))
-         (with-current-buffer (if (bufferp buffer) buffer (current-buffer))
-            (if (zerop result)
-                (tramp-message vec 6 "%d" result)
-              (tramp-message vec 6 "%d\n%s" result (buffer-string)))))
+          (if (zerop result)
+              (tramp-message vec 6 "%d" result)
+            (tramp-message
+            vec 6 "%d\n%s" result (tramp-get-buffer-string buffer))))
       (error
        (setq result 1)
        (tramp-message vec 6 "%d\n%s" result (error-message-string err))))
@@ -5696,7 +5710,7 @@ Invokes `password-read' if available, `read-passwd' else."
                (format "%s for %s " (capitalize (match-string 1)) key))))
         (auth-source-creation-prompts `((secret . ,pw-prompt)))
         ;; Use connection-local value.
-        (auth-sources (with-current-buffer (process-buffer proc) auth-sources))
+        (auth-sources (buffer-local-value 'auth-sources (process-buffer proc)))
         ;; We suspend the timers while reading the password.
          (stimers (with-timeout-suspend))
         auth-info auth-passwd)
@@ -5922,5 +5936,11 @@ BODY is the backend specific code."
 ;;   and friends, for most of the handlers this is the major
 ;;   difference between the different backends.  Other handlers but
 ;;   *-process-file would profit from this as well.
+;;
+;; * Implement file name abbreviation for a different user.  That is,
+;;   (abbreviate-file-name "/ssh:user1@host:/home/user2") =>
+;;   "/ssh:user1@host:~user2".
+;;
+;; * Implement file name abbreviation for user and host names.
 
 ;;; tramp.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index c047f66..a572ff8 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -219,8 +219,7 @@ is greater than 10.
        (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 
3))
         (untrace-all)
         (dolist (buf (tramp-list-tramp-buffers))
-          (with-current-buffer buf
-            (message ";; %s\n%s" buf (buffer-string)))
+          (message ";; %s\n%s" buf (tramp-get-buffer-string buf))
           (kill-buffer buf))))))
 
 (defsubst tramp--test-message (fmt-string &rest arguments)
@@ -5054,8 +5053,8 @@ INPUT, if non-nil, is a string sent to the process."
                   "echo foo >&2; echo bar" (current-buffer) stderr)
                  (should (string-equal "bar\n" (buffer-string)))
                  ;; Check stderr.
-                 (with-current-buffer stderr
-                   (should (string-equal "foo\n" (buffer-string)))))
+                 (should
+                  (string-equal "foo\n" (tramp-get-buffer-string stderr))))
 
              ;; Cleanup.
              (ignore-errors (kill-buffer stderr))))))