From fe121aade330f3faecb3ad9c7ee0566e7601ac7b Mon Sep 17 00:00:00 2001
From: garland <garland>
Date: Tue, 9 Mar 1993 13:11:19 +0000
Subject: [PATCH] The "Edit Source" button now works. A new button, "Dump
 Backtrace" has been added.  This is for dumping a copy of the stack backtrace
 for use in bug reports.  At the moment, it just prints a copy of the
 backtrace on the standard output stream.

---
 interface/debug.lisp | 105 +++++++++++++++++++++++++++++++++++++++----
 1 file changed, 96 insertions(+), 9 deletions(-)

diff --git a/interface/debug.lisp b/interface/debug.lisp
index 3bd05b40a..a977da74e 100644
--- a/interface/debug.lisp
+++ b/interface/debug.lisp
@@ -16,6 +16,11 @@
 (in-package "DEBUG")
 (use-package '("TOOLKIT" "INTERFACE"))
 
+;;; We need to record three things globally:
+;;;    - The structure decribing the current debugger display
+;;;    - The frame displays which are currently active (ie. visible)
+;;;    - The husks of old debugger displays for reuse
+;;;
 (defvar *current-debug-display* nil)
 (defvar *debug-active-frames* nil)
 (defvar *old-display-frames* nil)
@@ -42,7 +47,7 @@
 
 
 
-;;;; Callback functions
+;;;; Callback functions used by debugger
 
 (defun quit-debugger-callback (widget call-data)
   (declare (ignore widget call-data))
@@ -59,16 +64,21 @@
     ;; Should wrap this in a busy cursor
     (debug-display-frame frame)))
 
-(defun ping-callback (widget call-data test)
-  (declare (ignore widget call-data))
-  (destroy-widget (car (xt::widget-children test))))
-
 (defun close-all-callback (widget call-data)
   (declare (ignore widget call-data))
   (dolist (info *debug-active-frames*)
     (destroy-widget (cdr info)))
   (setf *debug-active-frames* nil))
 
+;;; This is to provide a means for recording the stack backtrace.  In
+;;; particular, this is important for sending bug reports.
+;;;
+(defun dump-backtrace-callback (widget call-data)
+  (declare (ignore widget call-data))
+  (let ((*current-frame* (di:top-frame)))
+    (format t "~%Stack Backtrace:~%")
+    (backtrace)))
+
 (defun frame-view-callback (widget call-data thing)
   (declare (ignore widget call-data))
   ;; Should wrap this in a busy cursor
@@ -81,9 +91,13 @@
 		:test #'(lambda (a b) (eql a (car b)))))
   (destroy-interface-pane frame))
 
