Merge from origin/emacs-24
[emacs.git] / lisp / emacs-lisp / trace.el
blob7a2fb22f3d592454e0a22800237545093ce2dda8
1 ;;; trace.el --- tracing facility for Emacs Lisp functions -*- lexical-binding: t -*-
3 ;; Copyright (C) 1993, 1998, 2000-2015 Free Software Foundation, Inc.
5 ;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
6 ;; Maintainer: emacs-devel@gnu.org
7 ;; Created: 15 Dec 1992
8 ;; Keywords: tools, lisp
10 ;; This file is part of GNU Emacs.
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.
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.
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/>.
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|
31 ;;; Commentary:
33 ;; Introduction:
34 ;; =============
35 ;; A simple trace package that utilizes nadvice.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.
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 nadvice.el
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.
57 ;; - If you want to trace a function that switches buffers or does other
58 ;; display oriented stuff use `M-x trace-function-background', which will
59 ;; generate the trace output silently in the background without popping
60 ;; up windows and doing other irritating stuff.
61 ;; - To untrace a function say `M-x untrace-function'.
62 ;; - To untrace all currently traced functions say `M-x untrace-all'.
64 ;; Examples:
65 ;; =========
67 ;; (defun fact (n)
68 ;; (if (= n 0) 1
69 ;; (* n (fact (1- n)))))
70 ;; fact
72 ;; (trace-function 'fact)
73 ;; fact
75 ;; Now, evaluating this...
77 ;; (fact 4)
78 ;; 24
80 ;; ...will generate the following in *trace-buffer*:
82 ;; 1 -> fact: n=4
83 ;; | 2 -> fact: n=3
84 ;; | | 3 -> fact: n=2
85 ;; | | | 4 -> fact: n=1
86 ;; | | | | 5 -> fact: n=0
87 ;; | | | | 5 <- fact: 1
88 ;; | | | 4 <- fact: 1
89 ;; | | 3 <- fact: 2
90 ;; | 2 <- fact: 6
91 ;; 1 <- fact: 24
94 ;; (defun ack (x y z)
95 ;; (if (= x 0)
96 ;; (+ y z)
97 ;; (if (and (<= x 2) (= z 0))
98 ;; (1- x)
99 ;; (if (and (> x 2) (= z 0))
100 ;; y
101 ;; (ack (1- x) y (ack x y (1- z)))))))
102 ;; ack
104 ;; (trace-function 'ack)
105 ;; ack
107 ;; Try this for some interesting trace output:
109 ;; (ack 3 3 1)
110 ;; 27
113 ;; The following does something similar to the functionality of the package
114 ;; log-message.el by Robert Potter, which is giving you a chance to look at
115 ;; messages that might have whizzed by too quickly (you won't see subr
116 ;; generated messages though):
118 ;; (trace-function-background 'message "*Message Log*")
121 ;;; Change Log:
123 ;; Revision 2.0 1993/05/18 00:41:16 hans
124 ;; * Adapted for advice.el 2.0; it now also works
125 ;; for GNU Emacs-19 and Lemacs
126 ;; * Separate function `trace-function-background'
127 ;; * Separate pieces of advice for foreground and background tracing
128 ;; * Less insane handling of interactive trace buffer specification
129 ;; * String arguments and values are now printed properly
131 ;; Revision 1.1 1992/12/15 22:45:15 hans
132 ;; * Created, first public release
135 ;;; Code:
137 (defgroup trace nil
138 "Tracing facility for Emacs Lisp functions."
139 :prefix "trace-"
140 :group 'lisp)
142 ;;;###autoload
143 (defcustom trace-buffer "*trace-output*"
144 "Trace output will by default go to that buffer."
145 :type 'string)
147 ;; Current level of traced function invocation:
148 (defvar trace-level 0)
150 ;; Semi-cryptic name used for a piece of trace advice:
151 (defvar trace-advice-name 'trace-function\ )
153 ;; Used to separate new trace output from previous traced runs:
154 (defvar trace-separator (format "%s\n" (make-string 70 ?=)))
156 (defvar inhibit-trace nil
157 "If non-nil, all tracing is temporarily inhibited.")
159 ;;;###autoload
160 (defun trace-values (&rest values)
161 "Helper function to get internal values.
162 You can call this function to add internal values in the trace buffer."
163 (unless inhibit-trace
164 (with-current-buffer trace-buffer
165 (goto-char (point-max))
166 (insert
167 (trace-entry-message
168 'trace-values trace-level values "")))))
170 (defun trace-entry-message (function level args context)
171 "Generate a string that describes that FUNCTION has been entered.
172 LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION,
173 and CONTEXT is a string describing the dynamic context (e.g. values of
174 some global variables)."
175 (let ((print-circle t))
176 (format "%s%s%d -> %S%s\n"
177 (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
178 (if (> level 1) " " "")
179 level
180 ;; FIXME: Make it so we can click the function name to jump to its
181 ;; definition and/or untrace it.
182 (cons function args)
183 context)))
185 (defun trace-exit-message (function level value context)
186 "Generate a string that describes that FUNCTION has exited.
187 LEVEL is the trace level, VALUE value returned by FUNCTION,
188 and CONTEXT is a string describing the dynamic context (e.g. values of
189 some global variables)."
190 (let ((print-circle t))
191 (format "%s%s%d <- %s: %S%s\n"
192 (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
193 (if (> level 1) " " "")
194 level
195 function
196 ;; Do this so we'll see strings:
197 value
198 context)))
200 (defvar trace--timer nil)
202 (defun trace--display-buffer (buf)
203 (unless (or trace--timer
204 (get-buffer-window buf 'visible))
205 (setq trace--timer
206 ;; Postpone the display to some later time, in case we
207 ;; can't actually do it now.
208 (run-with-timer 0 nil
209 (lambda ()
210 (setq trace--timer nil)
211 (display-buffer buf nil 0))))))
214 (defun trace-make-advice (function buffer background context)
215 "Build the piece of advice to be added to trace FUNCTION.
216 FUNCTION is the name of the traced function.
217 BUFFER is the buffer where the trace should be printed.
218 BACKGROUND if nil means to display BUFFER.
219 CONTEXT if non-nil should be a function that returns extra info that should
220 be printed along with the arguments in the trace."
221 (lambda (body &rest args)
222 (let ((trace-level (1+ trace-level))
223 (trace-buffer (get-buffer-create buffer))
224 (deactivate-mark nil) ;Protect deactivate-mark.
225 (ctx (funcall context)))
226 (unless inhibit-trace
227 (with-current-buffer trace-buffer
228 (set (make-local-variable 'window-point-insertion-type) t)
229 (unless background (trace--display-buffer trace-buffer))
230 (goto-char (point-max))
231 ;; Insert a separator from previous trace output:
232 (if (= trace-level 1) (insert trace-separator))
233 (insert
234 (trace-entry-message
235 function trace-level args ctx))))
236 (let ((result))
237 (unwind-protect
238 (setq result (list (apply body args)))
239 (unless inhibit-trace
240 (let ((ctx (funcall context)))
241 (with-current-buffer trace-buffer
242 (unless background (trace--display-buffer trace-buffer))
243 (goto-char (point-max))
244 (insert
245 (trace-exit-message
246 function
247 trace-level
248 (if result (car result) '\!non-local\ exit\!)
249 ctx))))))
250 (car result)))))
252 (defun trace-function-internal (function buffer background context)
253 "Add trace advice for FUNCTION."
254 (advice-add
255 function :around
256 (trace-make-advice function (or buffer trace-buffer) background
257 (or context (lambda () "")))
258 `((name . ,trace-advice-name) (depth . -100))))
260 (defun trace-is-traced (function)
261 (advice-member-p trace-advice-name function))
263 (defun trace--read-args (prompt)
264 "Read a function name, prompting with string PROMPT.
265 If `current-prefix-arg' is non-nil, also read a buffer and a \"context\"
266 \(Lisp expression). Return (FUNCTION BUFFER FUNCTION-CONTEXT)."
267 (cons
268 (let ((default (function-called-at-point))
269 (beg (string-match ":[ \t]*\\'" prompt)))
270 (intern (completing-read (if default
271 (format
272 "%s (default %s)%s"
273 (substring prompt 0 beg)
274 default
275 (if beg (substring prompt beg) ": "))
276 prompt)
277 obarray 'fboundp t nil nil
278 (if default (symbol-name default)))))
279 (when current-prefix-arg
280 (list
281 (read-buffer "Output to buffer: " trace-buffer)
282 (let ((exp
283 (let ((minibuffer-completing-symbol t))
284 (read-from-minibuffer "Context expression: "
285 nil read-expression-map t
286 'read-expression-history))))
287 (lambda ()
288 (let ((print-circle t))
289 (concat " [" (prin1-to-string (eval exp t)) "]"))))))))
291 ;;;###autoload
292 (defun trace-function-foreground (function &optional buffer context)
293 "Trace calls to function FUNCTION.
294 With a prefix argument, also prompt for the trace buffer (default
295 `trace-buffer'), and a Lisp expression CONTEXT.
297 Tracing a function causes every call to that function to insert
298 into BUFFER Lisp-style trace messages that display the function's
299 arguments and return values. It also evaluates CONTEXT, if that is
300 non-nil, and inserts its value too. For example, you can use this
301 to track the current buffer, or position of point.
303 This function creates BUFFER if it does not exist. This buffer will
304 popup whenever FUNCTION is called. Do not use this function to trace
305 functions that switch buffers, or do any other display-oriented
306 stuff - use `trace-function-background' instead.
308 To stop tracing a function, use `untrace-function' or `untrace-all'."
309 (interactive (trace--read-args "Trace function: "))
310 (trace-function-internal function buffer nil context))
312 ;;;###autoload
313 (defun trace-function-background (function &optional buffer context)
314 "Trace calls to function FUNCTION, quietly.
315 This is like `trace-function-foreground', but without popping up
316 the output buffer or changing the window configuration."
317 (interactive (trace--read-args "Trace function in background: "))
318 (trace-function-internal function buffer t context))
320 ;;;###autoload
321 (defalias 'trace-function 'trace-function-foreground)
323 (defun untrace-function (function)
324 "Untraces FUNCTION and possibly activates all remaining advice.
325 Activation is performed with `ad-update', hence remaining advice will get
326 activated only if the advice of FUNCTION is currently active. If FUNCTION
327 was not traced this is a noop."
328 (interactive
329 (list (intern (completing-read "Untrace function: "
330 obarray #'trace-is-traced t))))
331 (advice-remove function trace-advice-name))
333 (defun untrace-all ()
334 "Untraces all currently traced functions."
335 (interactive)
336 (mapatoms #'untrace-function))
338 (provide 'trace)
340 ;;; trace.el ends here