diff --git a/interface/debug.lisp b/interface/debug.lisp index 873a67432088519fd09c6e33b21c6e73301fdf82..70b8b68d98b124f5f3d8a53774d22e79196ffc6f 100644 --- a/interface/debug.lisp +++ b/interface/debug.lisp @@ -525,27 +525,31 @@ (multiple-value-bind (shell connection) (create-interface-shell) (declare (ignore shell)) - (with-motif-connection (connection) - (let ((pane (find-interface-pane condition)) - (*current-frame* frame)) - (unless pane - (setf pane (create-debugger condition))) - (unless (is-managed pane) - (popup-interface-pane pane)) - (setf (dd-info-level *current-debug-display*) *debug-command-level*) - (setf (dd-info-connection *current-debug-display*) connection) - (unwind-protect - (handler-case - (loop - (system:serve-event)) - (error (err) - (if *flush-debug-errors* - (interface-error (format nil "~a" err) pane) - (interface-error - "Do not yet support recursive debugging" pane)))) - (when (and connection *current-debug-display*) - (with-motif-connection (connection) - (close-motif-debugger condition))))))))) + (if connection + (with-motif-connection (connection) + (let ((pane (find-interface-pane condition)) + (*current-frame* frame)) + (unless pane + (setf pane (create-debugger condition))) + (unless (is-managed pane) + (popup-interface-pane pane)) + (setf (dd-info-level *current-debug-display*) + *debug-command-level*) + (setf (dd-info-connection *current-debug-display*) connection) + (unwind-protect + (handler-case + (loop + (system:serve-event)) + (error (err) + (if *flush-debug-errors* + (interface-error (format nil "~a" err) pane) + (interface-error + "Do not yet support recursive debugging" + pane)))) + (when (and connection *current-debug-display*) + (with-motif-connection (connection) + (close-motif-debugger condition)))))) + (invoke-tty-debugger condition))))) @@ -553,6 +557,17 @@ ;;; (defvar *in-windowing-debugger* nil) + +;;; INVOKE-TTY-DEBUGGER -- Internal +;;; +;;; Print condition and invoke the TTY debugger. +;;; +(defun invoke-tty-debugger (condition) + (format *error-output* "~2&~A~2&" *debug-condition*) + (unless (typep condition 'step-condition) + (show-restarts *debug-restarts* *error-output*)) + (internal-debug)) + ;;; INVOKE-DEBUGGER -- Public ;;; ;;; Invokes the Lisp debugger. It executes some common debugger setup code @@ -578,11 +593,7 @@ (if (or (not (use-graphics-interface)) *in-windowing-debugger* (typep condition 'xti:toolkit-error)) - (progn - (format *error-output* "~2&~A~2&" *debug-condition*) - (unless (typep condition 'step-condition) - (show-restarts *debug-restarts* *error-output*)) - (internal-debug)) + (invoke-tty-debugger condition) (let ((*in-windowing-debugger* t)) (write-line "Invoking debugger...") (invoke-motif-debugger condition)))))