lisp/emacs-lisp/trace.el

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