bug#27397: [PATCH] New commands for bulk tracing of elisp functions

[Phil Sainty <psainty@orcon.net.nz>]

[-- Attachment #1: Type: text/plain, Size: 861 bytes --]

On 17/06/17 21:20, Phil Sainty wrote:
> inconsistent with `trace--read-args' which uses a prefix arg to prompt
> the user for the trace buffer and a context expression -- which I now
> realise is behaviour that my commands should incorporate as well.

I've implemented this change, and attached the current WIP patch.

In the process I noticed that the existing behaviour of trace--read-args
was quite unfriendly if you wanted to set a trace buffer but had no need
of a context expression -- typing RET at the context expression prompt
triggered an "End of file during parsing" error, as that input string
is processed by `read-from-string'.

I've changed that code to treat an empty input as "nil" (which is read
to `nil'), and to ignore `nil' context expressions entirely (as opposed
to printing their evaluated value as "[nil]" in the trace buffer).


-Phil

[-- Attachment #2: 0001-New-commands-for-bulk-tracing-of-elisp-functions.patch --]
[-- Type: text/x-patch, Size: 9590 bytes --]

From 4d9ea7ac95b070d55b8e1502c3091168891f433e Mon Sep 17 00:00:00 2001
From: Phil Sainty <psainty@orcon.net.nz>
Date: Sun, 11 Jun 2017 17:29:53 +1200
Subject: [PATCH] New commands for bulk tracing of elisp functions

* lisp/emacs-lisp/trace.el (trace-package, untrace-package)
(trace-regexp, untrace-regexp, trace-is-traceable-p): New functions.

(trace--read-extra-args): New function, split from `trace--read-args'.
Changed to allow the user to enter an empty string at the context
expression prompt (previously an error; now treated as "nil"), and to
cause a "nil" context expression to produce no context output in the
trace buffer.

(trace--read-function-args): New name for `trace--read-args'.
Changed to use the new `trace-is-traceable-p' predicate.
(trace--read-args): Renamed to `trace--read-function-args'
(trace-function-foreground, trace-function-background): Call the
renamed `trace--read-function-args'.

(trace-is-traced, untrace-function, untrace-all): Doc updates/fixes.

* etc/NEWS: Mention the new trace commands.

* doc/misc/tramp.texi: Update "(tramp) Traces and Profiles" to use
`trace-package'.
---
 doc/misc/tramp.texi      |   4 +-
 etc/NEWS                 |   8 +++
 lisp/emacs-lisp/trace.el | 133 ++++++++++++++++++++++++++++++++++++++++-------
 3 files changed, 123 insertions(+), 22 deletions(-)

diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 4ca3932..54d5d00 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -3672,9 +3672,7 @@ Traces and Profiles
 
 @lisp
 @group
-(require 'trace)
-(dolist (elt (all-completions "tramp-" obarray 'functionp))
-  (trace-function-background (intern elt)))
+(trace-package "tramp-")
 (untrace-function 'tramp-read-passwd)
 @end group
 @end lisp
diff --git a/etc/NEWS b/etc/NEWS
index 7972511..d3d73cc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -743,6 +743,14 @@ header's value.
 where the GnuPG home directory (used for signature verification) is
 located and whether GnuPG's option "--homedir" is used or not.
 
+** Trace
+
++++
+*** New commands 'trace-package' and 'trace-regexp' (and their
+counterparts 'untrace-package' and 'untrace-regexp') allow for the
+bulk tracing of calls to functions with names matching a specified
+prefix or regexp.
+
 ** Tramp
 
 +++
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index 1c57d73..949bb54 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -257,10 +257,15 @@ trace-function-internal
                       (or context (lambda () "")))
    `((name . ,trace-advice-name) (depth . -100))))
 
+(defun trace-is-traceable-p (sym)
+  "Whether the given symbol is a traceable function."
+  (or (functionp sym) (macrop sym)))
+
 (defun trace-is-traced (function)
+  "Whether FUNCTION is currently traced."
   (advice-member-p trace-advice-name function))
 
-(defun trace--read-args (prompt)
+(defun trace--read-function-args (prompt)
   "Read a function name, prompting with string PROMPT.
 If `current-prefix-arg' is non-nil, also read a buffer and a \"context\"
 \(Lisp expression).  Return (FUNCTION BUFFER FUNCTION-CONTEXT)."
@@ -274,19 +279,25 @@ trace--read-args
                                    default
                                    (if beg (substring prompt beg) ": "))
                                 prompt)
-                              obarray 'fboundp t nil nil
+                              obarray 'trace-is-traceable-p t nil nil
                               (if default (symbol-name default)))))
    (when current-prefix-arg
-     (list
-      (read-buffer "Output to buffer: " trace-buffer)
-      (let ((exp
-             (let ((minibuffer-completing-symbol t))
-               (read-from-minibuffer "Context expression: "
-                                     nil read-expression-map t
-                                     'read-expression-history))))
-        (lambda ()
-          (let ((print-circle t))
-            (concat " [" (prin1-to-string (eval exp t)) "]"))))))))
+     (trace--read-extra-args))))
+
+(defun trace--read-extra-args ()
+  "Read a buffer and a \"context\" (Lisp expression).
+Return (BUFFER FUNCTION-CONTEXT)."
+  (list
+   (read-buffer "Output to buffer: " trace-buffer)
+   (let ((exp
+          (let ((minibuffer-completing-symbol t))
+            (read-from-minibuffer "Context expression: "
+                                  nil read-expression-map t
+                                  'read-expression-history "nil"))))
+     (and exp
+          (lambda ()
+            (let ((print-circle t))
+              (concat " [" (prin1-to-string (eval exp t)) "]")))))))
 
 ;;;###autoload
 (defun trace-function-foreground (function &optional buffer context)
@@ -306,7 +317,7 @@ trace-function-foreground
 stuff - use `trace-function-background' instead.
 
 To stop tracing a function, use `untrace-function' or `untrace-all'."
-  (interactive (trace--read-args "Trace function: "))
+  (interactive (trace--read-function-args "Trace function: "))
   (trace-function-internal function buffer nil context))
 
 ;;;###autoload
@@ -314,24 +325,108 @@ trace-function-background
   "Trace calls to function FUNCTION, quietly.
 This is like `trace-function-foreground', but without popping up
 the output buffer or changing the window configuration."
-  (interactive (trace--read-args "Trace function in background: "))
+  (interactive (trace--read-function-args "Trace function in background: "))
   (trace-function-internal function buffer t context))
 
 ;;;###autoload
 (defalias 'trace-function 'trace-function-foreground)
 
 (defun untrace-function (function)
-  "Untraces FUNCTION and possibly activates all remaining advice.
-Activation is performed with `ad-update', hence remaining advice will get
-activated only if the advice of FUNCTION is currently active.  If FUNCTION
-was not traced this is a noop."
+  "Remove trace from FUNCTION.  If FUNCTION was not traced this is a noop."
   (interactive
    (list (intern (completing-read "Untrace function: "
                                   obarray #'trace-is-traced t))))
   (advice-remove function trace-advice-name))
 
+;;;###autoload
+(defun trace-package (prefix &optional buffer context)
+  "Trace all functions with names starting with PREFIX.
+For example, to trace all diff functions, do the following:
+
+\\[trace-package] RET diff- RET
+
+Background tracing is used.  Switch to the trace output buffer to
+view the results.
+
+See also `untrace-package'."
+  ;; Derived in part from `elp-instrument-package'.
+  (interactive
+   (cons (completing-read "Prefix of package to trace: "
+                          obarray #'trace-is-traceable-p)
+         (and current-prefix-arg (trace--read-extra-args))))
+  (when (zerop (length prefix))
+    (error "Tracing all Emacs functions would render Emacs unusable"))
+  (mapc (lambda (name)
+          (trace-function-background (intern name) buffer context))
+        (all-completions prefix obarray #'trace-is-traceable-p))
+  (message
+   "Tracing to %s.  Use %s to untrace a package, or %s to remove all traces."
+   (or buffer trace-buffer)
+   (substitute-command-keys "\\[untrace-package]")
+   (substitute-command-keys "\\[untrace-all]")))
+
+(defun untrace-package (prefix)
+  "Remove traces from all functions with names starting with PREFIX.
+
+See also `trace-package'."
+  (interactive
+   (list (completing-read "Prefix of package to untrace: "
+                          obarray #'trace-is-traced)))
+  (if (and (zerop (length prefix))
+           (y-or-n-p "Remove all function traces?"))
+      (untrace-all)
+    (mapc (lambda (name)
+            (untrace-function (intern name)))
+          (all-completions prefix obarray #'trace-is-traceable-p))))
+
+;;;###autoload
+(defun trace-regexp (regexp &optional buffer context)
+  "Trace all functions with names matching REGEXP.
+For example, to trace indentation-related functions, you could try:
+
+\\[trace-regexp] RET indent\\|offset RET
+
+Warning: Do not attempt to trace all functions.  Tracing too many
+functions at one time will render Emacs unusable.
+
+Background tracing is used.  Switch to the trace output buffer to
+view the results.
+
+See also `untrace-regexp'."
+  (interactive
+   (cons (read-regexp "Regexp matching functions to trace: ")
+         (and current-prefix-arg (trace--read-extra-args))))
+  (when (member regexp '("" "." ".+" ".*"))
+    ;; Not comprehensive, but it catches the most likely attempts.
+    (error "Tracing all Emacs functions would render Emacs unusable"))
+  (mapatoms
+   (lambda (sym)
+     (and (trace-is-traceable-p sym)
+          (string-match-p regexp (symbol-name sym))
+          (trace-function-background sym buffer context))))
+  (message
+   "Tracing to %s.  Use %s to untrace by regexp, or %s to remove all traces."
+   (or buffer trace-buffer)
+   (substitute-command-keys "\\[untrace-regexp]")
+   (substitute-command-keys "\\[untrace-all]")))
+
+(defun untrace-regexp (regexp)
+  "Remove traces from all functions with names matching REGEXP.
+
+See also `trace-regexp'."
+  (interactive
+   (list (read-regexp "Regexp matching functions to untrace: ")))
+  (if (and (zerop (length regexp))
+           (y-or-n-p "Remove all function traces?"))
+      (untrace-all)
+    (mapatoms
+     (lambda (sym)
+       (and (trace-is-traceable-p sym)
+            (string-match-p regexp (symbol-name sym))
+            (untrace-function sym))))))
+
 (defun untrace-all ()
-  "Untraces all currently traced functions."
+  "Remove traces from all currently traced functions."
   (interactive)
   (mapatoms #'untrace-function))
 
-- 
2.8.3