Implement control variable REPL:ALLOW-RESTART-NOTIFICATIONS?. Change

debugger to present restart notifications with same numbering as does
the REP loop.

diff --git a/v7/src/runtime/debug.scm b/v7/src/runtime/debug.scm
index c74bafbed608f0ba2168bff11e57f21e9944e496..86b8870c49783129a8f5bee66fc843c856f5fe9e 100644 (file)
--- a/v7/src/runtime/debug.scm
+++ b/v7/src/runtime/debug.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/debug.scm,v 14.25 1991/05/15 18:13:49 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/debug.scm,v 14.26 1991/05/15 21:18:07 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -470,21 +470,35 @@ MIT in each case. |#
                         (length subproblems)
                         " inclusive).")
                        (top-level-loop))))))))))
-
+\f
 (define (prompt-for-nonnegative-integer prompt limit)
+  (prompt-for-integer prompt 0 limit))
+
+(define (prompt-for-integer prompt lower upper)
   (let loop ()
     (let ((expression
           (prompt-for-expression
-           (string-append prompt
-                          (if limit
-                              (string-append " (0 through "
-                                             (number->string (-1+ limit))
-                                             " inclusive)")
-                              "")))))
-      (cond ((not (exact-nonnegative-integer? expression))
-            (debugger-failure prompt " must be nonnegative integer.")
+           (string-append
+            prompt
+            (if lower
+                (if upper
+                    (string-append " (" (number->string lower)
+                                   " through "
+                                   (number->string (- upper 1))
+                                   " inclusive)")
+                    (string-append " (minimum " (number->string lower) ")"))
+                (if upper
+                    (string-append " (maximum "
+                                   (number->string (- upper 1))
+                                   ")")
+                    ""))))))
+      (cond ((not (exact-integer? expression))
+            (debugger-failure prompt " must be exact integer.")
             (loop))
-           ((and limit (>= expression limit))
+           ((and lower (< expression lower))
+            (debugger-failure prompt " too small.")
+            (loop))
+           ((and upper (>= expression upper))
             (debugger-failure prompt " too large.")
             (loop))
            (else
@@ -641,35 +655,30 @@ MIT in each case. |#
     (if (null? restarts)
        (debugger-failure "No options to choose from.")
        (let ((n-restarts (length restarts))
-             (invoke-option
-              (lambda (n)
-                (invoke-restart-interactively (list-ref restarts n)))))
-         (presentation
-          (lambda ()
-            (let ((port (current-output-port)))
-              (if (= n-restarts 1)
-                  (begin
-                    (write-string "There is only one option:" port)
-                    (newline port)
-                    (write-restarts restarts port)
-                    (if (prompt-for-confirmation "Use this option")
-                        (invoke-option 0)))
-                  (begin
-                    (write-string "Choose an option by number:" port)
-                    (newline port)
-                    (write-restarts restarts port)
-                    (invoke-option
-                     (prompt-for-nonnegative-integer "Option number"
-                                                     n-restarts)))))))))))
-
-(define (write-restarts restarts port)
-  (do ((restarts restarts (cdr restarts))
-       (index 0 (1+ index)))
-      ((null? restarts))
-    (write-string (string-pad-left (number->string index) 3) port)
-    (write-string ": " port)
-    (write-restart-report (car restarts) port)
-    (newline port)))
+             (write-index
+              (lambda (index port)
+                (write-string (string-pad-left (number->string index) 3) port)
+                (write-string ":" port))))
+         (let ((invoke-option
+                (lambda (n)
+                  (invoke-restart-interactively
+                   (list-ref restarts (- n-restarts n))))))
+           (presentation
+            (lambda ()
+              (let ((port (current-output-port)))
+                (if (= n-restarts 1)
+                    (begin
+                      (write-string "There is only one option:" port)
+                      (write-restarts restarts port write-index)
+                      (if (prompt-for-confirmation "Use this option")
+                          (invoke-option 1)))
+                    (begin
+                      (write-string "Choose an option by number:" port)
+                      (write-restarts restarts port write-index)
+                      (invoke-option
+                       (prompt-for-integer "Option number"
+                                           1
+                                           (+ n-restarts 1)))))))))))))
 \f
 ;;;; Advanced hacking commands
 

diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm
index 4420430efd0e9f94160ce2373d48266946a7842a..f94e82ab89b2003ddc098db0053869f46c4fb816 100644 (file)
--- a/v7/src/runtime/rep.scm
+++ b/v7/src/runtime/rep.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rep.scm,v 14.19 1991/03/14 04:27:13 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rep.scm,v 14.20 1991/05/15 21:17:51 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -37,6 +37,9 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 \f
+(define repl:allow-restart-notifications?
+  true)
+
 (define (initialize-package!)
   (set! *nearest-cmdl* false)
   (set! with-cmdl/input-port
@@ -294,13 +297,15 @@ MIT in each case. |#
                       message))
                (if condition
                    (cmdl-message/append
-                    (if hook/error-decision
+                    (if (and hook/error-decision (condition/error? condition))
                         (cmdl-message/active
                          (lambda (cmdl)
                            cmdl
                            (hook/error-decision)))
                         (cmdl-message/null))
-                    (condition-restarts-message condition))
+                    (if repl:allow-restart-notifications?
+                        (condition-restarts-message condition)
+                        (cmdl-message/null)))
                    (cmdl-message/null))
                (if (eq? 'INHERIT environment)
                    (cmdl-message/null)
@@ -334,7 +339,7 @@ MIT in each case. |#
 ;To continue, call RESTART with an option number:" port)
        (write-restarts (filter-restarts (condition/restarts condition)) port
         (lambda (index port)
-          (write-string " (RESTART " port)
+          (write-string "; (RESTART " port)
           (write index port)
           (write-string ") =>" port)))))))
 
@@ -358,6 +363,7 @@ MIT in each case. |#
                 (write-string ";Choose an option by number:" port)
                 (write-restarts restarts port
                   (lambda (index port)
+                    (write-string ";" port)
                     (write-string (string-pad-left (number->string index) 3)
                                   port)
                     (write-string ":" port)))
@@ -387,7 +393,6 @@ MIT in each case. |#
   (do ((restarts restarts (cdr restarts))
        (index (length restarts) (- index 1)))
       ((null? restarts))
-    (write-string ";" port)
     (write-index index port)
     (write-string " " port)
     (write-restart-report (car restarts) port)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 8f1b8d1e09ccb1a96b6ab8a544d158bb4b045d2f..44b293e0622d638d26a18306906cc6396fc2c870 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.106 1991/05/15 18:14:02 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.107 1991/05/15 21:18:22 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -1706,6 +1706,7 @@ MIT in each case. |#
          repl/prompt
          repl/reader-history
          repl/syntax-table
+         repl:allow-restart-notifications?
          repl?
          restart
          set-cmdl/input-port!
@@ -1735,6 +1736,8 @@ MIT in each case. |#
          repl-write/show-hash?)
   (export (runtime debugger-command-loop)
          hook/repl-environment)
+  (export (runtime debugger)
+         write-restarts)
   (initialization (initialize-package!)))
 
 (define-package (runtime save/restore)

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 9898c9a198d4aa6ac01b468468c0c4137127df57..d46d374026fedaa51479d8f3c3c101153d1c7f47 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.106 1991/05/15 18:14:02 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.107 1991/05/15 21:18:22 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -1706,6 +1706,7 @@ MIT in each case. |#
          repl/prompt
          repl/reader-history
          repl/syntax-table
+         repl:allow-restart-notifications?
          repl?
          restart
          set-cmdl/input-port!
@@ -1735,6 +1736,8 @@ MIT in each case. |#
          repl-write/show-hash?)
   (export (runtime debugger-command-loop)
          hook/repl-environment)
+  (export (runtime debugger)
+         write-restarts)
   (initialization (initialize-package!)))
 
 (define-package (runtime save/restore)