/[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.1 by garland, Thu Nov 12 14:08:12 1992 UTC revision 1.2 by garland, Wed Feb 10 12:34:37 1993 UTC
# Line 123  Line 123 
123            (di:do-debug-function-variables (v debug-fun)            (di:do-debug-function-variables (v debug-fun)
124              (unless any-p              (unless any-p
125                (setf any-p t)                (setf any-p t)
126                (push (create-label-gadget frame-view "localsLabel"                (push (create-label frame-view "localsLabel"
127                                           :font-list *header-font*                                           :font-list *header-font*
128                                           :label-string "Local variables:")                                           :label-string "Local variables:")
129                      widgets))                      widgets))
# Line 142  Line 142 
142            (cond            (cond
143             ((not any-p)             ((not any-p)
144              (push              (push
145               (create-label-gadget frame-view "noLocals"               (create-label frame-view "noLocals"
146                                    :font-list *italic-font*                                    :font-list *italic-font*
147                                    :label-string                                    :label-string
148                                    "   No local variables in function.")                                    "   No local variables in function.")
149               widgets))               widgets))
150             ((not any-valid-p)             ((not any-valid-p)
151              (push              (push
152               (create-label-gadget frame-view "noValidLocals"               (create-label frame-view "noValidLocals"
153                                    :font-list *italic-font*                                    :font-list *italic-font*
154                                    :label-string                                    :label-string
155                                    "   All variables have invalid values.")                                    "   All variables have invalid values.")
156               widgets))))               widgets))))
157    
158          (push (create-label-gadget frame-view "noVariableInfo"          (push (create-label frame-view "noVariableInfo"
159                                     :font-list *italic-font*                                     :font-list *italic-font*
160                                     :label-string                                     :label-string
161                                     "   No variable information available.")                                     "   No variable information available.")
# Line 164  Line 164 
164    
165  (defun debug-display-frame-prompt (frame frame-view)  (defun debug-display-frame-prompt (frame frame-view)
166    (let* ((form (create-form frame-view "promptForm"))    (let* ((form (create-form frame-view "promptForm"))
167           (label (create-label-gadget form "framePrompt"           (label (create-label form "framePrompt"
168                                       :label-string "Frame Eval:"                                       :label-string "Frame Eval:"
169                                       :font-list *header-font*))                                       :font-list *header-font*))
170           (entry (create-text form "frameEval"           (entry (create-text form "frameEval"
# Line 196  Line 196 
196           (frame-shell (create-interface-pane-shell title frame))           (frame-shell (create-interface-pane-shell title frame))
197           (frame-view (create-row-column frame-shell "debugFrameView"))           (frame-view (create-row-column frame-shell "debugFrameView"))
198           (menu-bar (create-menu-bar frame-view "frameMenu"))           (menu-bar (create-menu-bar frame-view "frameMenu"))
199           (fcall (create-label-gadget frame-view "frameCall"           (fcall (create-label frame-view "frameCall"
200                                       :label-string                                       :label-string
201                                       (format nil "Frame Call: ~a"                                       (format nil "Frame Call: ~a"
202                                               (grab-output-as-string                                               (grab-output-as-string
# Line 206  Line 206 
206                                   :callback 'frame-view-callback                                   :callback 'frame-view-callback
207                                   :client-data                                   :client-data
208                                   (di:debug-function-function debug-fun)))                                   (di:debug-function-function debug-fun)))
209           (slabel (create-label-gadget frame-view "sourceLabel"           (slabel (create-label frame-view "sourceLabel"
210                                        :font-list *header-font*                                        :font-list *header-font*
211                                        :label-string "Source form:"))                                        :label-string "Source form:"))
212           (swindow (create-scrolled-window frame-view "frameSourceWindow"           (swindow (create-scrolled-window frame-view "frameSourceWindow"
# Line 219  Line 219 
219                     (di:debug-condition (cond)                     (di:debug-condition (cond)
220                       (declare (ignore cond))                       (declare (ignore cond))
221                       "Source form not available.")))                       "Source form not available.")))
222           (srcview (create-label-gadget swindow "sourceForm"           (srcview (create-label swindow "sourceForm"
223                                         :alignment :alignment-beginning                                  :alignment :alignment-beginning
224                                         :user-data 0                                  :user-data 0
225                                         :label-string source))                                  :label-string source))
226           (cascade1           (cascade1
227            (create-interface-menu menu-bar "Frame"            (create-interface-menu menu-bar "Frame"
228             `(("Edit Source" edit-source-callback)             `(("Edit Source" edit-source-callback)
# Line 281  Line 281 
281                     menu-bar "Debug"                     menu-bar "Debug"
282                     `(("Close All Frames" close-all-callback)                     `(("Close All Frames" close-all-callback)
283                       ("Quit Debugger" quit-debugger-callback ,condition))))                       ("Quit Debugger" quit-debugger-callback ,condition))))
284           (errlabel (create-label-gadget form "errorLabel"           (errlabel (create-label form "errorLabel"
285                                          :top-attachment :attach-widget                                          :top-attachment :attach-widget
286                                          :top-widget menu-bar                                          :top-widget menu-bar
287                                          :left-attachment :attach-form                                          :left-attachment :attach-form
288                                          :font-list *header-font*                                          :font-list *header-font*
289                                          :label-string "Error Message:"))                                          :label-string "Error Message:"))
290           (errmsg (create-label-gadget form "errorMessage"           (errmsg (create-label form "errorMessage"
291                                        :top-attachment :attach-widget                                        :top-attachment :attach-widget
292                                        :top-widget errlabel                                        :top-widget errlabel
293                                        :left-attachment :attach-form                                        :left-attachment :attach-form
294                                        :right-attachment :attach-form))                                        :right-attachment :attach-form))
295           (rlabel (create-label-gadget form "restartLabel"           (rlabel (create-label form "restartLabel"
296                                        :top-attachment :attach-widget                                        :top-attachment :attach-widget
297                                        :top-widget errmsg                                        :top-widget errmsg
298                                        :left-attachment :attach-form                                        :left-attachment :attach-form
# Line 304  Line 304 
304                                        :left-attachment :attach-form                                        :left-attachment :attach-form
305                                        :right-attachment :attach-form                                        :right-attachment :attach-form
306                                        :left-offset 10))                                        :left-offset 10))
307           (btlabel (create-label-gadget form "backtraceLabel"           (btlabel (create-label form "backtraceLabel"
308                                         :label-string "Stack Backtrace:"                                         :label-string "Stack Backtrace:"
309                                         :font-list *header-font*                                         :font-list *header-font*
310                                         :top-attachment :attach-widget                                         :top-attachment :attach-widget
# Line 420  Line 420 
420          (progn          (progn
421            (write-line "Invoking debugger...")            (write-line "Invoking debugger...")
422            (invoke-motif-debugger condition)))))            (invoke-motif-debugger condition)))))
   
 #|  
 (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))  
          (*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))  
     (format *error-output* "~2&~A~2&" *debug-condition*)  
     (unless (typep condition 'step-condition)  
       (show-restarts *debug-restarts* *error-output*))  
     (internal-debug)))  
   
 |#  

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

  ViewVC Help
Powered by ViewVC 1.1.5