[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master e135f15: Tramp code cleanup
From: |
Michael Albinus |
Subject: |
master e135f15: Tramp code cleanup |
Date: |
Mon, 6 Dec 2021 13:36:24 -0500 (EST) |
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))))))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master e135f15: Tramp code cleanup,
Michael Albinus <=