master 70bfcbc: Tune Tramp traces

[Michael Albinus]

branch: master
commit 70bfcbcdd328775d0fcac5ec06b797e227fc032a
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    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.
---
 doc/misc/tramp.texi          | 18 +++-------------
 lisp/net/tramp-compat.el     |  5 +++--
 lisp/net/tramp.el            | 49 ++++++++++++++++++++++++++++++++++++++++++--
 test/lisp/net/tramp-tests.el | 14 +++++--------
 4 files changed, 58 insertions(+), 28 deletions(-)

diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index ebfc14d..47beb90 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 b67de1b..54cfb6f 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 741ea05..9fec151 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 3a19946..0f6f3b7 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*."