lisp/emacs-lisp/trace.el

   1 ;;; trace.el --- tracing facility for Emacs Lisp functions  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 1993, 1998, 2000-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
   6 ;; Maintainer: emacs-devel@gnu.org
   7 ;; Created: 15 Dec 1992
   8 ;; Keywords: tools, lisp
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;; LCD Archive Entry:
  26 ;; trace|Hans Chalupsky|hans@cs.buffalo.edu|
  27 ;; Tracing facility for Emacs Lisp functions|
  28 ;; 1993/05/18 00:41:16|2.0|~/packages/trace.el.Z|
  29
  30
  31 ;;; Commentary:
  32
  33 ;; Introduction:
  34 ;; =============
  35 ;; A simple trace package that utilizes nadvice.el.  It generates trace
  36 ;; information in a Lisp-style fashion and inserts it into a trace output
  37 ;; buffer.  Tracing can be done in the background (or silently) so that
  38 ;; generation of trace output won't interfere with what you are currently
  39 ;; doing.
  40
  41 ;; Restrictions:
  42 ;; =============
  43 ;; - Traced subrs when called interactively will always show nil as the
  44 ;;   value of their arguments.
  45 ;; - Only functions/macros/subrs that are called via their function cell will
  46 ;;   generate trace output, hence, you won't get trace output for:
  47 ;;   + Subrs called directly from other subrs/C-code
  48 ;;   + Compiled calls to subrs that have special byte-codes associated
  49 ;;     with them (e.g., car, cdr, ...)
  50 ;;   + Macros that were expanded during compilation
  51 ;; - All the restrictions that apply to nadvice.el
  52
  53 ;; Usage:
  54 ;; ======
  55 ;; - To trace a function say `M-x trace-function', which will ask you for the
  56 ;;   name of the function/subr/macro to trace.
  57 ;; - If you want to trace a function that switches buffers or does other
  58 ;;   display oriented stuff use `M-x trace-function-background', which will
  59 ;;   generate the trace output silently in the background without popping
  60 ;;   up windows and doing other irritating stuff.
  61 ;; - To untrace a function say `M-x untrace-function'.
  62 ;; - To untrace all currently traced functions say `M-x untrace-all'.
  63
  64 ;; Examples:
  65 ;; =========
  66 ;;
  67 ;;  (defun fact (n)
  68 ;;    (if (= n 0) 1
  69 ;;      (* n (fact (1- n)))))
  70 ;;  fact
  71 ;;
  72 ;;  (trace-function 'fact)
  73 ;;  fact
  74 ;;
  75 ;;  Now, evaluating this...
  76 ;;
  77 ;;  (fact 4)
  78 ;;  24
  79 ;;
  80 ;;  ...will generate the following in *trace-buffer*:
  81 ;;
  82 ;;  1 -> fact: n=4
  83 ;;  | 2 -> fact: n=3
  84 ;;  | | 3 -> fact: n=2
  85 ;;  | | | 4 -> fact: n=1
  86 ;;  | | | | 5 -> fact: n=0
  87 ;;  | | | | 5 <- fact: 1
  88 ;;  | | | 4 <- fact: 1
  89 ;;  | | 3 <- fact: 2
  90 ;;  | 2 <- fact: 6
  91 ;;  1 <- fact: 24
  92 ;;
  93 ;;
  94 ;;  (defun ack (x y z)
  95 ;;    (if (= x 0)
  96 ;;        (+ y z)
  97 ;;      (if (and (<= x 2) (= z 0))
  98 ;;          (1- x)
  99 ;;        (if (and (> x 2) (= z 0))
 100 ;;            y
 101 ;;          (ack (1- x) y (ack x y (1- z)))))))
 102 ;;  ack
 103 ;;
 104 ;;  (trace-function 'ack)
 105 ;;  ack
 106 ;;
 107 ;;  Try this for some interesting trace output:
 108 ;;
 109 ;;  (ack 3 3 1)
 110 ;;  27
 111 ;;
 112 ;;
 113 ;; The following does something similar to the functionality of the package
 114 ;; log-message.el by Robert Potter, which is giving you a chance to look at
 115 ;; messages that might have whizzed by too quickly (you won't see subr
 116 ;; generated messages though):
 117 ;;
 118 ;; (trace-function-background 'message "*Message Log*")
 119
 120
 121 ;;; Change Log:
 122
 123 ;; Revision 2.0 1993/05/18 00:41:16 hans
 124 ;;      * Adapted for advice.el 2.0; it now also works
 125 ;;        for GNU Emacs-19 and Lemacs
 126 ;;      * Separate function `trace-function-background'
 127 ;;      * Separate pieces of advice for foreground and background tracing
 128 ;;      * Less insane handling of interactive trace buffer specification
 129 ;;      * String arguments and values are now printed properly
 130 ;;
 131 ;; Revision 1.1 1992/12/15 22:45:15 hans
 132 ;;      * Created, first public release
 133
 134
 135 ;;; Code:
 136
 137 (defgroup trace nil
 138   "Tracing facility for Emacs Lisp functions."
 139   :prefix "trace-"
 140   :group 'lisp)
 141
 142 ;;;###autoload
 143 (defcustom trace-buffer "*trace-output*"
 144   "Trace output will by default go to that buffer."
 145   :type 'string)
 146
 147 ;; Current level of traced function invocation:
 148 (defvar trace-level 0)
 149
 150 ;; Semi-cryptic name used for a piece of trace advice:
 151 (defvar trace-advice-name 'trace-function\ )
 152
 153 ;; Used to separate new trace output from previous traced runs:
 154 (defvar trace-separator (format "%s\n" (make-string 70 ?=)))
 155
 156 (defvar inhibit-trace nil
 157   "If non-nil, all tracing is temporarily inhibited.")
 158
 159 ;;;###autoload
 160 (defun trace-values (&rest values)
 161   "Helper function to get internal values.
 162 You can call this function to add internal values in the trace buffer."
 163   (unless inhibit-trace
 164     (with-current-buffer trace-buffer
 165       (goto-char (point-max))
 166       (insert
 167        (trace-entry-message
 168         'trace-values trace-level values "")))))
 169
 170 (defun trace-entry-message (function level args context)
 171   "Generate a string that describes that FUNCTION has been entered.
 172 LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION,
 173 and CONTEXT is a string describing the dynamic context (e.g. values of
 174 some global variables)."
 175   (let ((print-circle t))
 176     (format "%s%s%d -> %S%s\n"
 177             (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
 178             (if (> level 1) " " "")
 179             level
 180             ;; FIXME: Make it so we can click the function name to jump to its
 181             ;; definition and/or untrace it.
 182             (cons function args)
 183             context)))
 184
 185 (defun trace-exit-message (function level value context)
 186   "Generate a string that describes that FUNCTION has exited.
 187 LEVEL is the trace level, VALUE value returned by FUNCTION,
 188 and CONTEXT is a string describing the dynamic context (e.g. values of
 189 some global variables)."
 190   (let ((print-circle t))
 191     (format "%s%s%d <- %s: %S%s\n"
 192             (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
 193             (if (> level 1) " " "")
 194             level
 195             function
 196             ;; Do this so we'll see strings:
 197             value
 198             context)))
 199
 200 (defvar trace--timer nil)
 201
 202 (defun trace--display-buffer (buf)
 203   (unless (or trace--timer
 204               (get-buffer-window buf 'visible))
 205     (setq trace--timer
 206           ;; Postpone the display to some later time, in case we
 207           ;; can't actually do it now.
 208           (run-with-timer 0 nil
 209                           (lambda ()
 210                             (setq trace--timer nil)
 211                             (display-buffer buf nil 0))))))
 212
 213
 214 (defun trace-make-advice (function buffer background context)
 215   "Build the piece of advice to be added to trace FUNCTION.
 216 FUNCTION is the name of the traced function.
 217 BUFFER is the buffer where the trace should be printed.
 218 BACKGROUND if nil means to display BUFFER.
 219 CONTEXT if non-nil should be a function that returns extra info that should
 220 be printed along with the arguments in the trace."
 221   (lambda (body &rest args)
 222     (let ((trace-level (1+ trace-level))
 223           (trace-buffer (get-buffer-create buffer))
 224           (deactivate-mark nil)         ;Protect deactivate-mark.
 225           (ctx (funcall context)))
 226       (unless inhibit-trace
 227         (with-current-buffer trace-buffer
 228           (set (make-local-variable 'window-point-insertion-type) t)
 229           (unless background (trace--display-buffer trace-buffer))
 230           (goto-char (point-max))
 231           ;; Insert a separator from previous trace output:
 232           (if (= trace-level 1) (insert trace-separator))
 233           (insert
 234            (trace-entry-message
 235             function trace-level args ctx))))
 236       (let ((result))
 237         (unwind-protect
 238             (setq result (list (apply body args)))
 239           (unless inhibit-trace
 240             (let ((ctx (funcall context)))
 241               (with-current-buffer trace-buffer
 242                 (unless background (trace--display-buffer trace-buffer))
 243                 (goto-char (point-max))
 244                 (insert
 245                  (trace-exit-message
 246                   function
 247                   trace-level
 248                   (if result (car result) '\!non-local\ exit\!)
 249                   ctx))))))
 250         (car result)))))
 251
 252 (defun trace-function-internal (function buffer background context)
 253   "Add trace advice for FUNCTION."
 254   (advice-add
 255    function :around
 256    (trace-make-advice function (or buffer trace-buffer) background
 257                       (or context (lambda () "")))
 258    `((name . ,trace-advice-name) (depth . -100))))
 259
 260 (defun trace-is-traced (function)
 261   (advice-member-p trace-advice-name function))
 262
 263 (defun trace--read-args (prompt)
 264   "Read a function name, prompting with string PROMPT.
 265 If `current-prefix-arg' is non-nil, also read a buffer and a \"context\"
 266 \(Lisp expression).  Return (FUNCTION BUFFER FUNCTION-CONTEXT)."
 267   (cons
 268    (let ((default (function-called-at-point))
 269          (beg (string-match ":[ \t]*\\'" prompt)))
 270      (intern (completing-read (if default
 271                                   (format
 272                                    "%s (default %s)%s"
 273                                    (substring prompt 0 beg)
 274                                    default
 275                                    (if beg (substring prompt beg) ": "))
 276                                 prompt)
 277                               obarray 'fboundp t nil nil
 278                               (if default (symbol-name default)))))
 279    (when current-prefix-arg
 280      (list
 281       (read-buffer "Output to buffer: " trace-buffer)
 282       (let ((exp
 283              (let ((minibuffer-completing-symbol t))
 284                (read-from-minibuffer "Context expression: "
 285                                      nil read-expression-map t
 286                                      'read-expression-history))))
 287         (lambda ()
 288           (let ((print-circle t))
 289             (concat " [" (prin1-to-string (eval exp t)) "]"))))))))
 290
 291 ;;;###autoload
 292 (defun trace-function-foreground (function &optional buffer context)
 293   "Trace calls to function FUNCTION.
 294 With a prefix argument, also prompt for the trace buffer (default
 295 `trace-buffer'), and a Lisp expression CONTEXT.
 296
 297 Tracing a function causes every call to that function to insert
 298 into BUFFER Lisp-style trace messages that display the function's
 299 arguments and return values.  It also evaluates CONTEXT, if that is
 300 non-nil, and inserts its value too.  For example, you can use this
 301 to track the current buffer, or position of point.
 302
 303 This function creates BUFFER if it does not exist.  This buffer will
 304 popup whenever FUNCTION is called.  Do not use this function to trace
 305 functions that switch buffers, or do any other display-oriented
 306 stuff - use `trace-function-background' instead.
 307
 308 To stop tracing a function, use `untrace-function' or `untrace-all'."
 309   (interactive (trace--read-args "Trace function: "))
 310   (trace-function-internal function buffer nil context))
 311
 312 ;;;###autoload
 313 (defun trace-function-background (function &optional buffer context)
 314   "Trace calls to function FUNCTION, quietly.
 315 This is like `trace-function-foreground', but without popping up
 316 the output buffer or changing the window configuration."
 317   (interactive (trace--read-args "Trace function in background: "))
 318   (trace-function-internal function buffer t context))
 319
 320 ;;;###autoload
 321 (defalias 'trace-function 'trace-function-foreground)
 322
 323 (defun untrace-function (function)
 324   "Untraces FUNCTION and possibly activates all remaining advice.
 325 Activation is performed with `ad-update', hence remaining advice will get
 326 activated only if the advice of FUNCTION is currently active.  If FUNCTION
 327 was not traced this is a noop."
 328   (interactive
 329    (list (intern (completing-read "Untrace function: "
 330                                   obarray #'trace-is-traced t))))
 331   (advice-remove function trace-advice-name))
 332
 333 (defun untrace-all ()
 334   "Untraces all currently traced functions."
 335   (interactive)
 336   (mapatoms #'untrace-function))
 337
 338 (provide 'trace)
 339
 340 ;;; trace.el ends here