code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/trace.el

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