1 ;;; An interactive debugger for lice
5 (defvar *debug-on-error
* t
6 "Non-nil means enter the debugger if an unhandled error is signaled.")
8 (defvar *debug-on-quit
* nil
9 "Non-nil means enter the debugger if quit is signaled (C-g, for example).")
11 (defvar *debugger-mode
*
12 (make-instance 'major-mode
14 :map
(let ((m (make-sparse-keymap)))
15 (define-key m
(kbd "q") 'debugger-invoke-top-level-restart
)
17 (defun debugger-mode ()
18 "See `*debugger-mode*'"
19 (set-major-mode '*debugger-mode
*))
21 (defun enter-debugger (condition old-debugger-value
)
22 "Create a debugger buffer, print the error and any active restarts."
23 (declare (ignore old-debugger-value
))
24 ;; maybe continue a sigint
25 (when (and (typep condition
'user-break
)
30 ;; make sure we're not in the minibuffer
31 (select-window (first (frame-window-list (selected-frame))))
32 (pop-to-buffer (get-buffer-create "*debugger*"))
34 (set-major-mode '*debugger-mode
*)
35 (insert (format nil
"Debugger~%~a~%~%~a~%~{~a~%~}" (backtrace-as-string) condition
(compute-restarts)))
37 ;; if we exit the recursive edit we'll fall into the regular debugger.
40 (defmacro with-lice-debugger
(&body body
)
41 `(let ((*debugger-hook
* #'enter-debugger
))
44 (defcommand debugger-invoke-top-level-restart
()
45 (when (get-buffer "*debugger*")
46 (kill-buffer (get-buffer "*debugger*")))
47 (invoke-restart (find-restart 'recursive-edit-top-level
)))