master c977337: Improve Tramp traces

[Michael Albinus]

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

    Improve Tramp traces
    
    * lisp/net/tramp-cmds.el (tramp-list-tramp-buffers):
    List also trace buffers.
    
    * lisp/net/tramp.el (tramp-buffer-name):
    Add `tramp-suppress-trace' property.
    (tramp-get-debug-file-name): Fix docstring.
    (tramp-trace-buffer-name): New defun.
    (tramp-trace-functions): New defvar.
    (tramp-debug-message): Obey also `tramp-trace-functions'.
    
    * test/lisp/net/tramp-tests.el (tramp--test-instrument-test-case):
    Handle trace buffer accordingly.
---
 lisp/net/tramp-cmds.el       |  4 +++-
 lisp/net/tramp.el            | 24 +++++++++++++++++++-----
 test/lisp/net/tramp-tests.el | 16 ++++++++--------
 3 files changed, 30 insertions(+), 14 deletions(-)

diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 1572c2f..d30d220 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -57,7 +57,9 @@ SYNTAX can be one of the symbols `default' (default),
    (all-completions
     "*tramp" (mapcar #'list (mapcar #'buffer-name (buffer-list))))
    (all-completions
-    "*debug tramp" (mapcar #'list (mapcar #'buffer-name (buffer-list))))))
+    "*debug tramp" (mapcar #'list (mapcar #'buffer-name (buffer-list))))
+   (all-completions
+    "*trace tramp" (mapcar #'list (mapcar #'buffer-name (buffer-list))))))
 
 (defun tramp-list-remote-buffers ()
   "Return a list of all buffers with remote `default-directory'."
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 9fec151..62df289 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1665,6 +1665,8 @@ See `tramp-dissect-file-name' for details."
        (format "*tramp/%s %s@%s*" method user-domain host-port)
       (format "*tramp/%s %s*" method host-port))))
 
+(put #'tramp-buffer-name 'tramp-suppress-trace t)
+
 (defun tramp-make-tramp-file-name (&rest args)
   "Construct a Tramp file name from ARGS.
 
@@ -1889,13 +1891,22 @@ The outline level is equal to the verbosity of the 
Tramp message."
 (put #'tramp-get-debug-buffer 'tramp-suppress-trace t)
 
 (defun tramp-get-debug-file-name (vec)
-  "Get the debug buffer for VEC."
+  "Get the debug file name 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-trace-buffer-name (vec)
+  "A name for the trace buffer for VEC."
+  (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 trace with tramp-verbose > 10.")
+
 (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
@@ -1922,10 +1933,13 @@ ARGUMENTS to actually emit the message (if applicable)."
                (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)))))
+           (dolist
+               (elt
+                (append
+                 (mapcar #'intern (all-completions "tramp-" obarray 
'functionp))
+                 tramp-trace-functions))
+             (unless (get elt 'tramp-suppress-trace)
+               (trace-function-background elt))))
          ;; 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)))))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 52480ba..a045b9c 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -179,6 +179,11 @@ The temporary file is not created."
   "Whether `tramp--test-instrument-test-case' run.
 This shall used dynamically bound only.")
 
+;; When `tramp-verbose' is greater than 10, and you want to trace
+;; other functions as well, do something like
+;; (let ((tramp-trace-functions '(file-name-non-special)))
+;;   (tramp--test-instrument-test-case 11
+;;     ...))
 (defmacro tramp--test-instrument-test-case (verbose &rest body)
   "Run BODY with `tramp-verbose' equal VERBOSE.
 Print the content of the Tramp connection and debug buffers, if
@@ -187,8 +192,7 @@ is greater than 10.
 `should-error' is not handled properly.  BODY shall not contain a timeout."
   (declare (indent 1) (debug (natnump body)))
   `(let* ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
-         (trace-buffer
-          (when (> tramp-verbose 10) (generate-new-buffer " *temp*")))
+         (trace-buffer (tramp-trace-buffer-name tramp-test-vec))
          (debug-ignored-errors
           (append
            '("^make-symbolic-link not supported$"
@@ -198,13 +202,9 @@ is greater than 10.
      (unwind-protect
         (let ((tramp--test-instrument-test-case-p t)) ,@body)
        ;; Unwind forms.
-       (when trace-buffer
-        (untrace-all))
        (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 
3))
-        (dolist
-            (buf (append
-                  (tramp-list-tramp-buffers)
-                  (and trace-buffer (list (get-buffer trace-buffer)))))
+        (untrace-all)
+        (dolist (buf (tramp-list-tramp-buffers))
           (with-current-buffer buf
             (message ";; %s\n%s" buf (buffer-string)))
           (kill-buffer buf))))))