From: Phil Sainty <psainty@orcon.net.nz>
Date: Fri, 12 Aug 2022 07:47:33 +0000 (+1200)
Subject: * lisp/emacs-lisp/trace.el: Allow trace context args to be forms
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=faf43bcab15df1bddcc83f954494104d5c0e6862;p=emacs.git

* lisp/emacs-lisp/trace.el: Allow trace context args to be forms

This lifts the restriction of context arguments needing to be
functions, when calling trace functions from lisp code.

(trace--read-extra-args, trace-entry-message, trace-entry-message):
Move the output formatting already used for interactive context into
the trace-*-message functions for use in non-interactive cases as
well.  Previously it was necessary for context functions to format
their output in a trace-aware manner, making a custom wrapper function
necessary to obtain well-formatted output even when the desired
context had an existing function.

(trace-function-internal, trace-make-advice): Move the generation of
an 'empty' context function into `trace-make-advice', which now takes
care of generating a function for any non-function context.

(trace-make-context): New function returning a context function for
an expression argument; extracted from `trace--read-extra-args'.
(trace--read-extra-args, trace-make-advice): Call it.

* doc/lispref/debugging.texi: Update documentation.
---

diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 8ae2d933671..6bdcf33a95d 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -1097,12 +1097,11 @@ user option, or as the @var{buffer} argument to a tracing command).
 @cindex @code{context} in trace functions
 Optional @var{context} expressions are also evaluated, both when the
 associated function is called and again when it returns, with the
-value logged alongside the call-time arguments or return value
-respectively.  This could be used to track the current buffer or
-position of point, for instance.  When trace functions are called from
-Lisp rather than interactively, @var{context} should be a function of
-no arguments which returns the value to be inserted into the trace
-output buffer.
+value logged within square brackets alongside the call-time arguments
+or return value respectively.  This could be used to track the current
+buffer or position of point, for instance.  If @var{context} is a
+function, it will be called (with no arguments) to obtain the value to
+be inserted into the trace output buffer.
 
 Finally, you may add explicit calls to @code{trace-values} to your
 code, to log arbitrary values to the trace buffer at any time.
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index d9c2a996081..fcc322ec67f 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -214,7 +214,7 @@ some global variables)."
             ;; FIXME: Make it so we can click the function name to jump to its
             ;; definition and/or untrace it.
             (cons function args)
-            context)))
+            (if context (format " [%s]" context) ""))))
 
 (defun trace-exit-message (function level value context)
   "Generate a string that describes that FUNCTION has exited.
@@ -230,7 +230,7 @@ some global variables)."
             function
             ;; Do this so we'll see strings:
             value
-            context)))
+            (if context (format " [%s]" context) ""))))
 
 (defvar trace--timer nil)
 
@@ -251,8 +251,14 @@ some global variables)."
 FUNCTION is the name of the traced function.
 BUFFER is the buffer where the trace should be printed.
 BACKGROUND if nil means to display BUFFER.
-CONTEXT if non-nil should be a function that returns extra info that should
-be printed along with the arguments in the trace."
+CONTEXT, if non-nil, should be either a function or an expression
+that returns extra info, which will be printed after the
+arguments or return value in the trace."
+  (setq context (if context
+                    (if (functionp context)
+                        context
+                      (trace-make-context context))
+                  (lambda () "")))
   (lambda (body &rest args)
     (let ((trace-level (1+ trace-level))
           (trace-buffer (get-buffer-create buffer))
@@ -289,8 +295,7 @@ be printed along with the arguments in the trace."
   "Add trace advice for FUNCTION."
   (advice-add
    function :around
-   (trace-make-advice function (or buffer trace-buffer) background
-                      (or context (lambda () "")))
+   (trace-make-advice function (or buffer trace-buffer) background context)
    `((name . ,trace-advice-name) (depth . -100))))
 
 (defun trace-is-traceable-p (sym)
@@ -334,15 +339,18 @@ Interactively, display the list as a message."
 Return (BUFFER CONTEXT)."
   (list
    (read-buffer "Output to buffer" trace-buffer)
-   (let ((exp
-          (read-from-minibuffer "Context expression: "
-                                nil read-expression-map t
-                                'read-expression-history "nil")))
-     (and exp
-          (lambda ()
-            (let ((print-circle t)
-                  (print-escape-newlines t))
-              (concat " [" (prin1-to-string (eval exp t)) "]")))))))
+   (when-let ((exp (read-from-minibuffer
+                    "Context expression: "
+                    nil read-expression-map t
+                    'read-expression-history "nil")))
+     (trace-make-context exp))))
+
+(defun trace-make-context (exp)
+  "Return a context function for expression EXP."
+  (lambda ()
+    (let ((print-circle t)
+          (print-escape-newlines t))
+      (prin1-to-string (eval exp t)))))
 
 ;;;###autoload
 (defun trace-function-foreground (function &optional buffer context)