Mercurial > hg > xemacs-beta

comparison lisp/utils/trace.el @ 0:376386a54a3c r19-14

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