From c122cc831869a9a11f50187c5cf999389b223eee Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 27 Aug 2023 10:38:31 +0200 Subject: [PATCH] Some minor Tramp changes * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): Fix error message. * lisp/net/tramp-cache.el (tramp-dump-connection-properties): Remove `tramp-null-hop'. * lisp/net/tramp-message.el (tramp-message, tramp-backtrace) (tramp-error): Handle VEC being nil. * lisp/net/tramp.el (tramp-null-hop): Add ;;;###tramp-autoload cookie. Use pseudo method "local". (tramp-file-name-unify): IF VEC is nil, set it to `tramp-null-hop'. (tramp-set-completion-function): Support also functions with METHOD as argument. (tramp-get-completion-methods): Add argument HOP. (tramp-completion-handle-file-name-all-completions): Use it. (tramp-call-process-region): Set VEC if nil. --- lisp/net/tramp-adb.el | 2 +- lisp/net/tramp-cache.el | 17 ++++++++++------ lisp/net/tramp-message.el | 24 +++++++++++------------ lisp/net/tramp.el | 41 ++++++++++++++++++++++++--------------- 4 files changed, 48 insertions(+), 36 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 076103e8ae4..3de4721ec77 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -923,7 +923,7 @@ implementation will be used." (when (string-match-p (rx multibyte) command) (tramp-error - v 'file-error "Cannot apply multi-byte command `%s'" command)) + v 'file-error "Cannot apply multibyte command `%s'" command)) (while (get-process name1) ;; NAME must be unique as process name. diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 8282e9c87ff..6ecb80f09b2 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -28,8 +28,8 @@ ;; An implementation of information caching for remote files. ;; Each connection, identified by a `tramp-file-name' structure or by -;; a process, has a unique cache. We distinguish 6 kind of caches, -;; depending on the key: +;; a process, has a unique cache. We distinguish several kinds of +;; caches, depending on the key: ;; ;; - localname is nil. These are reusable properties. Examples: ;; "remote-shell" identifies the POSIX shell to be called on the @@ -50,11 +50,14 @@ ;; definitions already sent to the remote shell, "last-cmd-time" is ;; the timestamp a command has been sent to the remote process. ;; -;; - The key is nil. These are temporary properties related to the -;; local machine. Examples: "parse-passwd" and "parse-group" keep -;; the results of parsing "/etc/passwd" and "/etc/group", +;; - The key is `tramp-null-hop' or nil. These are temporary +;; properties related to the local machine. If the key is nil, it +;; is silently converted into `tramp-null-hop'. +;; Examples: "parse-passwd" and "parse-group" keep the results of +;; parsing "/etc/passwd" and "/etc/group", ;; "{uid,gid}-{integer,string}" are the local uid and gid, and -;; "locale" is the used shell locale. +;; "locale" is the used shell locale. "user-host-completions" keeps +;; the reachable hosts for the commands in tramp-container.el. ;; ;; - The key is `tramp-cache-version'. It keeps the Tramp version the ;; cache data was produced with. If the cache is read by another @@ -568,6 +571,8 @@ PROPERTIES is a list of file properties (strings)." (stringp tramp-persistency-file-name)) (let ((cache (copy-hash-table tramp-cache-data)) print-length print-level) + ;; Remove `tramp-null-hop'. + (remhash tramp-null-hop cache) ;; Remove temporary data. If there is the key "login-as", we ;; don't save either, because all other properties might ;; depend on the login name, and we want to give the diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el index c91af638449..5b909b69ae3 100644 --- a/lisp/net/tramp-message.el +++ b/lisp/net/tramp-message.el @@ -328,9 +328,10 @@ applicable)." (process-buffer vec-or-proc) (tramp-get-connection-buffer vec-or-proc 'dont-create)))))))) - ;; Translate proc to vec. + ;; Translate proc to vec. Handle nil vec. (when (processp vec-or-proc) - (setq vec-or-proc (process-get vec-or-proc 'tramp-vector)))) + (setq vec-or-proc (process-get vec-or-proc 'tramp-vector))) + (setq vec-or-proc (tramp-file-name-unify vec-or-proc))) ;; Do it. (when (and (tramp-file-name-p vec-or-proc) (or (null tramp-debug-command-messages) (= level 6))) @@ -351,10 +352,8 @@ forces the backtrace even if `tramp-verbose' is less than 10. This function is meant for debugging purposes." (let ((tramp-verbose (if force 10 tramp-verbose))) (when (>= tramp-verbose 10) - (if vec-or-proc - (tramp-message - vec-or-proc 10 "\n%s" (with-output-to-string (backtrace))) - (with-output-to-temp-buffer "*debug tramp*" (backtrace)))))) + (tramp-message + vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))))) (defsubst tramp-error (vec-or-proc signal fmt-string &rest arguments) "Emit an error. @@ -370,13 +369,12 @@ FMT-STRING and ARGUMENTS." ;; character, as in smb domain spec. (setq arguments (list fmt-string) fmt-string "%s")) - (when vec-or-proc - (tramp-message - vec-or-proc 1 "%s" - (error-message-string - (list signal - (get signal 'error-message) - (apply #'format-message fmt-string arguments))))) + (tramp-message + vec-or-proc 1 "%s" + (error-message-string + (list signal + (get signal 'error-message) + (apply #'format-message fmt-string arguments)))) (signal signal (list (substring-no-properties (apply #'format-message fmt-string arguments)))))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 30602c353b3..05d28e8494f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1190,7 +1190,7 @@ The `ftp' syntax does not support methods.") ;; We cannot use `tramp-prefix-regexp', because it starts with `bol'. (literal tramp-prefix-format) - ;; Optional multi hops. + ;; Optional multi-hops. (* (regexp tramp-remote-file-name-spec-regexp) (regexp tramp-postfix-hop-regexp)) @@ -1457,10 +1457,12 @@ calling HANDLER.") (function-put #'tramp-file-name-localname 'tramp-suppress-trace t) (function-put #'tramp-file-name-hop 'tramp-suppress-trace t) -;; Needed for `tramp-read-passwd' and `tramp-get-remote-null-device'. +;;;###tramp-autoload (defconst tramp-null-hop - (make-tramp-file-name :user (user-login-name) :host tramp-system-name) -"Connection hop which identifies the virtual hop before the first one.") + (make-tramp-file-name + :method "local" :user (user-login-name) :host tramp-system-name) + "Connection hop which identifies the virtual hop before the first one. +Used also for caching properties of the local machine.") (defun tramp-file-name-user-domain (vec) "Return user and domain components of VEC." @@ -1490,14 +1492,17 @@ If nil, return `tramp-default-port'." ;;;###tramp-autoload (defun tramp-file-name-unify (vec &optional localname) "Unify VEC by removing localname and hop from `tramp-file-name' structure. -If LOCALNAME is an absolute file name, set it as localname. If -LOCALNAME is a relative file name, return `tramp-cache-undefined'. -Objects returned by this function compare `equal' if they refer to the -same connection. Make a copy in order to avoid side effects." +IF VEC is nil, set it to `tramp-null-hop'. +If LOCALNAME is an absolute file name, set it as localname. +If LOCALNAME is a relative file name, return `tramp-cache-undefined'. +Objects returned by this function compare `equal' if they refer +to the same connection. Make a copy in order to avoid side +effects." ;; (declare (tramp-suppress-trace t)) (if (and (stringp localname) (not (file-name-absolute-p localname))) (setq vec tramp-cache-undefined) + (unless vec (setq vec tramp-null-hop)) (when (tramp-file-name-p vec) (setq vec (copy-tramp-file-name vec)) (setf (tramp-file-name-localname vec) @@ -2134,6 +2139,8 @@ Example: ;; DNS-SD service type. ((string-match-p tramp-dns-sd-service-regexp (nth 1 (car v)))) + ;; Method. + ((string-equal method (nth 1 (car v)))) ;; Configuration file or empty string. (t (file-exists-p (nth 1 (car v)))))) (setq r (delete (car v) r))) @@ -2774,16 +2781,14 @@ not in completion mode." ;; Possible methods. (setq result - (append result (tramp-get-completion-methods m))))))) + (append result (tramp-get-completion-methods m hop))))))) ;; Unify list, add hop, remove nil elements. (dolist (elt result) (when elt - (string-match tramp-prefix-regexp elt) - (setq elt (replace-match (concat tramp-prefix-format hop) nil nil elt)) - (push - (substring elt (length (tramp-drop-volume-letter directory))) - result1))) + (setq elt (replace-regexp-in-string + tramp-prefix-regexp (concat tramp-prefix-format hop) elt)) + (push (substring elt (length directory)) result1))) ;; Complete local parts. (delete-dups @@ -2911,11 +2916,14 @@ remote host and localname (filename on remote host)." ;; This function returns all possible method completions, adding the ;; trailing method delimiter. -(defun tramp-get-completion-methods (partial-method) - "Return all method completions for PARTIAL-METHOD." +(defun tramp-get-completion-methods (partial-method hop) + "Return all method completions for PARTIAL-METHOD. +If HOP is non-nil, return only multi-hop capable methods." (mapcar (lambda (method) (and method (string-prefix-p (or partial-method "") method) + (or (not hop) + (tramp-multi-hop-p (make-tramp-file-name :method method))) (tramp-completion-make-tramp-file-name method nil nil nil))) (mapcar #'car tramp-methods))) @@ -6380,6 +6388,7 @@ are written with verbosity of 6." (temporary-file-directory tramp-compat-temporary-file-directory) (process-environment (default-toplevel-value 'process-environment)) (buffer (if (eq buffer t) (current-buffer) buffer)) + (vec (or vec (car tramp-current-connection))) result) (tramp-message vec 6 "`%s %s' %s %s %s %s" -- 2.39.5