/[cmucl]/src/interface/debug.lisp
ViewVC logotype

Diff of /src/interface/debug.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by ram, Fri Feb 11 20:42:55 1994 UTC revision 1.7 by ram, Thu Mar 3 16:57:31 1994 UTC
# Line 525  Line 525 
525      (multiple-value-bind (shell connection)      (multiple-value-bind (shell connection)
526                           (create-interface-shell)                           (create-interface-shell)
527        (declare (ignore shell))        (declare (ignore shell))
528        (with-motif-connection (connection)        (if connection
529          (let ((pane (find-interface-pane condition))            (with-motif-connection (connection)
530                (*current-frame* frame))              (let ((pane (find-interface-pane condition))
531            (unless pane                    (*current-frame* frame))
532              (setf pane (create-debugger condition)))                (unless pane
533            (unless (is-managed pane)                  (setf pane (create-debugger condition)))
534              (popup-interface-pane pane))                (unless (is-managed pane)
535            (setf (dd-info-level *current-debug-display*) *debug-command-level*)                  (popup-interface-pane pane))
536            (setf (dd-info-connection *current-debug-display*) connection)                (setf (dd-info-level *current-debug-display*)
537            (unwind-protect                      *debug-command-level*)
538                (handler-case                (setf (dd-info-connection *current-debug-display*) connection)
539                    (loop                (unwind-protect
540                      (system:serve-event))                    (handler-case
541                  (error (err)                        (loop
542                         (if *flush-debug-errors*                          (system:serve-event))
543                             (interface-error (format nil "~a" err) pane)                      (error (err)
544                             (interface-error                             (if *flush-debug-errors*
545                              "Do not yet support recursive debugging" pane))))                                 (interface-error (format nil "~a" err) pane)
546              (when (and connection *current-debug-display*)                                 (interface-error
547                (with-motif-connection (connection)                                  "Do not yet support recursive debugging"
548                  (close-motif-debugger condition)))))))))                                  pane))))
549                    (when (and connection *current-debug-display*)
550                      (with-motif-connection (connection)
551                        (close-motif-debugger condition))))))
552              (invoke-tty-debugger condition)))))
553    
554    
555    
# Line 553  Line 557 
557  ;;;  ;;;
558  (defvar *in-windowing-debugger* nil)  (defvar *in-windowing-debugger* nil)
559    
560    
561    ;;; INVOKE-TTY-DEBUGGER  --  Internal
562    ;;;
563    ;;;    Print condition and invoke the TTY debugger.
564    ;;;
565    (defun invoke-tty-debugger (condition)
566      (format *error-output* "~2&~A~2&" *debug-condition*)
567      (unless (typep condition 'step-condition)
568        (show-restarts *debug-restarts* *error-output*))
569      (internal-debug))
570    
571  ;;; INVOKE-DEBUGGER -- Public  ;;; INVOKE-DEBUGGER -- Public
572  ;;;  ;;;
573  ;;; Invokes the Lisp debugger.  It executes some common debugger setup code  ;;; Invokes the Lisp debugger.  It executes some common debugger setup code
# Line 578  Line 593 
593      (if (or (not (use-graphics-interface))      (if (or (not (use-graphics-interface))
594              *in-windowing-debugger*              *in-windowing-debugger*
595              (typep condition 'xti:toolkit-error))              (typep condition 'xti:toolkit-error))
596          (progn          (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))  
597          (let ((*in-windowing-debugger* t))          (let ((*in-windowing-debugger* t))
598            (write-line "Invoking debugger...")            (write-line "Invoking debugger...")
599            (invoke-motif-debugger condition)))))            (invoke-motif-debugger condition)))))

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

  ViewVC Help
Powered by ViewVC 1.1.5