(inhibit-trace): New var.

(trace-make-advice): Use it.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 51e13988a8150fdc4470ba4f12eee93426ea0bd8..be90765ae3621e3682309b2b497916b788051944 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2005-02-26  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * emacs-lisp/trace.el (inhibit-trace): New var.
+       (trace-make-advice): Use it.
+
+       * emacs-lisp/debug.el (debug): Put back the inhibit-trace.
+
 2005-02-26  Kim F. Storm  <storm@cua.dk>
 
        * mouse.el (mouse-1-click-in-non-selected-windows): New defcustom.

diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index a6ff9b152869669ae1ee7059135ca904a18da866..e3d3e9e645e4a8e3c711fc59aeb33fb52917b359 100644 (file)
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -1,6 +1,6 @@
 ;;; trace.el --- tracing facility for Emacs Lisp functions
 
-;; Copyright (C) 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1998, 2000, 2005  Free Software Foundation, Inc.
 
 ;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
 ;; Maintainer: FSF
@@ -175,6 +175,9 @@
 ;; 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.
@@ -183,14 +186,13 @@
          (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
                     " ")))
 
@@ -211,43 +213,27 @@
   ;; (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.
@@ -297,9 +283,9 @@ 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."
@@ -309,5 +295,5 @@ was not traced this is a noop."
 
 (provide 'trace)
 
-;;; arch-tag: cfd170a7-4932-4331-8c8b-b7151942e5a1
+;; arch-tag: cfd170a7-4932-4331-8c8b-b7151942e5a1
 ;;; trace.el ends here