src/debugger.lisp

   1 ;;; An interactive debugger for lice
   2
   3 (in-package "LICE")
   4
   5 (defvar *debugger-mode*
   6   (make-instance 'major-mode
   7                  :name "Debugger"
   8                  :map  (let ((m (make-sparse-keymap)))
   9                          (define-key m (kbd "q") 'debugger-invoke-top-level-restart)
  10                          m)))
  11 (defun debugger-mode ()
  12   "See `*debugger-mode*'"
  13   (set-major-mode '*debugger-mode*))
  14
  15 (defun enter-debugger (condition old-debugger-value)
  16   "Create a debugger buffer, print the error and any active restarts."
  17   (declare (ignore old-debugger-value))
  18   ;; maybe continue a sigint
  19   (when (and (typep condition 'user-break)
  20              (or *inhibit-quit*
  21                  *waiting-for-input*))
  22     (setf *quit-flag* t)
  23     (continue))
  24   ;; make sure we're not in the minibuffer
  25   (select-window (first (frame-window-list (selected-frame))))
  26   (pop-to-buffer (get-buffer-create "*debugger*"))
  27   (erase-buffer)
  28   (set-major-mode '*debugger-mode*)
  29   (insert (format nil "Debugger~%~a~%~%~a~%~{~a~%~}" (backtrace-as-string) condition (compute-restarts)))
  30   (recursive-edit)
  31   ;; if we exit the recursive edit we'll fall into the regular debugger.
  32   )
  33
  34 (defmacro with-lice-debugger (&body body)
  35   `(let ((*debugger-hook* #'enter-debugger))
  36      ,@body))
  37
  38 (defcommand debugger-invoke-top-level-restart ()
  39   (when (get-buffer "*debugger*")
  40     (kill-buffer (get-buffer "*debugger*")))
  41   (invoke-restart (find-restart 'recursive-edit-top-level)))
  42
  43 (defcommand toggle-debug-on-error ()
  44   "Toggle whether to enter Lisp debugger when an error is signaled.
  45 In an interactive call, record this option as a candidate for saving
  46 by \"Save Options\" in Custom buffers."
  47   (setf *debug-on-error* (not *debug-on-error*)))
  48
  49 (defcommand toggle-debug-on-quit ()
  50   "Toggle whether to enter Lisp debugger when C-g is pressed.
  51 In an interactive call, record this option as a candidate for saving
  52 by \"Save Options\" in Custom buffers."
  53   (setf *debug-on-quit* (not *debug-on-quit*)))