From: Michael Albinus Date: Sun, 30 Jul 2023 13:10:48 +0000 (+0200) Subject: Finish Tramp reorganization X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=da608160366aaa59567b4a45b3aabb34a2370594;p=emacs.git Finish Tramp reorganization * 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. --- diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 61359562ee3..85ddb81f398 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -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 () diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 72cf4a6a4b3..71ef8215ab0 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -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. diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el index bfefd95096d..98f202102dd 100644 --- a/lisp/net/tramp-message.el +++ b/lisp/net/tramp-message.el @@ -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. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1de0e84c3db..34ecd383621 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -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)."