[Emacs-diffs] Changes to emacs/lisp/emacs-lisp/trace.el

[Stefan Monnier]

Index: emacs/lisp/emacs-lisp/trace.el
diff -c emacs/lisp/emacs-lisp/trace.el:1.8 emacs/lisp/emacs-lisp/trace.el:1.9
*** emacs/lisp/emacs-lisp/trace.el:1.8  Mon Sep  1 15:45:22 2003
--- emacs/lisp/emacs-lisp/trace.el      Sun Feb 27 02:30:24 2005
***************
*** 1,6 ****
  ;;; trace.el --- tracing facility for Emacs Lisp functions
  
! ;; Copyright (C) 1993 Free Software Foundation, Inc.
  
  ;; Author: Hans Chalupsky <address@hidden>
  ;; Maintainer: FSF
--- 1,6 ----
  ;;; trace.el --- tracing facility for Emacs Lisp functions
  
! ;; Copyright (C) 1993, 1998, 2000, 2005  Free Software Foundation, Inc.
  
  ;; Author: Hans Chalupsky <address@hidden>
  ;; Maintainer: FSF
***************
*** 175,180 ****
--- 175,183 ----
  ;; 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,196 ****
          (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)))))
                     argument-bindings
                     " ")))
  
--- 186,198 ----
          (if (> level 1) " " "")
          level
          function
!         (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,253 ****
    ;; (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))))))))
  
  (defun trace-function-internal (function buffer background)
    ;; Adds trace advice for FUNCTION and activates it.
--- 213,239 ----
    ;; (quietly if BACKGROUND is t).
    (ad-make-advice
     trace-advice-name nil t
!    `(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,305 ****
  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))))
  
  (defun untrace-all ()
    "Untraces all currently traced functions."
--- 283,291 ----
  was not traced this is a noop."
    (interactive
     (list (ad-read-advised-function "Untrace function: " 'trace-is-traced)))
!   (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,313 ****
  
  (provide 'trace)
  
! ;;; arch-tag: cfd170a7-4932-4331-8c8b-b7151942e5a1
  ;;; trace.el ends here
--- 295,299 ----
  
  (provide 'trace)
  
! ;; arch-tag: cfd170a7-4932-4331-8c8b-b7151942e5a1
  ;;; trace.el ends here