]> code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/trace.el
Merge from emacs-24; up to 2012-12-25T15:07:59Z!dmantipov@yandex.ru
[gnu-emacs] / lisp / emacs-lisp / trace.el
1 ;;; trace.el --- tracing facility for Emacs Lisp functions -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 1993, 1998, 2000-2013 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 3 of the License, or
15 ;; (at your option) 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. If not, see <http://www.gnu.org/licenses/>.
24
25 ;; LCD Archive Entry:
26 ;; trace|Hans Chalupsky|hans@cs.buffalo.edu|
27 ;; Tracing facility for Emacs Lisp functions|
28 ;; 1993/05/18 00:41:16|2.0|~/packages/trace.el.Z|
29
30
31 ;;; Commentary:
32
33 ;; Introduction:
34 ;; =============
35 ;; A simple trace package that utilizes advice.el. It generates trace
36 ;; information in a Lisp-style fashion and inserts it into a trace output
37 ;; buffer. Tracing can be done in the background (or silently) so that
38 ;; generation of trace output won't interfere with what you are currently
39 ;; doing.
40
41 ;; Restrictions:
42 ;; =============
43 ;; - Traced subrs when called interactively will always show nil as the
44 ;; value of their arguments.
45 ;; - Only functions/macros/subrs that are called via their function cell will
46 ;; generate trace output, hence, you won't get trace output for:
47 ;; + Subrs called directly from other subrs/C-code
48 ;; + Compiled calls to subrs that have special byte-codes associated
49 ;; with them (e.g., car, cdr, ...)
50 ;; + Macros that were expanded during compilation
51 ;; - All the restrictions that apply to advice.el
52
53 ;; Usage:
54 ;; ======
55 ;; - To trace a function say `M-x trace-function' which will ask you for the
56 ;; name of the function/subr/macro to trace, as well as for the buffer
57 ;; into which trace output should go.
58 ;; - If you want to trace a function that switches buffers or does other
59 ;; display oriented stuff use `M-x trace-function-background' which will
60 ;; generate the trace output silently in the background without popping
61 ;; up windows and doing other irritating stuff.
62 ;; - To untrace a function say `M-x untrace-function'.
63 ;; - To untrace all currently traced functions say `M-x untrace-all'.
64
65 ;; Examples:
66 ;; =========
67 ;;
68 ;; (defun fact (n)
69 ;; (if (= n 0) 1
70 ;; (* n (fact (1- n)))))
71 ;; fact
72 ;;
73 ;; (trace-function 'fact)
74 ;; fact
75 ;;
76 ;; Now, evaluating this...
77 ;;
78 ;; (fact 4)
79 ;; 24
80 ;;
81 ;; ...will generate the following in *trace-buffer*:
82 ;;
83 ;; 1 -> fact: n=4
84 ;; | 2 -> fact: n=3
85 ;; | | 3 -> fact: n=2
86 ;; | | | 4 -> fact: n=1
87 ;; | | | | 5 -> fact: n=0
88 ;; | | | | 5 <- fact: 1
89 ;; | | | 4 <- fact: 1
90 ;; | | 3 <- fact: 2
91 ;; | 2 <- fact: 6
92 ;; 1 <- fact: 24
93 ;;
94 ;;
95 ;; (defun ack (x y z)
96 ;; (if (= x 0)
97 ;; (+ y z)
98 ;; (if (and (<= x 2) (= z 0))
99 ;; (1- x)
100 ;; (if (and (> x 2) (= z 0))
101 ;; y
102 ;; (ack (1- x) y (ack x y (1- z)))))))
103 ;; ack
104 ;;
105 ;; (trace-function 'ack)
106 ;; ack
107 ;;
108 ;; Try this for some interesting trace output:
109 ;;
110 ;; (ack 3 3 1)
111 ;; 27
112 ;;
113 ;;
114 ;; The following does something similar to the functionality of the package
115 ;; log-message.el by Robert Potter, which is giving you a chance to look at
116 ;; messages that might have whizzed by too quickly (you won't see subr
117 ;; generated messages though):
118 ;;
119 ;; (trace-function-background 'message "*Message Log*")
120
121
122 ;;; Change Log:
123
124 ;; Revision 2.0 1993/05/18 00:41:16 hans
125 ;; * Adapted for advice.el 2.0; it now also works
126 ;; for GNU Emacs-19 and Lemacs
127 ;; * Separate function `trace-function-background'
128 ;; * Separate pieces of advice for foreground and background tracing
129 ;; * Less insane handling of interactive trace buffer specification
130 ;; * String arguments and values are now printed properly
131 ;;
132 ;; Revision 1.1 1992/12/15 22:45:15 hans
133 ;; * Created, first public release
134
135
136 ;;; Code:
137
138 (defgroup trace nil
139 "Tracing facility for Emacs Lisp functions."
140 :prefix "trace-"
141 :group 'lisp)
142
143 ;;;###autoload
144 (defcustom trace-buffer "*trace-output*"
145 "Trace output will by default go to that buffer."
146 :type 'string)
147
148 ;; Current level of traced function invocation:
149 (defvar trace-level 0)
150
151 ;; Semi-cryptic name used for a piece of trace advice:
152 (defvar trace-advice-name 'trace-function\ )
153
154 ;; Used to separate new trace output from previous traced runs:
155 (defvar trace-separator (format "%s\n" (make-string 70 ?=)))
156
157 (defvar inhibit-trace nil
158 "If non-nil, all tracing is temporarily inhibited.")
159
160 (defun trace-entry-message (function level args context)
161 "Generate a string that describes that FUNCTION has been entered.
162 LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION,
163 and CONTEXT is a string describing the dynamic context (e.g. values of
164 some global variables)."
165 (let ((print-circle t))
166 (format "%s%s%d -> %S%s\n"
167 (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
168 (if (> level 1) " " "")
169 level
170 ;; FIXME: Make it so we can click the function name to jump to its
171 ;; definition and/or untrace it.
172 (cons function args)
173 context)))
174
175 (defun trace-exit-message (function level value context)
176 "Generate a string that describes that FUNCTION has exited.
177 LEVEL is the trace level, VALUE value returned by FUNCTION,
178 and CONTEXT is a string describing the dynamic context (e.g. values of
179 some global variables)."
180 (let ((print-circle t))
181 (format "%s%s%d <- %s: %S%s\n"
182 (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
183 (if (> level 1) " " "")
184 level
185 function
186 ;; Do this so we'll see strings:
187 value
188 context)))
189
190 (defvar trace--timer nil)
191
192 (defun trace-make-advice (function buffer background context)
193 "Build the piece of advice to be added to trace FUNCTION.
194 FUNCTION is the name of the traced function.
195 BUFFER is the buffer where the trace should be printed.
196 BACKGROUND if nil means to display BUFFER.
197 CONTEXT if non-nil should be a function that returns extra info that should
198 be printed along with the arguments in the trace."
199 (lambda (body &rest args)
200 (let ((trace-level (1+ trace-level))
201 (trace-buffer (get-buffer-create buffer))
202 (ctx (funcall context)))
203 (unless inhibit-trace
204 (with-current-buffer trace-buffer
205 (set (make-local-variable 'window-point-insertion-type) t)
206 (unless (or background trace--timer
207 (get-buffer-window trace-buffer 'visible))
208 (setq trace--timer
209 ;; Postpone the display to some later time, in case we
210 ;; can't actually do it now.
211 (run-with-timer 0 nil
212 (lambda ()
213 (setq trace--timer nil)
214 (display-buffer trace-buffer)))))
215 (goto-char (point-max))
216 ;; Insert a separator from previous trace output:
217 (if (= trace-level 1) (insert trace-separator))
218 (insert
219 (trace-entry-message
220 function trace-level args ctx))))
221 (let ((result))
222 (unwind-protect
223 (setq result (list (apply body args)))
224 (unless inhibit-trace
225 (let ((ctx (funcall context)))
226 (with-current-buffer trace-buffer
227 (unless background (display-buffer trace-buffer))
228 (goto-char (point-max))
229 (insert
230 (trace-exit-message
231 function
232 trace-level
233 (if result (car result) '\!non-local\ exit\!)
234 ctx))))))
235 (car result)))))
236
237 (defun trace-function-internal (function buffer background context)
238 "Add trace advice for FUNCTION."
239 (advice-add
240 function :around
241 (trace-make-advice function (or buffer trace-buffer) background
242 (or context (lambda () "")))
243 `((name . ,trace-advice-name))))
244
245 (defun trace-is-traced (function)
246 (advice-member-p trace-advice-name function))
247
248 (defun trace--read-args (prompt)
249 (cons
250 (intern (completing-read prompt obarray 'fboundp t))
251 (when current-prefix-arg
252 (list
253 (read-buffer "Output to buffer: " trace-buffer)
254 (let ((exp
255 (let ((minibuffer-completing-symbol t))
256 (read-from-minibuffer "Context expression: "
257 nil read-expression-map t
258 'read-expression-history))))
259 (lambda ()
260 (let ((print-circle t))
261 (concat " [" (prin1-to-string (eval exp t)) "]"))))))))
262
263 ;;;###autoload
264 (defun trace-function-foreground (function &optional buffer context)
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
273 To untrace a function, use `untrace-function' or `untrace-all'."
274 (interactive (trace--read-args "Trace function: "))
275 (trace-function-internal function buffer nil context))
276
277 ;;;###autoload
278 (defun trace-function-background (function &optional buffer context)
279 "Traces FUNCTION with trace output going quietly to BUFFER.
280 Like `trace-function-foreground' but without popping up the trace BUFFER or
281 changing the window configuration."
282 (interactive (trace--read-args "Trace function in background: "))
283 (trace-function-internal function buffer t context))
284
285 ;;;###autoload
286 (defalias 'trace-function 'trace-function-foreground)
287
288 (defun untrace-function (function)
289 "Untraces FUNCTION and possibly activates all remaining advice.
290 Activation is performed with `ad-update', hence remaining advice will get
291 activated only if the advice of FUNCTION is currently active. If FUNCTION
292 was not traced this is a noop."
293 (interactive
294 (list (intern (completing-read "Untrace function: "
295 obarray #'trace-is-traced t))))
296 (advice-remove function trace-advice-name))
297
298 (defun untrace-all ()
299 "Untraces all currently traced functions."
300 (interactive)
301 (mapatoms #'untrace-function))
302
303 (provide 'trace)
304
305 ;;; trace.el ends here