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.
This commit is contained in:
parent
5be26b43f4
commit
c9773379c1
3 changed files with 30 additions and 14 deletions
|
@ -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'."
|
||||
|
|
|
@ -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)))))
|
||||
|
|
|
@ -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))))))
|
||||
|
|
Loading…
Add table
Reference in a new issue