commit e4e8a1e834d7c83341450b65d06e088c92f4316e (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Fri May 7 22:41:44 2021 -0400 * lisp/gnus/nnoo.el (defvoo, deffoo): Add `doc-string` property diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el index 7759951662..4e8490125f 100644 --- a/lisp/gnus/nnoo.el +++ b/lisp/gnus/nnoo.el @@ -34,6 +34,7 @@ (defmacro defvoo (var init &optional doc &rest map) "The same as `defvar', only takes list of variables to MAP to." (declare (indent 2) + (doc-string 3) (debug (var init &optional doc &rest map))) `(prog1 ,(if doc @@ -44,6 +45,7 @@ (defmacro deffoo (func args &rest forms) "The same as `defun', only register FUNC." (declare (indent 2) + (doc-string 3) (debug (&define name lambda-list def-body))) `(prog1 (defun ,func ,args ,@forms) commit 048cc03290abc786f439ee9838c15a81541af2aa Author: Jim Porter Date: Mon May 3 08:24:01 2021 -0700 Ensure ` ' handles rectangular regions * lisp/delsel.el (delete-active-region): Autoload it and make it interactive. * lisp/menu-bar.el (menu-bar-edit-menu): Bind "Clear" to `delete-active-region'. diff --git a/etc/NEWS b/etc/NEWS index d5519de421..9f4ded3aab 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -298,6 +298,9 @@ prompt, and how you can tweak the file size threshold. +++ ** A prefix arg now causes 'delete-other-frames' to only iconify frames ++++ +** The "Edit => Clear" menu item now obeys a rectangular region + +++ ** New command 'execute-extended-command-for-buffer'. This new command, bound to 'M-S-x', works like diff --git a/lisp/delsel.el b/lisp/delsel.el index 982320340d..96a9dcc0c7 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -84,9 +84,11 @@ information on adapting behavior of commands in Delete Selection mode." (defvar delsel--replace-text-or-position nil) +;;;###autoload (defun delete-active-region (&optional killp) "Delete the active region. If KILLP in not-nil, the active region is killed instead of deleted." + (interactive "P") (cond (killp ;; Don't allow `kill-region' to change the value of `this-command'. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index d8cdeb101a..ef7235cffa 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -492,7 +492,7 @@ '(menu-item "Select All" mark-whole-buffer :help "Mark the whole buffer for a subsequent cut/copy")) (bindings--define-key menu [clear] - '(menu-item "Clear" delete-region + '(menu-item "Clear" delete-active-region :enable (and mark-active (not buffer-read-only)) :help commit a2842a11728336fc8110eedb5176ecfbe71bbc79 Author: Philipp Stephani Date: Fri May 7 18:36:57 2021 +0200 Don't use symbolic links in the test resource directory. This doesn't work on Windows. Instead, use the EMACS_TEST_DIRECTORY environment variable to find the BPF files. * test/src/emacs-tests.el (emacs-tests--lib-src): New constant. (emacs-tests/seccomp/allows-stdout) (emacs-tests/seccomp/forbids-subprocess) (emacs-tests/bwrap/allows-stdout): Use it. diff --git a/test/src/emacs-resources/seccomp-filter-exec.bpf b/test/src/emacs-resources/seccomp-filter-exec.bpf deleted file mode 120000 index 5b0e997822..0000000000 --- a/test/src/emacs-resources/seccomp-filter-exec.bpf +++ /dev/null @@ -1 +0,0 @@ -../../../lib-src/seccomp-filter-exec.bpf \ No newline at end of file diff --git a/test/src/emacs-resources/seccomp-filter.bpf b/test/src/emacs-resources/seccomp-filter.bpf deleted file mode 120000 index b3d603d0ae..0000000000 --- a/test/src/emacs-resources/seccomp-filter.bpf +++ /dev/null @@ -1 +0,0 @@ -../../../lib-src/seccomp-filter.bpf \ No newline at end of file diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el index ee5586fbaf..ac08e055b5 100644 --- a/test/src/emacs-tests.el +++ b/test/src/emacs-tests.el @@ -25,10 +25,13 @@ (require 'cl-lib) (require 'ert) -(require 'ert-x) (require 'rx) (require 'subr-x) +(defconst emacs-tests--lib-src + (substitute-in-file-name "$EMACS_TEST_DIRECTORY/../lib-src/") + "Location of the lib-src directory.") + (ert-deftest emacs-tests/seccomp/absent-file () (skip-unless (string-match-p (rx bow "SECCOMP" eow) system-configuration-features)) @@ -135,7 +138,8 @@ to `make-temp-file', which see." system-configuration-features)) (let ((emacs (expand-file-name invocation-name invocation-directory)) - (filter (ert-resource-file "seccomp-filter.bpf")) + (filter (expand-file-name "seccomp-filter.bpf" + emacs-tests--lib-src)) (process-environment nil)) (skip-unless (file-executable-p emacs)) (skip-unless (file-readable-p filter)) @@ -160,7 +164,8 @@ to `make-temp-file', which see." system-configuration-features)) (let ((emacs (expand-file-name invocation-name invocation-directory)) - (filter (ert-resource-file "seccomp-filter.bpf")) + (filter (expand-file-name "seccomp-filter.bpf" + emacs-tests--lib-src)) (process-environment nil)) (skip-unless (file-executable-p emacs)) (skip-unless (file-readable-p filter)) @@ -186,7 +191,8 @@ to `make-temp-file', which see." (bwrap (executable-find "bwrap")) (emacs (expand-file-name invocation-name invocation-directory)) - (filter (ert-resource-file "seccomp-filter-exec.bpf")) + (filter (expand-file-name "seccomp-filter-exec.bpf" + emacs-tests--lib-src)) (process-environment nil)) (skip-unless bash) (skip-unless bwrap) commit 9457d4f20f1f3da8450924cfe1f776fdd04261bb Author: Michael Albinus Date: Fri May 7 17:25:49 2021 +0200 Tramp: Fix file name quoting on MS Windows * lisp/net/tramp-sh.el (tramp-make-copy-program-file-name): Use `tramp-unquote-shell-quote-argument'. * lisp/net/tramp.el (tramp-unquote-shell-quote-argument): Adapt for MS Windows. * test/lisp/net/tramp-tests.el (tramp--test-special-characters): Adapt for MS Windows. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3ce74a2cf1..60090d31b8 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5266,7 +5266,7 @@ Return ATTR." ;; to be quoted. OpenSSH 8 supports disabling of strict file name ;; checking in scp, we use it when available. (unless (string-match-p "ftp$" method) - (setq localname (shell-quote-argument localname))) + (setq localname (tramp-unquote-shell-quote-argument localname))) (cond ((tramp-get-method-parameter vec 'tramp-remote-copy-program) localname) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9fec151422..5d62a1fb3d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -5476,8 +5476,12 @@ T1 and T2 are time values (as returned by `current-time' for example)." "Remove quotation prefix \"/:\" from string S, and quote it then for shell. Suppress `shell-file-name'. This is needed on w32 systems, which would use a wrong quoting for local file names. See `w32-shell-name'." - (let (shell-file-name) - (shell-quote-argument (tramp-compat-file-name-unquote s)))) + (if (eq system-type 'windows-nt) + (let ((result (tramp-compat-file-name-unquote s))) + (setq result (tramp-compat-string-replace "\"" "\"\"" result)) + (concat "\"" result "\"")) + (let (shell-file-name) + (shell-quote-argument (tramp-compat-file-name-unquote s))))) ;; Currently (as of Emacs 20.5), the function `shell-quote-argument' ;; does not deal well with newline characters. Newline is replaced by diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 0f6f3b7980..03915d7a3f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5882,6 +5882,7 @@ This requires restrictions of file name syntax." (make-directory tmp-name2) (dolist (elt files) + ;(tramp--test-message "%s" elt) (let* ((file1 (expand-file-name elt tmp-name1)) (file2 (expand-file-name elt tmp-name2)) (file3 (expand-file-name (concat elt "foo") tmp-name1))) @@ -6071,7 +6072,8 @@ This requires restrictions of file name syntax." "\tfoo bar baz\t") (t " foo\tbar baz\t")) "@foo@bar@baz@" - "$foo$bar$$baz$" + (unless (tramp--test-windows-nt-and-scp-p) + "$foo$bar$$baz$") "-foo-bar-baz-" "%foo%bar%baz%" "&foo&bar&baz&" @@ -6087,9 +6089,10 @@ This requires restrictions of file name syntax." "'foo'bar'baz'" "'foo\"bar'baz\"") "#foo~bar#baz~" - (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) - "!foo!bar!baz!" - "!foo|bar!baz|") + (unless (tramp--test-windows-nt-and-scp-p) + (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) + "!foo!bar!baz!" + "!foo|bar!baz|")) (if (or (tramp--test-gvfs-p) (tramp--test-rclone-p) (tramp--test-windows-nt-or-smb-p)) @@ -6110,7 +6113,6 @@ This requires restrictions of file name syntax." "Check special characters in file names." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-rsync-p))) -; (skip-unless (not (tramp--test-windows-nt-and-scp-p))) (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p)))) (tramp--test-special-characters)) @@ -6122,7 +6124,6 @@ Use the `stat' command." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-rsync-p))) -; (skip-unless (not (tramp--test-windows-nt-and-scp-p))) ;; We cannot use `tramp-test-vec', because this fails during compilation. (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil (skip-unless (tramp-get-remote-stat v))) @@ -6141,7 +6142,6 @@ Use the `perl' command." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-rsync-p))) -; (skip-unless (not (tramp--test-windows-nt-and-scp-p))) ;; We cannot use `tramp-test-vec', because this fails during compilation. (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil (skip-unless (tramp-get-remote-perl v))) @@ -6163,7 +6163,6 @@ Use the `ls' command." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-rsync-p))) -; (skip-unless (not (tramp--test-windows-nt-and-scp-p))) (let ((tramp-connection-properties (append commit 615cf550f22f78d123acb1e8e90be6c69699dbee Author: Eli Zaretskii Date: Fri May 7 17:09:44 2021 +0300 Fix a recent change in rmc.el * lisp/emacs-lisp/rmc.el (read-multiple-choice): Doc fix. Improve the message when entering recursive-edit. diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el index 6aa169c032..8abe570e64 100644 --- a/lisp/emacs-lisp/rmc.el +++ b/lisp/emacs-lisp/rmc.el @@ -27,36 +27,37 @@ ;;;###autoload (defun read-multiple-choice (prompt choices &optional help-string) - "Ask user a multiple choice question. -PROMPT should be a string that will be displayed as the prompt. - -CHOICES is a list of (KEY NAME [DESCRIPTION]). KEY is a -character to be entered. NAME is a short name for the entry to -be displayed while prompting (if there's room, it might be -shortened). DESCRIPTION is an optional longer explanation for -the entry that will be displayed in a help buffer if the user -requests more help. This help description has a fixed format in -columns, but, for greater flexibility, instead of passing a -DESCRIPTION, the user can use the optional argument HELP-STRING. -This argument is a string that contains the text with the -complete description of all choices. `read-multiple-choice' will -display that description in a help buffer if the user requests -it. + "Ask user to select an entry from CHOICES, promting with PROMPT. +This function allows to ask the user a multiple-choice question. + +CHOICES should be a list of the form (KEY NAME [DESCRIPTION]). +KEY is a character the user should type to select the entry. +NAME is a short name for the entry to be displayed while prompting +\(if there's no room, it might be shortened). +DESCRIPTION is an optional longer description of the entry; it will +be displayed in a help buffer if the user requests more help. This +help description has a fixed format in columns. For greater +flexibility, instead of passing a DESCRIPTION, the caller can pass +the optional argument HELP-STRING. This argument is a string that +should contain a more detailed description of all of the possible +choices. `read-multiple-choice' will display that description in a +help buffer if the user requests that. This function translates user input into responses by consulting the bindings in `query-replace-map'; see the documentation of -that variable for more information. In this case, the useful -bindings are `recenter', `scroll-up', `scroll-down', and `edit'. -If the user enters `recenter', `scroll-up', or `scroll-down' -responses, perform the requested window recentering or scrolling -and ask again. If the user enters `edit', start a recursive -edit. When the user exit the recursive edit, the multiple choice -prompt gains focus again. - -When `use-dialog-box' is t (the default), this function can pop -up a dialog window to collect the user input. That functionality -requires `display-popup-menus-p' to return t. Otherwise, a -text dialog will be used. +that variable for more information. The relevant bindings for the +purposes of this function are `recenter', `scroll-up', `scroll-down', +and `edit'. +If the user types the `recenter', `scroll-up', or `scroll-down' +responses, the function performs the requested window recentering or +scrolling, and then asks the question again. If the user enters `edit', +the function starts a recursive edit. When the user exit the recursive +edit, the multiple-choice prompt gains focus again. + +When `use-dialog-box' is t (the default), and the command using this +function was invoked via the mouse, this function pops up a GUI dialog +to collect the user input, but only if Emacs is capable of using GUI +dialogs. Otherwise, the function will always use text-mode dialogs. The return value is the matching entry from the CHOICES list. @@ -146,7 +147,7 @@ Usage example: (save-excursion (message "%s" (substitute-command-keys - "Recursive edit. Resume with \\[exit-recursive-edit]")) + "Recursive edit; type \\[exit-recursive-edit] to return to help screen")) (recursive-edit)))) (t tchar))) (when (eq tchar t) commit f50577ea07fd85a1798cc2d41251ab1418fd802f Author: Michael Albinus Date: Fri May 7 14:31:17 2021 +0200 Fix some annoyances wrt file-name-non-special * lisp/files.el (file-name-non-special): Do not expand `file-truename'. * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Use local `default-directory' for `start-process'. diff --git a/lisp/files.el b/lisp/files.el index 27074beffc..93a0e07aba 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -7559,7 +7559,10 @@ only these files will be asked to be saved." (setq file-arg-indices (cdr file-arg-indices)))) (pcase method ('identity (car arguments)) - ('add (file-name-quote (apply operation arguments) t)) + ('add + ;; This is `file-truename'. We don't want file name handlers + ;; to expand this. + (file-name-quote (let (tramp-mode) (apply operation arguments)) t)) ('buffer-file-name (let ((buffer-file-name (file-name-unquote buffer-file-name t))) (apply operation arguments))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 57be9ecf00..3ce74a2cf1 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2371,11 +2371,12 @@ The method used must be an out-of-band method." ;; can be handled. We don't set a timeout, because ;; the copying of large files can last longer than 60 ;; secs. - p (apply - #'start-process - (tramp-get-connection-name v) - (tramp-get-connection-buffer v) - copy-program copy-args)) + p (let ((default-directory (tramp-compat-temporary-file-directory))) + (apply + #'start-process + (tramp-get-connection-name v) + (tramp-get-connection-buffer v) + copy-program copy-args))) (tramp-message orig-vec 6 "%s" (string-join (process-command p) " ")) (process-put p 'vector orig-vec) (process-put p 'adjust-window-size-function #'ignore) commit 3ad239e1bc1228407ae656440327a29e7373f977 Author: Lars Ingebrigtsen Date: Fri May 7 13:17:12 2021 +0200 `mail-envelope-from' doc clarification * lisp/mail/sendmail.el (mail-envelope-from): Note that the buffer should be narrowed before calling (bug#47616). diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 9a4c8f3c66..a64f086998 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -962,7 +962,10 @@ the user from the mailer." (defun mail-envelope-from () "Return the envelope mail address to use when sending mail. -This function uses `mail-envelope-from'." +This function uses the `mail-envelope-from' variable. + +The buffer should be narrowed to the headers of the mail message +before this function is called." (if (eq mail-envelope-from 'header) (nth 1 (mail-extract-address-components (mail-fetch-field "From"))) commit 70bfcbcdd328775d0fcac5ec06b797e227fc032a Author: Michael Albinus Date: Fri May 7 13:04:28 2021 +0200 Tune Tramp traces * doc/misc/tramp.texi (Traces and Profiles): Describe call traces. * lisp/net/tramp-compat.el: Add `tramp-suppress-trace' property for all functions. * lisp/net/tramp.el (tramp-verbose): Adapt docstring. (tramp-file-name-method, tramp-file-name-user) (tramp-file-name-domain, tramp-file-name-host) (tramp-file-name-port, tramp-file-name-localname) (tramp-file-name-hop, tramp-file-name-user-domain) (tramp-file-name-host-port, tramp-file-name-port-or-default) (tramp-tramp-file-p, tramp-find-method, tramp-find-user) (tramp-find-host, tramp-dissect-file-name) (tramp-dissect-hop-name, tramp-debug-buffer-name) (tramp-debug-outline-level, tramp-get-debug-buffer) (tramp-get-debug-file-name, tramp-read-passwd) (tramp-clear-passwd): Add `tramp-suppress-trace' property. (tramp-debug-message): Activate call traces. * test/lisp/net/tramp-tests.el (tramp--test-instrument-test-case): Simplify. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index ebfc14d936..47beb90e6c 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5336,6 +5336,7 @@ The verbosity levels are @*@indent @w{ 8} connection properties @*@indent @w{ 9} test commands @*@indent @w{10} traces (huge) +@*@indent @w{11} call traces (maintainer only) With @code{tramp-verbose} greater than or equal to 4, messages are also written to a @value{tramp} debug buffer. Such debug buffers are @@ -5384,21 +5385,8 @@ The debug buffer is written as a file in your this option with care, because it could decrease the performance of @value{tramp} actions. -To enable stepping through @value{tramp} function call traces, they -have to be specifically enabled as shown in this code: - -@lisp -@group -(require 'trace) -(dolist (elt (all-completions "tramp-" obarray 'functionp)) - (trace-function-background (intern elt))) -(untrace-function 'tramp-read-passwd) -@end group -@end lisp - -The buffer @file{*trace-output*} contains the output from the function -call traces. Disable @code{tramp-read-passwd} to stop password -strings from being written to @file{*trace-output*}. +If @code{tramp-verbose} is greater than or equal to 11, @value{tramp} +function call traces are written to the buffer @file{*trace-output*}. @node GNU Free Documentation License diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index b67de1bd21..54cfb6fb4a 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -63,8 +63,6 @@ `(when (functionp ,function) (with-no-warnings (funcall ,function ,@arguments)))) -(put #'tramp-compat-funcall 'tramp-suppress-trace t) - (defsubst tramp-compat-temporary-file-directory () "Return name of directory for temporary files. It is the default value of `temporary-file-directory'." @@ -355,6 +353,9 @@ A nil value for either argument stands for the current time." (lambda (fromstring tostring instring) (replace-regexp-in-string (regexp-quote fromstring) tostring instring)))) +(dolist (elt (all-completions "tramp-compat-" obarray 'functionp)) + (put (intern elt) 'tramp-suppress-trace t)) + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-loaddefs 'force) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 741ea05cea..9fec151422 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -109,7 +109,8 @@ Any level x includes messages for all levels 1 .. x-1. The levels are 7 file caching 8 connection properties 9 test commands -10 traces (huge)." +10 traces (huge) +11 call traces (maintainer only)." :type 'integer) (defcustom tramp-debug-to-file nil @@ -1390,6 +1391,14 @@ 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) + (defun tramp-file-name-user-domain (vec) "Return user and domain components of VEC." (when (or (tramp-file-name-user vec) (tramp-file-name-domain vec)) @@ -1398,6 +1407,8 @@ calling HANDLER.") tramp-prefix-domain-format) (tramp-file-name-domain vec)))) +(put #'tramp-file-name-user-domain 'tramp-suppress-trace t) + (defun tramp-file-name-host-port (vec) "Return host and port components of VEC." (when (or (tramp-file-name-host vec) (tramp-file-name-port vec)) @@ -1406,12 +1417,16 @@ calling HANDLER.") 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'." (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) + ;; 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'." @@ -1458,6 +1473,8 @@ 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 @@ -1506,6 +1523,8 @@ 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 @@ -1527,6 +1546,8 @@ 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 @@ -1548,6 +1569,8 @@ 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) + (defun tramp-dissect-file-name (name &optional nodefault) "Return a `tramp-file-name' structure of NAME, a remote file name. The structure consists of method, user, domain, host, port, @@ -1612,6 +1635,8 @@ 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) + (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." @@ -1629,6 +1654,8 @@ See `tramp-dissect-file-name' for details." ;; Return result. v)) +(put #'tramp-dissect-hop-name 'tramp-suppress-trace t) + (defun tramp-buffer-name (vec) "A name for the connection buffer VEC." (let ((method (tramp-file-name-method vec)) @@ -1805,6 +1832,8 @@ version, the function does nothing." (format "*debug tramp/%s %s@%s*" method user-domain host-port) (format "*debug tramp/%s %s*" method host-port)))) +(put #'tramp-debug-buffer-name 'tramp-suppress-trace t) + (defconst tramp-debug-outline-regexp (concat "[[:digit:]]+:[[:digit:]]+:[[:digit:]]+\\.[[:digit:]]+ " ;; Timestamp. @@ -1830,6 +1859,8 @@ 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 2)))) +(put #'tramp-debug-outline-level 'tramp-suppress-trace t) + (defun tramp-get-debug-buffer (vec) "Get the debug buffer for VEC." (with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec)) @@ -1855,12 +1886,16 @@ The outline level is equal to the verbosity of the Tramp message." (use-local-map special-mode-map)) (current-buffer))) +(put #'tramp-get-debug-buffer 'tramp-suppress-trace t) + (defun tramp-get-debug-file-name (vec) "Get the debug buffer for VEC." (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-debug-message (vec fmt-string &rest arguments) "Append message to debug buffer of VEC. Message is formatted with FMT-STRING as control string and the remaining @@ -1871,8 +1906,8 @@ ARGUMENTS to actually emit the message (if applicable)." (with-current-buffer (tramp-get-debug-buffer vec) (goto-char (point-max)) (let ((point (point))) - ;; Headline. (when (bobp) + ;; Headline. (insert (format ";; Emacs: %s Tramp: %s -*- mode: outline; coding: utf-8; -*-" @@ -1885,6 +1920,12 @@ ARGUMENTS to actually emit the message (if applicable)." (locate-library "tramp") (or tramp-repository-branch "") (or tramp-repository-version ""))))) + ;; Traces. + (when (>= tramp-verbose 11) + (dolist (elt (all-completions "tramp-" obarray 'functionp)) + (let ((fn (intern elt))) + (unless (get fn 'tramp-suppress-trace) + (trace-function-background fn))))) ;; Delete debug file. (when (and tramp-debug-to-file (tramp-get-debug-file-name vec)) (ignore-errors (delete-file (tramp-get-debug-file-name vec))))) @@ -5408,6 +5449,8 @@ Invokes `password-read' if available, `read-passwd' else." ;; Reenable the timers. (with-timeout-unsuspend stimers)))) +(put #'tramp-read-passwd 'tramp-suppress-trace t) + (defun tramp-clear-passwd (vec) "Clear password cache for connection related to VEC." (let ((method (tramp-file-name-method vec)) @@ -5422,6 +5465,8 @@ Invokes `password-read' if available, `read-passwd' else." :host ,host-port :port ,method)) (password-cache-remove (tramp-make-tramp-file-name vec 'noloc 'nohop)))) +(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)." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 3a199469d6..0f6f3b7980 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -195,9 +195,6 @@ is greater than 10. "^error with add-name-to-file") debug-ignored-errors)) inhibit-message) - (when trace-buffer - (dolist (elt (all-completions "tramp-" obarray 'functionp)) - (trace-function-background (intern elt)))) (unwind-protect (let ((tramp--test-instrument-test-case-p t)) ,@body) ;; Unwind forms. @@ -205,13 +202,12 @@ is greater than 10. (untrace-all)) (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3)) (dolist - (buf (if trace-buffer - (cons (get-buffer trace-buffer) (tramp-list-tramp-buffers)) - (tramp-list-tramp-buffers))) + (buf (append + (tramp-list-tramp-buffers) + (and trace-buffer (list (get-buffer trace-buffer))))) (with-current-buffer buf - (message ";; %s\n%s" buf (buffer-string))))) - (when trace-buffer - (kill-buffer trace-buffer))))) + (message ";; %s\n%s" buf (buffer-string))) + (kill-buffer buf)))))) (defsubst tramp--test-message (fmt-string &rest arguments) "Emit a message into ERT *Messages*."