/[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.8 by ram, Mon Oct 31 04:53:18 1994 UTC revision 1.9 by pmai, Wed Dec 12 20:18:25 2001 UTC
# Line 98  Line 98 
98        (let ((*current-frame* frame))        (let ((*current-frame* frame))
99          (funcall (debug-command-p :edit-source)))          (funcall (debug-command-p :edit-source)))
100      (error (cond)      (error (cond)
101             (interface-error (format nil "~A" cond)))))             (interface-error (safe-condition-message cond)))))
102    
103  (defun frame-eval-callback (widget call-data frame output)  (defun frame-eval-callback (widget call-data frame output)
104    (declare (ignore call-data))    (declare (ignore call-data))
# Line 115  Line 115 
115                               (di:eval-in-frame frame (read-from-string input))))                               (di:eval-in-frame frame (read-from-string input))))
116                          (format nil "~a~s~%" out val))                          (format nil "~a~s~%" out val))
117                      (error (cond)                      (error (cond)
118                             (format nil "~2&~A~2&" cond)))))                             (safe-condition-message cond)))))
119            (length (length response)))           (length (length response)))
120      (declare (simple-string response))      (declare (simple-string response))
121    
122      (text-set-string widget "")      (text-set-string widget "")
# Line 299  Line 299 
299  ;;; condition.  ;;; condition.
300  ;;;  ;;;
301  (defun debug-display-error (errmsg condition)  (defun debug-display-error (errmsg condition)
302    (set-values errmsg :label-string (format nil "~A" condition)))    (set-values errmsg :label-string (safe-condition-message condition)))
303    
304  ;;; DEBUG-DISPLAY-RESTARTS -- Internal  ;;; DEBUG-DISPLAY-RESTARTS -- Internal
305  ;;;  ;;;
# Line 543  Line 543 
543                          (system:serve-event))                          (system:serve-event))
544                      (error (err)                      (error (err)
545                             (if *flush-debug-errors*                             (if *flush-debug-errors*
546                                 (interface-error (format nil "~a" err) pane)                                 (interface-error (safe-condition-message err)
547                                                    pane)
548                                 (interface-error                                 (interface-error
549                                  "Do not yet support recursive debugging"                                  "Do not yet support recursive debugging"
550                                  pane))))                                  pane))))
# Line 559  Line 560 
560  (defvar *in-windowing-debugger* nil)  (defvar *in-windowing-debugger* nil)
561    
562    
563  ;;; INVOKE-TTY-DEBUGGER  --  Internal  ;;; REAL-INVOKE-DEBUGGER -- Internal
564  ;;;  ;;;
565  ;;;    Print condition and invoke the TTY debugger.  ;;; Invokes the Lisp debugger.  It decides whether to invoke the TTY
566    ;;; debugger or the Motif debugger.
567  ;;;  ;;;
568  (defun invoke-tty-debugger (condition)  (defun real-invoke-debugger (condition)
569    (format *error-output* "~2&~A~2&" *debug-condition*)    (if (or (not (use-graphics-interface))
570    (unless (typep condition 'step-condition)            *in-windowing-debugger*
571      (show-restarts *debug-restarts* *error-output*))            (typep condition 'xti:toolkit-error))
572    (internal-debug))        (invoke-tty-debugger condition)
573          (let ((*in-windowing-debugger* t))
574  ;;; INVOKE-DEBUGGER -- Public          (write-line "Invoking debugger...")
575  ;;;          (invoke-motif-debugger condition))))
 ;;; Invokes the Lisp debugger.  It executes some common debugger setup code  
 ;;; and then decides whether to invoke the TTY debugger or the Motif  
 ;;; debugger.  
 ;;;  
 (defun invoke-debugger (condition)  
   "The CMU Common Lisp debugger.  Type h for help."  
   (when *debugger-hook*  
     (let ((hook *debugger-hook*)  
           (*debugger-hook* nil))  
       (funcall hook condition hook)))  
   (unix:unix-sigsetmask 0)  
   (let* ((*debug-condition* condition)  
          (*debug-restarts* (compute-restarts condition))  
          (*standard-input* *debug-io*)          ;in case of setq  
          (*standard-output* *debug-io*)         ;''  ''  ''  ''  
          (*error-output* *debug-io*)  
          ;; Rebind some printer control variables.  
          (kernel:*current-level* 0)  
          (*print-readably* nil)  
          (*read-eval* t))  
     (if (or (not (use-graphics-interface))  
             *in-windowing-debugger*  
             (typep condition 'xti:toolkit-error))  
         (invoke-tty-debugger condition)  
         (let ((*in-windowing-debugger* t))  
           (write-line "Invoking debugger...")  
           (invoke-motif-debugger condition)))))  

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

  ViewVC Help
Powered by ViewVC 1.1.5