Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Finish Tramp reorganization

Browse source 
* lisp/net/tramp-compat.el (subr-x): Don't require.
(top): Use `function-put' but `put'.

* lisp/net/tramp-gvfs.el (tramp-dbus-function): Add declare form.

* lisp/net/tramp-message.el (tramp-byte-run--set-suppress-trace):
New function.  Add it to `defun-declarations-alist'.
(tramp-setup-debug-buffer, tramp-debug-buffer-name)
(tramp-get-debug-buffer, tramp-get-debug-file-name)
(tramp-trace-buffer-name, tramp-debug-message, tramp-message):
Add declare form.
(tramp-debug-buffer-name): Use `tramp-string-empty-or-nil-p'.
(tramp-test-message): New defun.

* lisp/net/tramp.el (top): Use `function-put' but `put'.
(tramp-file-name-user-domain, tramp-file-name-host-port)
(tramp-file-name-port-or-default, tramp-file-name-unify)
(tramp-dissect-file-name, tramp-ensure-dissected-file-name)
(tramp-dissect-hop-name, tramp-make-tramp-file-name)
(tramp-signal-hook-function, tramp-post-process-creation)
(tramp-read-passwd, tramp-read-passwd-without-cache)
(tramp-clear-passwd): Add declare form.
(tramp-string-empty-or-nil-p): Add ;;;###tramp-autoload cookie.
(tramp-test-message): Move to tramp-message.el.
This commit is contained in:
Michael Albinus 2023-07-30 15:10:48 +02:00
parent 4038f1b40d
commit da60816036
4 changed files with 56 additions and 92 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
lisp/net/tramp-compat.el
View file

