;;; trace.el --- tracing facility for Emacs Lisp functions
-;; Copyright (C) 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1998, 2000, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
+;; Maintainer: FSF
;; Created: 15 Dec 1992
;; Keywords: tools, lisp
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;; LCD Archive Entry:
;; trace|Hans Chalupsky|hans@cs.buffalo.edu|
;; Introduction:
;; =============
-;; A simple trace package that utilizes advice.el. It generates trace
+;; A simple trace package that utilizes advice.el. It generates trace
;; information in a Lisp-style fashion and inserts it into a trace output
;; buffer. Tracing can be done in the background (or silently) so that
;; generation of trace output won't interfere with what you are currently
;; doing.
-;; How to get the latest trace.el:
-;; ===============================
-;; You can get the latest version of this file either via anonymous ftp from
-;; ftp.cs.buffalo.edu (128.205.32.9) with pathname /pub/Emacs/trace.el,
-;; or send email to hans@cs.buffalo.edu and I'll mail it to you.
-
;; Requirement:
;; ============
;; trace.el needs advice.el version 2.0 or later which you can get from the
;;
;; or explicitly load it with (require 'trace) or (load "trace").
-;; Comments, suggestions, bug reports
-;; ==================================
-;; are strongly appreciated, please email them to hans@cs.buffalo.edu.
-
;; Usage:
;; ======
;; - To trace a function say `M-x trace-function' which will ask you for the
;; (if (= n 0) 1
;; (* n (fact (1- n)))))
;; fact
-;;
+;;
;; (trace-function 'fact)
;; fact
;;
;;
;;
;; (defun ack (x y z)
-;; (if (= x 0)
+;; (if (= x 0)
;; (+ y z)
-;; (if (and (<= x 2) (= z 0))
+;; (if (and (<= x 2) (= z 0))
;; (1- x)
-;; (if (and (> x 2) (= z 0))
+;; (if (and (> x 2) (= z 0))
;; y
;; (ack (1- x) y (ack x y (1- z)))))))
;; ack
;; (ack 3 3 1)
;; 27
;;
-;;
+;;
;; The following does something similar to the functionality of the package
;; log-message.el by Robert Potter, which is giving you a chance to look at
;; messages that might have whizzed by too quickly (you won't see subr
(require 'advice)
+(defgroup trace nil
+ "Tracing facility for Emacs Lisp functions."
+ :prefix "trace-"
+ :group 'lisp)
+
;;;###autoload
-(defvar trace-buffer "*trace-output*"
- "*Trace output will by default go to that buffer.")
+(defcustom trace-buffer "*trace-output*"
+ "*Trace output will by default go to that buffer."
+ :type 'string
+ :group 'trace)
;; Current level of traced function invocation:
(defvar trace-level 0)
;; Used to separate new trace output from previous traced runs:
(defvar trace-separator (format "%s\n" (make-string 70 ?=)))
+(defvar inhibit-trace nil
+ "If non-nil, all tracing is temporarily inhibited.")
+
(defun trace-entry-message (function level argument-bindings)
;; Generates a string that describes that FUNCTION has been entered at
;; trace LEVEL with ARGUMENT-BINDINGS.
(if (> level 1) " " "")
level
function
- (mapconcat (function
- (lambda (binding)
- (concat
- (symbol-name (ad-arg-binding-field binding 'name))
- "="
- ;; do this so we'll see strings:
- (prin1-to-string
- (ad-arg-binding-field binding 'value)))))
+ (mapconcat (lambda (binding)
+ (concat
+ (symbol-name (ad-arg-binding-field binding 'name))
+ "="
+ ;; do this so we'll see strings:
+ (prin1-to-string
+ (ad-arg-binding-field binding 'value))))
argument-bindings
" ")))
;; (quietly if BACKGROUND is t).
(ad-make-advice
trace-advice-name nil t
- (cond (background
- (` (advice
- lambda ()
- (let ((trace-level (1+ trace-level))
- (trace-buffer (get-buffer-create (, buffer))))
- (save-excursion
- (set-buffer trace-buffer)
- (goto-char (point-max))
- ;; Insert a separator from previous trace output:
- (if (= trace-level 1) (insert trace-separator))
- (insert
- (trace-entry-message
- '(, function) trace-level ad-arg-bindings)))
- ad-do-it
- (save-excursion
- (set-buffer trace-buffer)
- (goto-char (point-max))
- (insert
- (trace-exit-message
- '(, function) trace-level ad-return-value)))))))
- (t (` (advice
- lambda ()
- (let ((trace-level (1+ trace-level))
- (trace-buffer (get-buffer-create (, buffer))))
- (pop-to-buffer trace-buffer)
- (goto-char (point-max))
- ;; Insert a separator from previous trace output:
- (if (= trace-level 1) (insert trace-separator))
- (insert
- (trace-entry-message
- '(, function) trace-level ad-arg-bindings))
- ad-do-it
- (pop-to-buffer trace-buffer)
- (goto-char (point-max))
- (insert
- (trace-exit-message
- '(, function) trace-level ad-return-value)))))))))
+ `(advice
+ lambda ()
+ (let ((trace-level (1+ trace-level))
+ (trace-buffer (get-buffer-create ,buffer)))
+ (unless inhibit-trace
+ (with-current-buffer trace-buffer
+ ,(unless background '(pop-to-buffer trace-buffer))
+ (goto-char (point-max))
+ ;; Insert a separator from previous trace output:
+ (if (= trace-level 1) (insert trace-separator))
+ (insert
+ (trace-entry-message
+ ',function trace-level ad-arg-bindings))))
+ ad-do-it
+ (unless inhibit-trace
+ (with-current-buffer trace-buffer
+ ,(unless background '(pop-to-buffer trace-buffer))
+ (goto-char (point-max))
+ (insert
+ (trace-exit-message
+ ',function trace-level ad-return-value))))))))
(defun trace-function-internal (function buffer background)
;; Adds trace advice for FUNCTION and activates it.
(defun trace-function (function &optional buffer)
"Traces FUNCTION with trace output going to BUFFER.
For every call of FUNCTION Lisp-style trace messages that display argument
-and return values will be inserted into BUFFER. This function generates the
+and return values will be inserted into BUFFER. This function generates the
trace advice for FUNCTION and activates it together with any other advice
there might be!! The trace BUFFER will popup whenever FUNCTION is called.
Do not use this to trace functions that switch buffers or do any other
(defun trace-function-background (function &optional buffer)
"Traces FUNCTION with trace output going quietly to BUFFER.
For every call of FUNCTION Lisp-style trace messages that display argument
-and return values will be inserted into BUFFER. This function generates the
+and return values will be inserted into BUFFER. This function generates the
trace advice for FUNCTION and activates it together with any other advice
there might be!! Trace output will quietly go to BUFFER without changing
the window or buffer configuration at all."
(defun untrace-function (function)
"Untraces FUNCTION and possibly activates all remaining advice.
Activation is performed with `ad-update', hence remaining advice will get
-activated only if the advice of FUNCTION is currently active. If FUNCTION
+activated only if the advice of FUNCTION is currently active. If FUNCTION
was not traced this is a noop."
(interactive
(list (ad-read-advised-function "Untrace function: " 'trace-is-traced)))
- (cond ((trace-is-traced function)
- (ad-remove-advice function 'around trace-advice-name)
- (ad-update function))))
+ (when (trace-is-traced function)
+ (ad-remove-advice function 'around trace-advice-name)
+ (ad-update function)))
(defun untrace-all ()
"Untraces all currently traced functions."
(provide 'trace)
+;; arch-tag: cfd170a7-4932-4331-8c8b-b7151942e5a1
;;; trace.el ends here