From c9773379c1a598493aafcf18e4b2f2ebe579937b Mon Sep 17 00:00:00 2001
From: Michael Albinus <michael.albinus@gmx.de>
Date: Thu, 13 May 2021 16:46:17 +0200
Subject: [PATCH] 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 1572c2f3e3c..d30d22021a5 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 9fec1514221..62df2890cb1 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 52480bac7ec..a045b9c62f7 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))))))
-- 
2.39.5