@ -34,7 +34,6 @@
(require 'format-spec)
(require 'parse-time)
(require 'shell)
(require 'subr-x)
(require 'xdg)
(declare-function tramp-error "tramp")
@ -307,7 +306,7 @@ Also see `ignore'."
"List of characters equivalent to trailing colon in \"password\" prompts."))
(dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
(put (intern elt) 'tramp-suppress-trace t))
(function-put (intern elt) 'tramp-suppress-trace t))
(add-hook 'tramp-unload-hook
(lambda ()

3
lisp/net/tramp-gvfs.el
View file

@ -951,14 +951,13 @@ Return nil for null BYTE-ARRAY."
(defun tramp-dbus-function (vec func args)
"Apply a D-Bus function FUNC from dbus.el.
The call will be traced by Tramp with trace level 6."
(declare (tramp-suppress-trace t))
(let (result)
(tramp-message vec 6 "%s" (cons func args))
(setq result (apply func args))
(tramp-message vec 6 "%s" (tramp-gvfs-stringify-dbus-message result))
result))
(put #'tramp-dbus-function 'tramp-suppress-trace t)
(defmacro with-tramp-dbus-call-method
(vec synchronous bus service path interface method &rest args)
"Apply a D-Bus call on bus BUS.

56
lisp/net/tramp-message.el
View file

@ -55,6 +55,16 @@
(declare-function tramp-get-default-directory "tramp")
(defvar tramp-compat-temporary-file-directory)
(eval-and-compile
(defalias 'tramp-byte-run--set-suppress-trace
#'(lambda (f _args val)
(list 'function-put (list 'quote f)
''tramp-suppress-trace val)))
(add-to-list
'defun-declarations-alist
(list 'tramp-suppress-trace #'tramp-byte-run--set-suppress-trace)))
;;;###tramp-autoload
(defcustom tramp-verbose 3
"Verbosity level for Tramp messages.
@ -122,8 +132,6 @@ Point must be at the beginning of a header line.
The outline level is equal to the verbosity of the Tramp message."
(1+ (string-to-number (match-string 3))))
(put #'tramp-debug-outline-level 'tramp-suppress-trace t)
;; This function takes action since Emacs 28.1, when
;; `read-extended-command-predicate' is set to
;; `command-completion-default-include-p'.
@ -135,11 +143,11 @@ They are completed by \"M-x TAB\" only in Tramp debug buffers."
(buffer-substring (point-min) (min (+ (point-min) 10) (point-max)))
";; Emacs:")))
(put #'tramp-debug-buffer-command-completion-p 'tramp-suppress-trace t)
(defun tramp-setup-debug-buffer ()
"Function to setup debug buffers."
;; (declare (completion tramp-debug-buffer-command-completion-p))
(declare (tramp-suppress-trace t))
;; (declare (completion tramp-debug-buffer-command-completion-p)
;; (tramp-suppress-trace t))
(interactive)
(set-buffer-file-coding-system 'utf-8)
(setq buffer-undo-list t)
@ -165,46 +173,40 @@ They are completed by \"M-x TAB\" only in Tramp debug buffers."
(local-set-key "\M-n" 'clone-buffer)
(add-hook 'clone-buffer-hook #'tramp-setup-debug-buffer nil 'local))
(put #'tramp-setup-debug-buffer 'tramp-suppress-trace t)
(function-put
#'tramp-setup-debug-buffer 'completion-predicate
#'tramp-debug-buffer-command-completion-p)
(defun tramp-debug-buffer-name (vec)
"A name for the debug buffer of VEC."
(declare (tramp-suppress-trace t))
(let ((method (tramp-file-name-method vec))
(user-domain (tramp-file-name-user-domain vec))
(host-port (tramp-file-name-host-port vec)))
(if (or (null user-domain) (string-empty-p user-domain))
(if (tramp-string-empty-or-nil-p user-domain)
(format "*debug tramp/%s %s*" method host-port)
(format "*debug tramp/%s %s@%s*" method user-domain host-port))))
(put #'tramp-debug-buffer-name 'tramp-suppress-trace t)
(defun tramp-get-debug-buffer (vec)
"Get the debug buffer of VEC."
(declare (tramp-suppress-trace t))
(with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec))
(when (bobp)
(tramp-setup-debug-buffer))
(current-buffer)))
(put #'tramp-get-debug-buffer 'tramp-suppress-trace t)
(defun tramp-get-debug-file-name (vec)
"Get the debug file name for VEC."
(declare (tramp-suppress-trace t))
(expand-file-name
(tramp-compat-string-replace "/" " " (tramp-debug-buffer-name vec))
tramp-compat-temporary-file-directory))
(put #'tramp-get-debug-file-name 'tramp-suppress-trace t)
(defun tramp-trace-buffer-name (vec)
"A name for the trace buffer for VEC."
(declare (tramp-suppress-trace t))
(tramp-compat-string-replace "*debug" "*trace" (tramp-debug-buffer-name vec)))
(put #'tramp-trace-buffer-name 'tramp-suppress-trace t)
(defvar tramp-trace-functions nil
"A list of non-Tramp functions to be traced with `tramp-verbose' > 10.")
@ -212,6 +214,7 @@ They are completed by \"M-x TAB\" only in Tramp debug buffers."
"Append message to debug buffer of VEC.
Message is formatted with FMT-STRING as control string and the remaining
ARGUMENTS to actually emit the message (if applicable)."
(declare (tramp-suppress-trace t))
(let ((inhibit-message t)
create-lockfiles file-name-handler-alist message-log-max
signal-hook-function)
@ -287,8 +290,6 @@ ARGUMENTS to actually emit the message (if applicable)."
(write-region
point (point-max) (tramp-get-debug-file-name vec) 'append))))))))
(put #'tramp-debug-message 'tramp-suppress-trace t)
;;;###tramp-autoload
(defun tramp-message (vec-or-proc level fmt-string &rest arguments)
"Emit a message depending on verbosity level.
@ -303,6 +304,7 @@ is greater than or equal 4.
Calls functions `message' and `tramp-debug-message' with FMT-STRING as
control string and the remaining ARGUMENTS to actually emit the message (if
applicable)."
(declare (tramp-suppress-trace t))
(ignore-errors
(when (<= level tramp-verbose)
;; Display only when there is a minimum level, and the progress
@ -453,14 +455,24 @@ the resulting error message."
(progn ,@body)
(error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
(defun tramp-test-message (fmt-string &rest arguments)
"Emit a Tramp message according `default-directory'."
(declare (tramp-suppress-trace t))
(cond
((tramp-tramp-file-p default-directory)
(apply #'tramp-message
(tramp-dissect-file-name default-directory) 0 fmt-string arguments))
((tramp-file-name-p (car tramp-current-connection))
(apply #'tramp-message
(car tramp-current-connection) 0 fmt-string arguments))
(t (apply #'message fmt-string arguments))))
(defun tramp-debug-button-action (button)
"Goto the linked message in debug buffer at place."
(when (mouse-event-p last-input-event) (mouse-set-point last-input-event))
(when-let ((point (button-get button 'position)))
(goto-char point)))
(put #'tramp-debug-button-action 'tramp-suppress-trace t)
(define-button-type 'tramp-debug-button-type
'follow-link t
'mouse-face 'highlight
@ -492,8 +504,6 @@ The link buttons are in the verbositiy level substrings."
'position (set-marker (make-marker) beg1)
'help-echo "mouse-2, RET: goto entry message"))))
(put #'tramp-debug-link-messages 'tramp-suppress-trace t)
(defvar tramp-debug-nesting ""
"Indicator for debug messages nested level.
This shouldn't be changed globally, but let-bind where needed.")
@ -515,8 +525,6 @@ Bound in `tramp-*-file-name-handler' functions.")
:type 'help-function-def
'help-args (list fun (symbol-file fun))))))
(put #'tramp-debug-message-buttonize 'tramp-suppress-trace t)
;; This is used in `tramp-file-name-handler' and `tramp-*-maybe-open-connection'.
(defmacro with-tramp-debug-message (vec message &rest body)
"Execute BODY, embedded with MESSAGE in the debug buffer of VEC.

86
lisp/net/tramp.el
View file

@ -1435,13 +1435,13 @@ calling HANDLER.")
(cl-defstruct (tramp-file-name (:type list) :named)
method user domain host port localname hop))
(put #'tramp-file-name-method 'tramp-suppress-trace t)
(put #'tramp-file-name-user 'tramp-suppress-trace t)
(put #'tramp-file-name-domain 'tramp-suppress-trace t)
(put #'tramp-file-name-host 'tramp-suppress-trace t)
(put #'tramp-file-name-port 'tramp-suppress-trace t)
(put #'tramp-file-name-localname 'tramp-suppress-trace t)
(put #'tramp-file-name-hop 'tramp-suppress-trace t)
(function-put #'tramp-file-name-method 'tramp-suppress-trace t)
(function-put #'tramp-file-name-user 'tramp-suppress-trace t)
(function-put #'tramp-file-name-domain 'tramp-suppress-trace t)
(function-put #'tramp-file-name-host 'tramp-suppress-trace t)
(function-put #'tramp-file-name-port 'tramp-suppress-trace t)
(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'.
(defconst tramp-null-hop
@ -1451,33 +1451,30 @@ calling HANDLER.")
;;;###tramp-autoload
(defun tramp-file-name-user-domain (vec)
"Return user and domain components of VEC."
(declare (tramp-suppress-trace t))
(when (or (tramp-file-name-user vec) (tramp-file-name-domain vec))
(concat (tramp-file-name-user vec)
(and (tramp-file-name-domain vec)
tramp-prefix-domain-format)
(tramp-file-name-domain vec))))
(put #'tramp-file-name-user-domain 'tramp-suppress-trace t)
;;;###tramp-autoload
(defun tramp-file-name-host-port (vec)
"Return host and port components of VEC."
(declare (tramp-suppress-trace t))
(when (or (tramp-file-name-host vec) (tramp-file-name-port vec))
(concat (tramp-file-name-host vec)
(and (tramp-file-name-port vec)
tramp-prefix-port-format)
(tramp-file-name-port vec))))
(put #'tramp-file-name-host-port 'tramp-suppress-trace t)
(defun tramp-file-name-port-or-default (vec)
"Return port component of VEC.
If nil, return `tramp-default-port'."
(declare (tramp-suppress-trace t))
(or (tramp-file-name-port vec)
(tramp-get-method-parameter vec 'tramp-default-port)))
(put #'tramp-file-name-port-or-default 'tramp-suppress-trace t)
;;;###tramp-autoload
(defun tramp-file-name-unify (vec &optional localname)
"Unify VEC by removing localname and hop from `tramp-file-name' structure.
@ -1485,6 +1482,7 @@ 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)
@ -1496,8 +1494,6 @@ same connection. Make a copy in order to avoid side effects."
(tramp-file-name-hop vec) nil))
vec))
(put #'tramp-file-name-unify 'tramp-suppress-trace t)
;; Comparison of file names is performed by `tramp-equal-remote'.
(defun tramp-file-name-equal-p (vec1 vec2)
"Check, whether VEC1 and VEC2 denote the same `tramp-file-name'.
@ -1539,8 +1535,6 @@ entry does not exist, return nil."
(string-match-p tramp-file-name-regexp name)
t))
(put #'tramp-tramp-file-p 'tramp-suppress-trace t)
;; This function bypasses the file name handler approach. It is NOT
;; recommended to use it in any package if not absolutely necessary.
;; However, it is more performant than `file-local-name', and might be
@ -1590,8 +1584,6 @@ This is METHOD, if non-nil. Otherwise, do a lookup in
result
(propertize result 'tramp-default t))))
(put #'tramp-find-method 'tramp-suppress-trace t)
(defun tramp-find-user (method user host)
"Return the right user string to use depending on METHOD and HOST.
This is USER, if non-nil. Otherwise, do a lookup in
@ -1613,8 +1605,6 @@ This is USER, if non-nil. Otherwise, do a lookup in
result
(propertize result 'tramp-default t))))
(put #'tramp-find-user 'tramp-suppress-trace t)
(defun tramp-find-host (method user host)
"Return the right host string to use depending on METHOD and USER.
This is HOST, if non-nil. Otherwise, do a lookup in
@ -1636,8 +1626,6 @@ This is HOST, if non-nil. Otherwise, do a lookup in
result
(propertize result 'tramp-default t))))
(put #'tramp-find-host 'tramp-suppress-trace t)
;;;###tramp-autoload
(defun tramp-dissect-file-name (name &optional nodefault)
"Return a `tramp-file-name' structure of NAME, a remote file name.
@ -1647,6 +1635,7 @@ localname (file name on remote host), and hop.
Unless NODEFAULT is non-nil, method, user and host are expanded
to their default values. For the other file name parts, no
default values are used."
(declare (tramp-suppress-trace t))
(save-match-data
(unless (tramp-tramp-file-p name)
(tramp-user-error nil "Not a Tramp file name: \"%s\"" name))
@ -1703,24 +1692,22 @@ default values are used."
(tramp-user-error
v "Method `%s' is not supported for multi-hops" method)))))))
(put #'tramp-dissect-file-name 'tramp-suppress-trace t)
;;;###tramp-autoload
(defun tramp-ensure-dissected-file-name (vec-or-filename)
"Return a `tramp-file-name' structure for VEC-OR-FILENAME.
VEC-OR-FILENAME may be either a string or a `tramp-file-name'.
If it's not a Tramp filename, return nil."
(declare (tramp-suppress-trace t))
(cond
((tramp-file-name-p vec-or-filename) vec-or-filename)
((tramp-tramp-file-p vec-or-filename)
(tramp-dissect-file-name vec-or-filename))))
(put #'tramp-ensure-dissected-file-name 'tramp-suppress-trace t)
(defun tramp-dissect-hop-name (name &optional nodefault)
"Return a `tramp-file-name' structure of `hop' part of NAME.
See `tramp-dissect-file-name' for details."
(declare (tramp-suppress-trace t))
(let ((v (tramp-dissect-file-name
(concat tramp-prefix-format
(replace-regexp-in-string
@ -1735,8 +1722,7 @@ See `tramp-dissect-file-name' for details."
;; Return result.
v))
(put #'tramp-dissect-hop-name 'tramp-suppress-trace t)
;;;###tramp-autoload
(defsubst tramp-string-empty-or-nil-p (string)
"Check whether STRING is empty or nil."
(or (null string) (string= string "")))
@ -1750,20 +1736,13 @@ See `tramp-dissect-file-name' for details."
(format "*tramp/%s %s*" method host-port)
(format "*tramp/%s %s@%s*" method user-domain host-port))))
(put #'tramp-buffer-name 'tramp-suppress-trace t)
;;;###tramp-autoload
(defun tramp-make-tramp-file-name (&rest args)
"Construct a Tramp file name from ARGS.
ARGS could have two different signatures. The first one is of
type (VEC &optional LOCALNAME).
If LOCALNAME is nil, the value in VEC is used. If it is a
symbol, a null localname will be used. Otherwise, LOCALNAME is
expected to be a string, which will be used.
The other signature exists for backward compatibility. It has
the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
expected to be a string, which will be used."
(declare (advertised-calling-convention (vec &optional localname) "29.1"))
(let (method user domain host port localname hop)
(cond
((tramp-file-name-p (car args))
@ -1816,9 +1795,6 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
tramp-postfix-host-format
localname)))
(set-advertised-calling-convention
#'tramp-make-tramp-file-name '(vec &optional localname) "29.1")
(defun tramp-make-tramp-hop-name (vec)
"Construct a Tramp hop name from VEC."
(concat
@ -1948,33 +1924,19 @@ does not exist, otherwise propagate the error."
(tramp-error ,vec 'file-missing ,filename)
(signal (car ,err) (cdr ,err)))))))
(defun tramp-test-message (fmt-string &rest arguments)
"Emit a Tramp message according `default-directory'."
(cond
((tramp-tramp-file-p default-directory)
(apply #'tramp-message
(tramp-dissect-file-name default-directory) 0 fmt-string arguments))
((tramp-file-name-p (car tramp-current-connection))
(apply #'tramp-message
(car tramp-current-connection) 0 fmt-string arguments))
(t (apply #'message fmt-string arguments))))
(put #'tramp-test-message 'tramp-suppress-trace t)
;; This function provides traces in case of errors not triggered by
;; Tramp functions.
(defun tramp-signal-hook-function (error-symbol data)
"Function to be called via `signal-hook-function'."
;; `custom-initialize-*' functions provoke `void-variable' errors.
;; We don't want to see them in the backtrace.
(declare (tramp-suppress-trace t))
(unless (eq error-symbol 'void-variable)
(let ((inhibit-message t))
(tramp-error
(car tramp-current-connection) error-symbol
(mapconcat (lambda (x) (format "%s" x)) data " ")))))
(put #'tramp-signal-hook-function 'tramp-suppress-trace t)
(defmacro with-parsed-tramp-file-name (filename var &rest body)
"Parse a Tramp filename and make components available in the body.
@ -4664,6 +4626,7 @@ a connection-local variable."
(defun tramp-post-process-creation (proc vec)
"Apply actions after creation of process PROC."
(declare (tramp-suppress-trace t))
(process-put proc 'tramp-vector vec)
(process-put proc 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag proc nil)
@ -4671,8 +4634,6 @@ a connection-local variable."
(when (process-command proc)
(tramp-message vec 6 "%s" (string-join (process-command proc) " "))))
(put #'tramp-post-process-creation 'tramp-suppress-trace t)
(defun tramp-direct-async-process-p (&rest args)
"Whether direct async `make-process' can be called."
(let ((v (tramp-dissect-file-name default-directory))
@ -6392,6 +6353,7 @@ verbosity of 6."
(defun tramp-read-passwd (proc &optional prompt)
"Read a password from user (compat function).
Consults the auth-source package."
(declare (tramp-suppress-trace t))
(let* (;; If `auth-sources' contains "~/.authinfo.gpg", and
;; `exec-path' contains a relative file name like ".", it
;; could happen that the "gpg" command is not found. So we
@ -6454,11 +6416,10 @@ Consults the auth-source package."
(setq tramp-password-save-function nil))
(tramp-set-connection-property vec "first-password-request" nil))))
(put #'tramp-read-passwd 'tramp-suppress-trace t)
(defun tramp-read-passwd-without-cache (proc &optional prompt)
"Read a password from user (compat function)."
;; We suspend the timers while reading the password.
(declare (tramp-suppress-trace t))
(let (tramp-dont-suspend-timers)
(with-tramp-suspended-timers
(password-read
@ -6467,10 +6428,9 @@ Consults the auth-source package."
(tramp-check-for-regexp proc tramp-password-prompt-regexp)
(match-string 0)))))))
(put #'tramp-read-passwd-without-cache 'tramp-suppress-trace t)
(defun tramp-clear-passwd (vec)
"Clear password cache for connection related to VEC."
(declare (tramp-suppress-trace t))
(let ((method (tramp-file-name-method vec))
(user-domain (tramp-file-name-user-domain vec))
(host-port (tramp-file-name-host-port vec))
@ -6483,8 +6443,6 @@ Consults the auth-source package."
:host ,host-port :port ,method))
(password-cache-remove (tramp-make-tramp-file-name vec 'noloc))))
(put #'tramp-clear-passwd 'tramp-suppress-trace t)
(defun tramp-time-diff (t1 t2)
"Return the difference between the two times, in seconds.
T1 and T2 are time values (as returned by `current-time' for example)."