mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-24 21:41:48 -08:00
Code Issues Projects Releases Wiki Activity

trace.el: Avoid inf-loops when tracing "core functions"

Browse source 
This makes it possible to trace at least some of the functions
used by the tracer, such as the cl-print functions.

* lisp/emacs-lisp/trace.el (trace--entry-message)
(trace--exit-message): Don't trace the tracing code.
This commit is contained in:
Stefan Monnier 2026-01-08 17:50:25 -05:00
parent 804f965577
commit 7905fc4a3d
1 changed files with 29 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

56
lisp/emacs-lisp/trace.el
View file

@ -163,36 +163,38 @@ You can call this function to add internal values in the trace buffer."
"Generate a string that describes that FUNCTION has been entered.
LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION."
(unless inhibit-trace
(trace--insert
(let ((ctx (funcall context))
(print-circle t)
(print-escape-newlines t))
(format "%s%s%d -> %s%s\n"
(mapconcat #'char-to-string
(make-string (max 0 (1- level)) ?|) " ")
(if (> level 1) " " "")
level
;; FIXME: Make it so we can click the function name to
;; jump to its definition and/or untrace it.
(cl-prin1-to-string (cons function args))
ctx)))))
(let ((inhibit-trace t))
(trace--insert
(let ((ctx (funcall context))
(print-circle t)
(print-escape-newlines t))
(format "%s%s%d -> %s%s\n"
(mapconcat #'char-to-string
(make-string (max 0 (1- level)) ?|) " ")
(if (> level 1) " " "")
level
;; FIXME: Make it so we can click the function name to
;; jump to its definition and/or untrace it.
(cl-prin1-to-string (cons function args))
ctx))))))
(defun trace--exit-message (function level value context)
"Generate a string that describes that FUNCTION has exited.
LEVEL is the trace level, VALUE value returned by FUNCTION."
(unless inhibit-trace
(trace--insert
(let ((ctx (funcall context))
(print-circle t)
(print-escape-newlines t))
(format "%s%s%d <- %s: %s%s\n"
(mapconcat 'char-to-string (make-string (1- level) ?|) " ")
(if (> level 1) " " "")
level
function
;; Do this so we'll see strings:
(cl-prin1-to-string value)
ctx)))))
(let ((inhibit-trace t))
(trace--insert
(let ((ctx (funcall context))
(print-circle t)
(print-escape-newlines t))
(format "%s%s%d <- %s: %s%s\n"
(mapconcat #'char-to-string (make-string (1- level) ?|) " ")
(if (> level 1) " " "")
level
function
;; Do this so we'll see strings:
(cl-prin1-to-string value)
ctx))))))
(defvar trace--timer nil)
@ -261,7 +263,7 @@ If `current-prefix-arg' is non-nil, also read a buffer and a \"context\"
(cons
(let ((default (function-called-at-point)))
(intern (completing-read (format-prompt prompt default)
obarray 'fboundp t nil nil
obarray #'fboundp t nil nil
(if default (symbol-name default)))))
(when current-prefix-arg
(list
@ -307,7 +309,7 @@ the output buffer or changing the window configuration."
(trace-function-internal function buffer t context))
;;;###autoload
(defalias 'trace-function 'trace-function-foreground)
(defalias 'trace-function #'trace-function-foreground)
(defun untrace-function (function)
"Untraces FUNCTION and possibly activates all remaining advice.