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.

diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 1572c2f3e3c63c5fb0be1364615a7b8294d6a347..d30d22021a57fe8b3140341636055ef5ba4747c7 100644 (file)
--- 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 9fec151422140637a022026cd9ce60ce087c3605..62df2890cb1642c4cbb1d6fb619a6b46fee0486a 100644 (file)
--- 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 52480bac7ec8c1c09c232556a1fa164af7142933..a045b9c62f7f8c0379a3493609d0ba9e15855244 100644 (file)
--- 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))))))