🚀 go-pugleaf

Here is a simple trace package that gives you Lisp-style trace output for
Emacs-Lisp functions. The package is based on advice.el previously posted
here. 

The latest versions of trace.el and advice.el are also available via anonymous
ftp from ftp.cs.buffalo.edu (128.205.32.9) in directory /pub/Emacs/.

Enjoy,

Hans

hans@cs.buffalo.edu
Hans Chalupsky, Dept. of CS, 226 Bell Hall, SUNY@Buffalo, NY 14260.

------------------------ cut here ------------------------
;; -*-Emacs-Lisp-*-
;;
;; Tracing facility for Emacs-Lisp functions
;;
;; Copyright (C) 1992 Hans Chalupsky
;;
;; File:     trace.el
;; Revision: $Revision: 1.1 $
;; Author:   Hans Chalupsky (hans@cs.buffalo.edu)
;; Created:   Date: 92/12/09 19:18:06
;; Modified: $Date: 92/12/15 22:45:15 $
;;
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; A copy of the GNU General Public License can be obtained from this
;; program's author (send electronic mail to hans@cs.buffalo.edu) or from
;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;; 02139, USA.
;;
;;
;; Description:
;; ============
;; 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.
;;
;; Restrictions:
;; =============
;; - Traced subrs when called interactively will always show nil as the
;;   value of ad-subr-args.
;; - Subrs called from other subrs/C-code won't generate any trace output.
;; - All the restrictions that apply to advice.el
;;
;; Installation:
;; =============
;; Put this file together with advice.el (which you can get from the same
;; ftp directory mentioned above) somewhere into your Emacs load-path, 
;; byte-compile it/them for efficiency, and put the following autoload 
;; declaration into your .emacs
;;
;;    (autoload 'trace-function "trace" "Trace a function" t nil)
;;
;; 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.
;; Also feel free to mail me any questions you might have about trace.el.
;;
;; Usage:
;; ======
;; - To trace a function say M-x trace-function which will ask you for the name
;;   of the function/subr/macro you want to trace, as well as for the buffer
;;   into which trace output should go. With a prefix argument the tracing
;;   will be done silently in the background. 
;; - To untrace a function say M-x untrace-function and supply the function 
;;   you want to have untraced as an argument. 
;; - To untrace all currently traced functions say M-x untrace-all.
;;
;;
;; Examples:
;; =========
;;
;;  (defun fact (n)
;;    (if (= n 0) 1
;;      (* n (fact (1- n)))))
;;  fact
;;  
;;  (trace-function 'fact)
;;  fact
;;
;;  ;; Now, evaluating this...
;;  (fact 4)
;;  24
;;
;;  ;; ...will generate the following in *trace-buffer*:  
;;  1 -> fact: n=4
;;  | 2 -> fact: n=3
;;  | | 3 -> fact: n=2
;;  | | | 4 -> fact: n=1
;;  | | | | 5 -> fact: n=0
;;  | | | | 5 <- fact: 1
;;  | | | 4 <- fact: 1
;;  | | 3 <- fact: 2
;;  | 2 <- fact: 6
;;  1 <- fact: 24
;;
;;
;;  (defun ack (x y z)
;;    (if (= x 0) 
;;        (+ y z)
;;      (if (and (<= x 2) (= z 0)) 
;;          (1- x)
;;        (if (and (> x 2) (= z 0)) 
;;            y
;;          (ack (1- x) y (ack x y (1- z)))))))
;;  ack
;;
;;  (trace-function 'ack)
;;  ack
;;
;;  ;; Try this for some interesting trace output:
;;  (ack 3 3 1)
;;  27
;;
;; 
;;  ;; The following does something similar to the functionality of the
;;  ;; package log-message.el by Robert Potter (rpotter@grip.cis.upenn.edu),
;;  ;; which is giving you a chance to look at messages that might have
;;  ;; whizzed by too quickly (you won't see subr generated messages though):
;;
;;  (trace-function 'message "*Message Log*" t)
;;


(require 'advice)
(require 'backquote)

(defconst trace-version (substring "$Revision: 1.1 $" 11 -2))

(defvar trace-buffer "*trace-output*"
  "Trace output will by default go to that buffer")

(defvar traced-functions nil
  "List of functions that are currently traced")

(defvar trace-level 0
  "Current level of traced function invocation")

(defvar trace-in-background nil
  "If non-NIL all trace ouput will silently go to trace-buffer, otherwise
the execution of a traced function will pop to the trace-buffer.")

(defvar trace-separator (format "%s\n" (make-string 70 ?=))
  "Used to separate new trace output from previous traced runs")


(defun trace-entry-message (function level argument-bindings)
  "Generates a string that describes that FUNCTION has been entered at
trace LEVEL with ARGUMENT-BINDINGS."
  (format "%s%s%d -> %s: %s\n"
	  (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
	  (if (> level 1) " " "")
	  level
	  function
	  (mapconcat (function
		      (lambda (binding)
		       (format "%s=%s"
			       (ad-arg-binding-field binding 'name)
			       (ad-arg-binding-field binding 'value))))
		     argument-bindings
		     " ")))

(defun trace-exit-message (function level value)
  "Generates a string that describes that FUNCTION has been exited at
trace LEVEL and that it returned VALUE."
  (format "%s%s%d <- %s: %s\n"
	  (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
	  (if (> level 1) " " "")
	  level
	  function
	  value))

(defun trace-function (function &optional buffer background)
  "Generates the trace advice for FUNCTION and activates it (and all other
advice there might be!!) Trace output will go to BUFFER. If BACKGROUND is
non-NIL (or when called with a prefix argument) trace output will be
generated in the background, otherwise a traced FUNCTION will popup its
trace BUFFER whenever it is called."
  (interactive
   (call-interactively
    (progn
      ;; This seems to be the only way to influence the default used by the
      ;; B specifier in interactive. Messes with buffer list but is much less
      ;; work than doing the correct thing by hand:
      (save-excursion
	(switch-to-buffer (get-buffer-create trace-buffer)))
      '(lambda (function &optional buffer background)
	(interactive "aFunction to trace: \nBOutput to buffer: \nP")
	(list function buffer background)))))
  (ad-add-advice
   function
   (ad-make-advice
    'trace nil
    (` ((let ((trace-level (1+ trace-level))
	      (trace-buffer (get-buffer-create (, (or buffer trace-buffer))))
	      (trace-in-background (, (and background t))))
	  (if (and (= trace-level 1)
		   (not trace-in-background))
	      (pop-to-buffer trace-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)))
	  (if (not trace-in-background) (goto-char (point-max)))
	  ad-do-it
	  (save-excursion
	    (set-buffer trace-buffer)
	    (goto-char (point-max))
	    (insert
	     (trace-exit-message
	      '(, function) trace-level ad-return-value)))
	  (if (not trace-in-background) (goto-char (point-max)))
	  ))))
   'around 'last)
  (if (ad-has-proper-definition function)
      (ad-activate function nil))
  (if (not (memq function traced-functions))
      (setq traced-functions (cons function traced-functions)))
  function)

(defun untrace-function (function)
  "Untraces FUNCTION and activates all remaining advice information. If 
FUNCTION was not traced this is a noop."
  (interactive "aFunction to untrace: ")
  (cond ((memq function traced-functions)
	 (ad-remove-advice function 'around 'trace)
	 (if (ad-has-proper-definition function)
	     (ad-activate function nil))
	 (setq traced-functions (delq function traced-functions))
	 function)))

(defun untrace-all ()
  "Untraces all currently traced functions"
  (interactive)
  (ad-dolist (traced-fn (copy-alist traced-functions))
     (untrace-function traced-fn)))

(provide 'trace)

;; eof