lisp/emacs-lisp/trace.el

   1 ;;; trace.el --- tracing facility for Emacs Lisp functions
   2
   3 ;; Copyright (C) 1993, 1998, 2000-2013 Free Software Foundation, Inc.
   4
   5 ;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
   6 ;; Maintainer: FSF
   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 advice.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 ;; Requirement:
  42 ;; ============
  43 ;; trace.el needs advice.el version 2.0 or later which you can get from the
  44 ;; same place from where you got trace.el.
  45
  46 ;; Restrictions:
  47 ;; =============
  48 ;; - Traced subrs when called interactively will always show nil as the
  49 ;;   value of their arguments.
  50 ;; - Only functions/macros/subrs that are called via their function cell will
  51 ;;   generate trace output, hence, you won't get trace output for:
  52 ;;   + Subrs called directly from other subrs/C-code
  53 ;;   + Compiled calls to subrs that have special byte-codes associated
  54 ;;     with them (e.g., car, cdr, ...)
  55 ;;   + Macros that were expanded during compilation
  56 ;; - All the restrictions that apply to advice.el
  57
  58 ;; Installation:
  59 ;; =============
  60 ;; Put this file together with advice.el (version 2.0 or later) somewhere
  61 ;; into your Emacs `load-path', byte-compile it/them for efficiency, and
  62 ;; put the following autoload declarations into your .emacs
  63 ;;
  64 ;;    (autoload 'trace-function "trace" "Trace a function" t)
  65 ;;    (autoload 'trace-function-background "trace" "Trace a function" t)
  66 ;;
  67 ;; or explicitly load it with (require 'trace) or (load "trace").
  68
  69 ;; Usage:
  70 ;; ======
  71 ;; - To trace a function say `M-x trace-function' which will ask you for the
  72 ;;   name of the function/subr/macro to trace, as well as for the buffer
  73 ;;   into which trace output should go.
  74 ;; - If you want to trace a function that switches buffers or does other
  75 ;;   display oriented stuff use `M-x trace-function-background' which will
  76 ;;   generate the trace output silently in the background without popping
  77 ;;   up windows and doing other irritating stuff.
  78 ;; - To untrace a function say `M-x untrace-function'.
  79 ;; - To untrace all currently traced functions say `M-x untrace-all'.
  80
  81 ;; Examples:
  82 ;; =========
  83 ;;
  84 ;;  (defun fact (n)
  85 ;;    (if (= n 0) 1
  86 ;;      (* n (fact (1- n)))))
  87 ;;  fact
  88 ;;
  89 ;;  (trace-function 'fact)
  90 ;;  fact
  91 ;;
  92 ;;  Now, evaluating this...
  93 ;;
  94 ;;  (fact 4)
  95 ;;  24
  96 ;;
  97 ;;  ...will generate the following in *trace-buffer*:
  98 ;;
  99 ;;  1 -> fact: n=4
 100 ;;  | 2 -> fact: n=3
 101 ;;  | | 3 -> fact: n=2
 102 ;;  | | | 4 -> fact: n=1
 103 ;;  | | | | 5 -> fact: n=0
 104 ;;  | | | | 5 <- fact: 1
 105 ;;  | | | 4 <- fact: 1
 106 ;;  | | 3 <- fact: 2
 107 ;;  | 2 <- fact: 6
 108 ;;  1 <- fact: 24
 109 ;;
 110 ;;
 111 ;;  (defun ack (x y z)
 112 ;;    (if (= x 0)
 113 ;;        (+ y z)
 114 ;;      (if (and (<= x 2) (= z 0))
 115 ;;          (1- x)
 116 ;;        (if (and (> x 2) (= z 0))
 117 ;;            y
 118 ;;          (ack (1- x) y (ack x y (1- z)))))))
 119 ;;  ack
 120 ;;
 121 ;;  (trace-function 'ack)
 122 ;;  ack
 123 ;;
 124 ;;  Try this for some interesting trace output:
 125 ;;
 126 ;;  (ack 3 3 1)
 127 ;;  27
 128 ;;
 129 ;;
 130 ;; The following does something similar to the functionality of the package
 131 ;; log-message.el by Robert Potter, which is giving you a chance to look at
 132 ;; messages that might have whizzed by too quickly (you won't see subr
 133 ;; generated messages though):
 134 ;;
 135 ;; (trace-function-background 'message "*Message Log*")
 136
 137
 138 ;;; Change Log:
 139
 140 ;; Revision 2.0 1993/05/18 00:41:16 hans
 141 ;;      * Adapted for advice.el 2.0; it now also works
 142 ;;        for GNU Emacs-19 and Lemacs
 143 ;;      * Separate function `trace-function-background'
 144 ;;      * Separate pieces of advice for foreground and background tracing
 145 ;;      * Less insane handling of interactive trace buffer specification
 146 ;;      * String arguments and values are now printed properly
 147 ;;
 148 ;; Revision 1.1 1992/12/15 22:45:15 hans
 149 ;;      * Created, first public release
 150
 151
 152 ;;; Code:
 153
 154 (require 'advice)
 155
 156 (defgroup trace nil
 157   "Tracing facility for Emacs Lisp functions."
 158   :prefix "trace-"
 159   :group 'lisp)
 160
 161 ;;;###autoload
 162 (defcustom trace-buffer (purecopy "*trace-output*")
 163   "Trace output will by default go to that buffer."
 164   :type 'string
 165   :group 'trace)
 166
 167 ;; Current level of traced function invocation:
 168 (defvar trace-level 0)
 169
 170 ;; Semi-cryptic name used for a piece of trace advice:
 171 (defvar trace-advice-name 'trace-function\ )
 172
 173 ;; Used to separate new trace output from previous traced runs:
 174 (defvar trace-separator (format "%s\n" (make-string 70 ?=)))
 175
 176 (defvar inhibit-trace nil
 177   "If non-nil, all tracing is temporarily inhibited.")
 178
 179 (defun trace-entry-message (function level argument-bindings)
 180   ;; Generates a string that describes that FUNCTION has been entered at
 181   ;; trace LEVEL with ARGUMENT-BINDINGS.
 182   (format "%s%s%d -> %s: %s\n"
 183           (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
 184           (if (> level 1) " " "")
 185           level
 186           function
 187           (let ((print-circle t))
 188             (mapconcat (lambda (binding)
 189                          (concat
 190                           (symbol-name (ad-arg-binding-field binding 'name))
 191                           "="
 192                           ;; do this so we'll see strings:
 193                           (prin1-to-string
 194                            (ad-arg-binding-field binding 'value))))
 195                        argument-bindings
 196                        " "))))
 197
 198 (defun trace-exit-message (function level value)
 199   ;; Generates a string that describes that FUNCTION has been exited at
 200   ;; trace LEVEL and that it returned VALUE.
 201   (format "%s%s%d <- %s: %s\n"
 202           (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
 203           (if (> level 1) " " "")
 204           level
 205           function
 206           ;; do this so we'll see strings:
 207           (let ((print-circle t)) (prin1-to-string value))))
 208
 209 (defun trace-make-advice (function buffer background)
 210   ;; Builds the piece of advice to be added to FUNCTION's advice info
 211   ;; so that it will generate the proper trace output in BUFFER
 212   ;; (quietly if BACKGROUND is t).
 213   (ad-make-advice
 214    trace-advice-name nil t
 215    `(advice
 216      lambda ()
 217      (let ((trace-level (1+ trace-level))
 218            (trace-buffer (get-buffer-create ,buffer)))
 219        (unless inhibit-trace
 220          (with-current-buffer trace-buffer
 221            (set (make-local-variable 'window-point-insertion-type) t)
 222            ,(unless background '(display-buffer trace-buffer))
 223            (goto-char (point-max))
 224            ;; Insert a separator from previous trace output:
 225            (if (= trace-level 1) (insert trace-separator))
 226            (insert
 227             (trace-entry-message
 228              ',function trace-level ad-arg-bindings))))
 229        ad-do-it
 230        (unless inhibit-trace
 231          (with-current-buffer trace-buffer
 232            ,(unless background '(display-buffer trace-buffer))
 233            (goto-char (point-max))
 234            (insert
 235             (trace-exit-message
 236              ',function trace-level ad-return-value))))))))
 237
 238 (defun trace-function-internal (function buffer background)
 239   ;; Adds trace advice for FUNCTION and activates it.
 240   (ad-add-advice
 241    function
 242    (trace-make-advice function (or buffer trace-buffer) background)
 243    'around 'last)
 244   (ad-activate function nil))
 245
 246 (defun trace-is-traced (function)
 247   (ad-find-advice function 'around trace-advice-name))
 248
 249 ;;;###autoload
 250 (defun trace-function (function &optional buffer)
 251   "Traces FUNCTION with trace output going to BUFFER.
 252 For every call of FUNCTION Lisp-style trace messages that display argument
 253 and return values will be inserted into BUFFER.  This function generates the
 254 trace advice for FUNCTION and activates it together with any other advice
 255 there might be!!  The trace BUFFER will popup whenever FUNCTION is called.
 256 Do not use this to trace functions that switch buffers or do any other
 257 display oriented stuff, use `trace-function-background' instead."
 258   (interactive
 259    (list
 260     (intern (completing-read "Trace function: " obarray 'fboundp t))
 261     (read-buffer "Output to buffer: " trace-buffer)))
 262   (trace-function-internal function buffer nil))
 263
 264 ;;;###autoload
 265 (defun trace-function-background (function &optional buffer)
 266   "Traces FUNCTION with trace output going quietly to BUFFER.
 267 When this tracing is enabled, every call to FUNCTION writes
 268 a Lisp-style trace message (showing the arguments and return value)
 269 into BUFFER.  This function generates advice to trace FUNCTION
 270 and activates it together with any other advice there might be.
 271 The trace output goes to BUFFER quietly, without changing
 272 the window or buffer configuration.
 273
 274 BUFFER defaults to `trace-buffer'."
 275   (interactive
 276    (list
 277     (intern
 278      (completing-read "Trace function in background: " obarray 'fboundp t))
 279     (read-buffer "Output to buffer: " trace-buffer)))
 280   (trace-function-internal function buffer t))
 281
 282 (defun untrace-function (function)
 283   "Untraces FUNCTION and possibly activates all remaining advice.
 284 Activation is performed with `ad-update', hence remaining advice will get
 285 activated only if the advice of FUNCTION is currently active.  If FUNCTION
 286 was not traced this is a noop."
 287   (interactive
 288    (list (ad-read-advised-function "Untrace function" 'trace-is-traced)))
 289   (when (trace-is-traced function)
 290     (ad-remove-advice function 'around trace-advice-name)
 291     (ad-update function)))
 292
 293 (defun untrace-all ()
 294   "Untraces all currently traced functions."
 295   (interactive)
 296   (ad-do-advised-functions (function)
 297     (untrace-function function)))
 298
 299 (provide 'trace)
 300
 301 ;;; trace.el ends here