0.6.12.49:

[sbcl.git] / src / code / debug.lisp

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index 3186f17..ba1c054 100644 (file)
--- 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)
@@ -1285,10 +1288,10 @@ argument")
 (defvar *cached-readtable* nil)
 (declaim (type (or readtable null) *cached-readtable*))
 
-(pushnew #'(lambda ()
-            (setq *cached-debug-source* nil *cached-source-stream* nil
-                  *cached-readtable* nil))
-        sb!int:*before-save-initializations*)
+(pushnew (lambda ()
+          (setq *cached-debug-source* nil *cached-source-stream* nil
+                *cached-readtable* nil))
+        *before-save-initializations*)
 
 ;;; We also cache the last top-level form that we printed a source for
 ;;; so that we don't have to do repeated reads and calls to