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