;; Created by: Joe Wells, jbw@cs.bu.edu
;; Created on: Fri May 15 13:16:01 1992
;; Last modified by: Joe Wells, jbw@csd
;; Last modified on: Fri May 15 17:03:28 1992
;; Filename: backtrace-fix.el
;; Purpose: make backtrace useful when circular structures are on the stack

;; Changes by MDE:  made filename backtracef.el for System V compatibility,
;; added the following three statements.
(provide 'backtrace-fix)
(provide 'backtracef)
(defvar error-flag)			; quiet the byte-compiler

(or (fboundp 'original-backtrace)
    (fset 'original-backtrace
	  (symbol-function 'backtrace)))

(defconst backtrace-junk "\
  original-backtrace()
  (condition-case ...)
  (let ...)
  (save-excursion ...)
  (let ...)
")
(defun backtrace ()
  "Print a trace of Lisp function calls currently active.
Output stream used is value of standard-output."
  (let (err-flag)
    (save-excursion
      (set-buffer (get-buffer-create " backtrace-temp"))
      (buffer-flush-undo (current-buffer))
      (erase-buffer)
      (let ((standard-output (current-buffer)))
	(condition-case err
	    (original-backtrace)
	  (error
	   (setq error-flag err))))
      (cond (err-flag
	     (goto-char (point-max))
	     (beginning-of-line 1)
	     ;; don't leave any unbalanced parens lying around
	     (delete-region (point) (point-max))))
      (goto-char (point-min))
      (search-forward backtrace-junk nil t)
      (delete-region (point-min) (point))
      (princ (buffer-substring (point-min) (point-max)))))
  nil)