X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug.lisp;h=25b55c59b6ad6b02e441cca82fff6ee2d47f2835;hb=4cf50b1896b25f5337e7c258b0b560da00d47993;hp=ad90045d2cd73bea7bc27a4a14aff823cbae1c3d;hpb=a8fa26a6e9804d3548f5bca9361a91345a689099;p=sbcl.git

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index ad90045..25b55c5 100644
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -37,15 +37,22 @@
 ;;; nestedness inside debugger command loops
 (defvar *debug-command-level* 0)
 
-(defvar *stack-top-hint* nil
-  #!+sb-doc
-  "If this is bound before the debugger is invoked, it is used as the stack
-   top by the debugger.")
+;;; If this is bound before the debugger is invoked, it is used as the
+;;; stack top by the debugger.
+(defvar *stack-top-hint* nil)
+
 (defvar *stack-top* nil)
 (defvar *real-stack-top* nil)
 
 (defvar *current-frame* nil)
 
+;;; Beginner-oriented help messages are important because you end up
+;;; in the debugger whenever something bad happens, or if you try to
+;;; get out of the system with Ctrl-C or (EXIT) or EXIT or whatever.
+;;; But after memorizing them the wasted screen space gets annoying..
+(defvar *debug-beginner-help-p* t
+  "Should the debugger display beginner-oriented help messages?")
+
 (defun debug-prompt (stream)
 
   ;; old behavior, will probably go away in sbcl-0.7.x
@@ -253,7 +260,7 @@ Function and macro commands:
 	 :type (or sb!di:code-location sb!di:debug-function))
   ;; the breakpoint returned by sb!di:make-breakpoint
   (breakpoint (required-argument) :type sb!di:breakpoint)
-  ;; the function returned from sb!di:preprocess-for-eval. If result is
+  ;; the function returned from SB!DI:PREPROCESS-FOR-EVAL. If result is
   ;; non-NIL, drop into the debugger.
   (break #'identity :type function)
   ;; the function returned from sb!di:preprocess-for-eval. If result is
@@ -582,18 +589,6 @@ Function and macro commands:
 (defvar *debug-restarts*)
 (defvar *debug-condition*)
 
-;;; Print *DEBUG-CONDITION*, taking care to avoid recursive invocation
-;;; of the debugger in case of a problem (e.g. a bug in the PRINT-OBJECT
-;;; method for *DEBUG-CONDITION*).
-(defun princ-debug-condition-carefully (stream)
-  (handler-case (princ *debug-condition* stream)
-    (error (condition)
-	   (format stream
-  		   "  (caught ~S when trying to print ~S)"
-		   (type-of condition)
-		   '*debug-condition*)))
-  *debug-condition*)
-
 (defun invoke-debugger (condition)
   #!+sb-doc
   "Enter the debugger."
@@ -645,16 +640,22 @@ reset to ~S."
        ;; the last line of output or so, and get confused.
        (flush-standard-output-streams)
 
-       ;; The initial output here goes to *ERROR-OUTPUT*, because the
+       ;; (The initial output here goes to *ERROR-OUTPUT*, because the
        ;; initial output is not interactive, just an error message,
        ;; and when people redirect *ERROR-OUTPUT*, they could
        ;; reasonably expect to see error messages logged there,
-       ;; regardless of what the debugger does afterwards.
-       (format *error-output*
-	       "~2&debugger invoked on condition of type ~S:~%  "
-	       (type-of *debug-condition*))
-       (princ-debug-condition-carefully *error-output*)
-       (terpri *error-output*)
+       ;; regardless of what the debugger does afterwards.)
+       (handler-case
+	   (format *error-output*
+		   "~2&~@<debugger invoked on condition of type ~S: ~
+                    ~2I~_~A~:>~%"
+		   (type-of *debug-condition*)
+		   *debug-condition*)
+	 (error (condition)
+	   (format *error-output*
+  		   "~&(caught ~S trying to print ~S when entering debugger)~%"
+		   (type-of condition)
+		   '*debug-condition*)))
 
        ;; After the initial error/condition/whatever announcement to
        ;; *ERROR-OUTPUT*, we become interactive, and should talk on
@@ -679,15 +680,17 @@ reset to ~S."
 	     ;; that file, and right to send them to *DEBUG-IO*.
 	     (*error-output* *debug-io*))
 	 (unless (typep condition 'step-condition)
-	   (format *debug-io*
-		   "~%~@<Within the debugger, you can type HELP for help. At ~
-                   any command prompt (within the debugger or not) you can ~
-                   type (SB-EXT:QUIT) to terminate the SBCL executable. ~
-                   The condition which caused the debugger to be entered ~
-                   is bound to ~S.~:@>~2%"
-		   '*debug-condition*)
-	   (show-restarts *debug-restarts* *debug-io*)
-	   (terpri *debug-io*))
+	   (when *debug-beginner-help-p*
+	     (format *debug-io*
+		     "~%~@<Within the debugger, you can type HELP for help. ~
+                      At any command prompt (within the debugger or not) you ~
+                      can type (SB-EXT:QUIT) to terminate the SBCL ~
+                      executable. The condition which caused the debugger to ~
+                      be entered is bound to ~S. You can suppress this ~
+                      message by clearing ~S.~:@>~2%"
+		     '*debug-condition*
+		     '*debug-beginner-help-p*))
+	   (show-restarts *debug-restarts* *debug-io*))
 	 (internal-debug))))))
 
 (defun show-restarts (restarts s)
@@ -1164,8 +1167,10 @@ argument")
 ;;;(!def-debug-command "QUIT" ()
 ;;;  (throw 'sb!impl::top-level-catcher nil))
 
-;;; CMU CL supported this GO debug command, but SBCL doesn't -- just
-;;; type the CONTINUE restart name.
+;;; CMU CL supported this GO debug command, but SBCL doesn't -- in
+;;; SBCL you just type the CONTINUE restart name instead (or "RESTART
+;;; CONTINUE", that's OK too).
+
 ;;;(!def-debug-command "GO" ()
 ;;;  (continue *debug-condition*)
 ;;;  (error "There is no restart named CONTINUE."))
@@ -1205,7 +1210,7 @@ argument")
   ;; desperate holdout is running this on a dumb terminal somewhere,
   ;; we tell him where to find the message stored as a string.
   (format *debug-io*
-	  "~&~a~2%(The HELP string is stored in ~S.)~%"
+	  "~&~A~2%(The HELP string is stored in ~S.)~%"
 	  *debug-help-string*
 	  '*debug-help-string*))