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

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

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

Just attaching the current patch.  Thanks for the input Dmitry and
Kaushal.  I'll leave it a while to see whether anyone else wishes to
weigh in on the outstanding items:

* The inconsistent predicate naming of `trace-is-traced' vs
  `trace-is-traceable-p'.
  https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27397#19

* Whether foreground-tracing variants of the new commands are wanted.
  https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27397#25
  https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27397#34

* Whether it's a good idea to display the trace buffer initially
  when one of the background tracing commands is invoked.


(I guess I'll follow up next weekend if no one has anything to add
in the interim.)


-Phil

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

From 5ca9108f585a06c2085ab180c390bf85d3657230 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-function): New function, split from `trace--read-args'.
Changed to use the new `trace-is-traceable-p' predicate.

(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-args): Removed function.  Replaced by the combination of
`trace--read-function' and `trace--read-extra-args'.

(trace-function-foreground, trace-function-background): Updated
interactive specs to use the new functions.

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

Commentary updated to cover the new commands.

Change log updated to cover the main changes since 1993.

* 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 | 206 ++++++++++++++++++++++++++++++++++++++---------
 3 files changed, 176 insertions(+), 42 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..05ee780 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -52,14 +52,20 @@
 
 ;; Usage:
 ;; ======
-;; - To trace a function say `M-x trace-function', which will ask you for the
+;; - To trace a function use `M-x trace-function', which will ask you for the
 ;;   name of the function/subr/macro to trace.
 ;; - If you want to trace a function that switches buffers or does other
 ;;   display oriented stuff use `M-x trace-function-background', which will
 ;;   generate the trace output silently in the background without popping
 ;;   up windows and doing other irritating stuff.
-;; - To untrace a function say `M-x untrace-function'.
-;; - To untrace all currently traced functions say `M-x untrace-all'.
+;; - `M-x trace-package' will ask you for a function name prefix, and trace
+;;   (in the background) all matching functions.
+;; - `M-x trace-regexp' will ask you for a function name pattern (regexp),
+;;   and trace (in the background) all matching functions.
+;; - To untrace a function use `M-x untrace-function'.
+;; - To untrace multiple functions by prefix use `M-x untrace-package'.
+;; - To untrace multiple functions by regexp use `M-x untrace-regexp'.
+;; - To untrace all currently traced functions use `M-x untrace-all'.
 
 ;; Examples:
 ;; =========
@@ -120,6 +126,22 @@
 
 ;;; Change Log:
 
+;; 2017-06-17  Phil Sainty
+;;	* New commands `trace-package', `untrace-package', `trace-regexp',
+;;	  `untrace-regexp'
+;;
+;; 2012-2014  Stefan Monnier, Glenn Morris
+;;	* Adapted for nadvice.el
+;;	* New `context' argument and display in trace buffer
+;;	* `trace-function' renamed to (and now an alias of)
+;;	  `trace-function-foreground'
+;;
+;; 2005-02-27  Stefan Monnier
+;;	* New `inhibit-trace' variable
+;;
+;; 1998-04-05  Stephen Eglen
+;;	* New customize group `trace'
+;;
 ;; Revision 2.0 1993/05/18 00:41:16 hans
 ;;	* Adapted for advice.el 2.0; it now also works
 ;;	  for GNU Emacs-19 and Lemacs
@@ -257,42 +279,48 @@ 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)
-  "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)."
-  (cons
-   (let ((default (function-called-at-point))
-         (beg (string-match ":[ \t]*\\'" prompt)))
-     (intern (completing-read (if default
-                                  (format
-                                   "%s (default %s)%s"
-                                   (substring prompt 0 beg)
-                                   default
-                                   (if beg (substring prompt beg) ": "))
-                                prompt)
-                              obarray 'fboundp 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)) "]"))))))))
+(defun trace--read-function (prompt)
+  "Read a function name, prompting with string PROMPT."
+  (let ((default (function-called-at-point))
+        (beg (string-match ":[ \t]*\\'" prompt)))
+    (intern (completing-read (if default
+                                 (format
+                                  "%s (default %s)%s"
+                                  (substring prompt 0 beg)
+                                  default
+                                  (if beg (substring prompt beg) ": "))
+                               prompt)
+                             obarray 'trace-is-traceable-p t nil nil
+                             (if default (symbol-name default))))))
+
+(defun trace--read-extra-args ()
+  "Read a buffer and a \"context\" (Lisp expression).
+Return (BUFFER 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)
   "Trace calls to function FUNCTION.
-With a prefix argument, also prompt for the trace buffer (default
-`trace-buffer'), and a Lisp expression CONTEXT.
+With a prefix argument, also prompt for the trace output BUFFER
+\(default `trace-buffer'), and a Lisp expression CONTEXT.
 
 Tracing a function causes every call to that function to insert
 into BUFFER Lisp-style trace messages that display the function's
@@ -306,7 +334,9 @@ 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
+   (cons (trace--read-function "Trace function: ")
+         (and current-prefix-arg (trace--read-extra-args))))
   (trace-function-internal function buffer nil context))
 
 ;;;###autoload
@@ -314,24 +344,122 @@ 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
+   (cons (trace--read-function "Trace function in background: ")
+         (and current-prefix-arg (trace--read-extra-args))))
   (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
+
+With a prefix argument, also prompt for the trace output BUFFER
+\(default `trace-buffer'), and a Lisp expression CONTEXT.
+
+Background tracing is used.  Switch to the trace output buffer to view
+the results.
+
+See `trace-function-foreground' for details on the optional arguments
+and foreground vs background tracing.
+
+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 all traces from 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.
+
+With a prefix argument, also prompt for the trace output BUFFER
+\(default `trace-buffer'), and a Lisp expression CONTEXT.
+
+Background tracing is used.  Switch to the trace output buffer to view
+the results.
+
+See `trace-function-foreground' for details on the optional arguments
+and foreground vs background tracing.
+
+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 all traces from 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