;; stack-dump.kl
;; An error handler which prints the the stack and the error message

(if (boundp 'print-stack-dump)
  (throw 'ERROR ())			; if already defined, stop reading
)

print-stack-dump			;forces autoload now.

(defun print-stack-dump-on-error-handler (&rest args)
  (apply print-stack-dump:pre-handler args)
  (apply print-stack-dump args)
  (apply print-stack-dump:post-handler args)
  (if print-stack-dump:exit-after
    (exit 1)
  )
)

;; USAGE: (setq *error-handlers* '(print-stack-dump))
;;AUTOLOAD: stack-dump-on-error
;;AUTODOC: stack-dump-on-error "dumps stack to stderr on error"
;;(stack-dump-on-error flag [depth [exit]])
;;
;;If flag is true, the next uncaught error will print the error message and
;;the full stack dump to the standard output. 
;;(stack-dump-on-error ()) disables this behavior (default).
;;Very useful in scripts.
;;(stack-dump-on-error t N) will limit the print to the first N frames
;;(stack-dump-on-error t N t) will make an exit afterwards

(defvar stack-dump-on-error:old ())
(defun stack-dump-on-error (&optional install (max-level *maxint*) exit-after
  pre-handler post-handler)
  (if install
    (progn
      (setq stack-dump-on-error:old *error-handlers*)
      (setq *error-handlers* '(print-stack-dump-on-error-handler))
      (setq print-stack-dump:max-level max-level)
      (setq print-stack-dump:exit-after exit-after)
      (setq print-stack-dump:pre-handler pre-handler)
      (setq print-stack-dump:post-handler post-handler)
    )
    (if stack-dump-on-error:old
      (setq *error-handlers* stack-dump-on-error:old)
)))
      
