debugger.lisp

   1 ;;; An interactive debugger for lice
   2
   3 (in-package #:lice)
   4
   5 (defvar *debug-on-error* t
   6   "Non-nil means enter the debugger if an unhandled error is signaled.")
   7
   8 (defvar *debug-on-quit* nil
   9   "Non-nil means enter the debugger if quit is signaled (C-g, for example).")
  10
  11 (defvar *debugger-mode*
  12   (make-instance 'major-mode
  13                  :name "Debugger"
  14                  :map  (let ((m (make-sparse-keymap)))
  15                          (define-key m (kbd "q") 'debugger-invoke-top-level-restart)
  16                          m)))
  17 (defun debugger-mode ()
  18   "See `*debugger-mode*'"
  19   (set-major-mode *debugger-mode*))
  20
  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)
  26              (or *inhibit-quit*
  27                  *waiting-for-input*))
  28     (setf *quit-flag* t)
  29     (continue))
  30   ;; make sure we're not in the minibuffer
  31   (select-window (first (frame-window-list *current-frame*)))
  32   (pop-to-buffer (get-buffer-create "*debugger*"))
  33   (erase-buffer)
  34   (set-major-mode *debugger-mode*)
  35   (insert (format nil "Debugger~%~a~%~%~a~%~{~a~%~}" (backtrace-as-string) condition (compute-restarts)))
  36   (recursive-edit)
  37   ;; if we exit the recursive edit we'll fall into the regular debugger.
  38   )
  39
  40 (defmacro with-lice-debugger (&body body)
  41   `(let ((*debugger-hook* #'enter-debugger))
  42      ,@body))
  43
  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)))