NetNews Usenet Archive 1992 #30/NN_1992_30.iso/spool/gnu/emacs/sources/867

Text File | 1992-12-16 | 9.2 KB | 280 lines

Path: sparky!uunet!elroy.jpl.nasa.gov!swrinde!news.dell.com!natinst.com!cs.utexas.edu!qt.cs.utexas.edu!yale.edu!spool.mu.edu!umn.edu!cs.widener.edu!dsinc!ub!acsu.buffalo.edu!hans
From: [e-mail] (Hans Chalupsky)
Newsgroups: gnu.emacs.sources
Subject: trace.el - a trace package for Emacs-Lisp functions
Message-ID: <[e-mail]>
Date: 16 Dec 92 04:48:49 GMT
Sender: [e-mail]
Distribution: gnu
Organization: State University of New York at Buffalo/Comp Sci
Lines: 267
Nntp-Posting-Host: hadar.cs.buffalo.edu

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

[e-mail]
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 ([e-mail])
;; 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 [e-mail]) 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 [e-mail] 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 [e-mail].
;; 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 ([e-mail]),
;;  ;; 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