home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / edb / backtracef.el next >
Encoding:
Text File  |  1993-04-08  |  1.5 KB  |  48 lines
  1. ;; Created by: Joe Wells, jbw@cs.bu.edu
  2. ;; Created on: Fri May 15 13:16:01 1992
  3. ;; Last modified by: Joe Wells, jbw@csd
  4. ;; Last modified on: Fri May 15 17:03:28 1992
  5. ;; Filename: backtrace-fix.el
  6. ;; Purpose: make backtrace useful when circular structures are on the stack
  7.  
  8. ;; Changes by MDE:  made filename backtracef.el for System V compatibility,
  9. ;; added the following three statements.
  10. (provide 'backtrace-fix)
  11. (provide 'backtracef)
  12. (defvar error-flag)            ; quiet the byte-compiler
  13.  
  14. (or (fboundp 'original-backtrace)
  15.     (fset 'original-backtrace
  16.       (symbol-function 'backtrace)))
  17.  
  18. (defconst backtrace-junk "\
  19.   original-backtrace()
  20.   (condition-case ...)
  21.   (let ...)
  22.   (save-excursion ...)
  23.   (let ...)
  24. ")
  25. (defun backtrace ()
  26.   "Print a trace of Lisp function calls currently active.
  27. Output stream used is value of standard-output."
  28.   (let (err-flag)
  29.     (save-excursion
  30.       (set-buffer (get-buffer-create " backtrace-temp"))
  31.       (buffer-flush-undo (current-buffer))
  32.       (erase-buffer)
  33.       (let ((standard-output (current-buffer)))
  34.     (condition-case err
  35.         (original-backtrace)
  36.       (error
  37.        (setq error-flag err))))
  38.       (cond (err-flag
  39.          (goto-char (point-max))
  40.          (beginning-of-line 1)
  41.          ;; don't leave any unbalanced parens lying around
  42.          (delete-region (point) (point-max))))
  43.       (goto-char (point-min))
  44.       (search-forward backtrace-junk nil t)
  45.       (delete-region (point-min) (point))
  46.       (princ (buffer-substring (point-min) (point-max)))))
  47.   nil)
  48.