lisp/emacs-lisp/trace.el

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