-(defun edit-source-callback (widget call-data)
+(defun edit-source-callback (widget call-data frame)
   (declare (ignore widget call-data))
-  (funcall (debug-command-p :edit-source)))
+  (handler-case
+      (let ((*current-frame* frame))
+	(funcall (debug-command-p :edit-source)))
+    (error (cond)
+	   (interface-error (format nil "~A" cond)))))
 
 (defun frame-eval-callback (widget call-data frame output)
   (declare (ignore call-data))
@@ -128,6 +142,11 @@
 
 
 
+;;; DEBUG-DISPLAY-FRAME-LOCALS -- Internal
+;;;
+;;; This sets up the display of the available local variables for the given
+;;; stack frame.
+;;;
 (defun debug-display-frame-locals (frame debug-fun location frame-view)
   (let (widgets)
     (if (di:debug-variable-info-available debug-fun)
@@ -175,6 +194,11 @@
 	      widgets))
     (apply #'manage-children widgets)))
 
+;;; DEBUG-DISPLAY-FRAME-PROMPT -- Internal
+;;;
+;;; Every frame window has a Frame Eval area.  This function creates the
+;;; Eval area and attaches the necessary callbacks.
+;;;
 (defun debug-display-frame-prompt (frame frame-view)
   (let* ((form (create-form frame-view "promptForm"))
 	 (label (create-label form "framePrompt"
@@ -201,6 +225,15 @@
     (add-callback entry :activate-callback 'frame-eval-callback
 		  frame output)))
 
+;;; DEBUG-DISPLAY-FRAME -- Internal
+;;;
+;;; Function to generate the graphical display for the given frame.  Each
+;;; frame window is composed of the following parts:
+;;;    - The function called
+;;;    - The source form
+;;;    - Local variables
+;;;    - Frame Eval window
+;;;
 (defun debug-display-frame (frame)
   (let* ((debug-fun (di:frame-debug-function frame))
 	 (location (di:frame-code-location frame))
@@ -238,7 +271,7 @@
 				:label-string source))
 	 (cascade1
 	  (create-interface-menu menu-bar "Frame"
-	   `(("Edit Source" edit-source-callback)
+	   `(("Edit Source" edit-source-callback ,frame)
 	     ("Expand Source Form" source-verbosity-callback ,frame ,srcview 1)
 	     ("Shrink Source Form" source-verbosity-callback ,frame ,srcview -1)
 	     ("Close Frame" close-frame-callback ,frame))))
@@ -259,9 +292,19 @@
 
 ;;;; Functions to display the debugger control panel
 
+;;; DEBUG-DISPLAY-ERROR -- Internal
+;;;
+;;; Fills in the given widget with the error message for the given
+;;; condition.
+;;;
 (defun debug-display-error (errmsg condition)
   (set-values errmsg :label-string (format nil "~A" condition)))
 
+;;; DEBUG-DISPLAY-RESTARTS -- Internal
+;;;
+;;; Fills in a RowColumn box with buttons corresponding to the currently
+;;; active restarts.
+;;;
 (defun debug-display-restarts (restart-view)
   (let ((widgets (reverse (xti:widget-children restart-view)))
 	(used-ones))
@@ -283,6 +326,11 @@
     (when widgets
       (apply #'unmanage-children widgets))))
 
+;;; DEBUG-DISPLAY-STACK -- Internal
+;;;
+;;; Fills in a RowColumn box with buttons corresponding to the stack frames
+;;; found on the stack.
+;;;
 (defun debug-display-stack (backtrace)
   (let ((widgets (reverse (xti:widget-children backtrace)))
 	(used-ones)
@@ -309,6 +357,13 @@
     (when widgets
       (apply #'unmanage-children widgets))))
 
+;;; REALLY-CREATE-DEBUGGER -- Internal
+;;;
+;;; This creates all the widgets used by the main debugger window.  It
+;;; calls various sub-functions such as DEBUG-DISPLAY-STACK to fill in the
+;;; various display sections.  It should only be called if there are no old
+;;; debugger panes available for recycling.
+;;;
 (defun really-create-debugger (condition)
   (let* ((debug-pane (create-interface-pane-shell "Debugger" condition))
 	 (frame (create-frame debug-pane "debugFrame"))
@@ -319,6 +374,7 @@
 	 (cascade (create-cached-menu
 		   menu-bar "Debug"
 		   '(("Close All Frames" close-all-callback)
+		     ("Dump Backtrace" dump-backtrace-callback)
 		     ("Quit Debugger" quit-debugger-callback))))
  	 (errlabel (create-label form "errorLabel"
 					:top-attachment :attach-widget
@@ -391,6 +447,13 @@
     (popup-interface-pane debug-pane)
     debug-pane))
 
+;;; REUSE-DEBUGGER -- Internal
+;;;
+;;; Takes an old debugger pane and a new condition.  It renovates the old
+;;; display to reflect the current debugging state.  This should be used
+;;; whenever possible since it is quite a bit faster than creating a new
+;;; debugger pane from scratch.
+;;;
 (defun reuse-debugger (condition info)
   (let ((debug-pane (dd-info-debug-pane info))
 	(errmsg (dd-info-errmsg info))
@@ -414,11 +477,23 @@
     (popup-interface-pane debug-pane)
     debug-pane))
 
+;;; CREATE-DEBUGGER -- Internal
+;;;
+;;; Creates a graphical debugger display for the given condition.  It will
+;;; attempt to reuse any available old panes.  However, if none are
+;;; available, it will create a new display frame.
+;;;
 (defun create-debugger (condition)
   (if *old-display-frames*
       (reuse-debugger condition (pop *old-display-frames*))
       (really-create-debugger condition)))
 
+;;; CLOSE-MOTIF-DEBUGGER -- Internal
+;;;
+;;; This function should always be called before leaving the context of the
+;;; debugger.  It closes down the frame windows and marks the main debug
+;;; display pane as ready for recycling.
+;;;
 (defun close-motif-debugger (condition)
   (declare (ignore condition))
   (push *current-debug-display* *old-display-frames*)
@@ -434,8 +509,14 @@
 
   (format t "Leaving debugger.~%"))
 
+;;; INVOKE-MOTIF-DEBUGGER -- Internal
+;;;
+;;; This function essentially mimics the functions which manage the TTY
+;;; debugger, but uses a graphical debugging display instead.
+;;;
 (defun invoke-motif-debugger (condition)
-  (let* ((frame (di:top-frame))
+  (let* ((*in-the-debugger* t)
+	 (frame (di:top-frame))
 	 (previous-display *current-debug-display*)
 	 (*current-debug-display* nil)
 	 (*debug-active-frames* nil))
@@ -468,6 +549,12 @@
 
 
 
+;;; INVOKE-DEBUGGER -- Public
+;;;
+;;; 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*
-- 
GitLab