>From 4d9ea7ac95b070d55b8e1502c3091168891f433e Mon Sep 17 00:00:00 2001 From: Phil Sainty 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