Change RETURN-TO-COMMAND-LOOP to accept a condition as its sole

argument.  The restart that it invokes is extracted from the
condition, not from the current restarts, and if it is an
ABORT-CURRENT-COMMAND condition, its input is processed.

diff --git a/v7/src/edwin/artdebug.scm b/v7/src/edwin/artdebug.scm
index 78e827218c44d7421953f30946cadf5bcdbbd02b..a5362b05973277092f87f12aa5bad945837ea4f3 100644 (file)
--- a/v7/src/edwin/artdebug.scm
+++ b/v7/src/edwin/artdebug.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: artdebug.scm,v 1.23 1993/10/16 07:41:27 cph Exp $
+;;;    $Id: artdebug.scm,v 1.24 1993/10/26 00:37:55 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -206,7 +206,7 @@ or #F meaning no limit."
                     select-buffer)
                 (continuation-browser-buffer condition)))
              (message error-type-name " error")))
-       (return-to-command-loop #f))))
+       (return-to-command-loop condition))))
 
 (define-command browse-continuation
   "Invoke the continuation-browser on CONTINUATION."

diff --git a/v7/src/edwin/comred.scm b/v7/src/edwin/comred.scm
index 2dc662c1416ab41524d6a11d56d27c6aae803987..2020b21eb4e2fcd0afc5fb6d4a43af6277954313 100644 (file)
--- a/v7/src/edwin/comred.scm
+++ b/v7/src/edwin/comred.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: comred.scm,v 1.107 1993/09/23 07:09:12 cph Exp $
+;;;    $Id: comred.scm,v 1.108 1993/10/26 00:37:56 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -69,7 +69,7 @@
   (with-keyboard-macro-disabled
    (lambda ()
      (bind-condition-handler (list condition-type:abort-current-command)
-        handle-abort-condition
+        return-to-command-loop
        (lambda ()
         (command-reader init))))))
 
@@ -88,7 +88,7 @@
        (bind-condition-handler (list condition-type:abort-current-command)
            (lambda (condition)
              (if (not (condition/^G? condition))
-                 (handle-abort-condition condition)))
+                 (return-to-command-loop condition)))
          (lambda ()
            (if (and (not (default-object? initialization)) initialization)
                (bind-abort-editor-command
@@ -139,14 +139,13 @@
                     (apply-input-event input))))))
        (lambda (restart) restart (thunk))))))
 
-(define (handle-abort-condition condition)
-  (return-to-command-loop (abort-current-command/input condition)))
-
-(define (return-to-command-loop input)
-  (let ((restart (find-restart 'ABORT-EDITOR-COMMAND)))
+(define (return-to-command-loop condition)
+  (let ((restart (find-restart 'ABORT-EDITOR-COMMAND condition)))
     (if (not restart) (error "Missing ABORT-EDITOR-COMMAND restart."))
     (keyboard-macro-disable)
-    (invoke-restart restart input)))
+    (invoke-restart restart
+                   (and (condition/abort-current-command? condition)
+                        (abort-current-command/input condition)))))
 
 (define (get-next-keyboard-char)
   (if *executing-keyboard-macro?*

diff --git a/v7/src/edwin/debug.scm b/v7/src/edwin/debug.scm
index 7f481709d75df3a1795de8f7581f66a0607f7329..bf5c61664a57488501fb1637a78375c10ed848ba 100644 (file)
--- a/v7/src/edwin/debug.scm
+++ b/v7/src/edwin/debug.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: debug.scm,v 1.22 1993/10/26 00:31:19 cph Exp $
+;;;    $Id: debug.scm,v 1.23 1993/10/26 00:37:57 cph Exp $
 ;;;
 ;;;    Copyright (c) 1992-93 Massachusetts Institute of Technology
 ;;;
@@ -1194,7 +1194,7 @@ The buffer below describes the current subproblem or reduction.
              (fluid-let ((starting-debugger? true))
                (select-continuation-browser-buffer condition))
              (message error-type-name " error")))
-       (return-to-command-loop #f))))
+       (return-to-command-loop condition))))
 
 (define starting-debugger? false)
 \f

diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index ef26d43507d82cf035cf9633b8934cd327b1cd8c..b35a15f99409505582e59594d1647e08d2056e8d 100644 (file)
--- a/v7/src/edwin/editor.scm
+++ b/v7/src/edwin/editor.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: editor.scm,v 1.231 1993/10/25 19:57:19 cph Exp $
+;;;    $Id: editor.scm,v 1.232 1993/10/26 00:37:58 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-1993 Massachusetts Institute of Technology
 ;;;
@@ -295,7 +295,7 @@ with the contents of the startup message."
        (else
         (editor-beep)
         (message (condition/report-string condition))
-        (return-to-command-loop #f))))
+        (return-to-command-loop condition))))
 
 (define-variable debug-on-internal-error
   "True means enter debugger if error is signalled while the editor is running.
@@ -330,7 +330,7 @@ This does not affect editor errors or evaluation errors."
        (let ((strings (editor-error-strings condition)))
          (if (not (null? strings))
              (apply message strings)))
-       (return-to-command-loop #f))))
+       (return-to-command-loop condition))))
 
 (define-variable debug-on-editor-error
   "True means signal Scheme error when an editor error occurs."

diff --git a/v7/src/edwin/evlcom.scm b/v7/src/edwin/evlcom.scm
index e797388282aafe7b22d8a56c0cebbfd76c1a00f2..c712422e5513108b337244445ccce0b80d142e84 100644 (file)
--- a/v7/src/edwin/evlcom.scm
+++ b/v7/src/edwin/evlcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: evlcom.scm,v 1.46 1993/10/21 04:59:00 cph Exp $
+;;;    $Id: evlcom.scm,v 1.47 1993/10/26 00:37:59 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -474,7 +474,7 @@ Set by Scheme evaluation code to update the mode line."
       (debug-scheme-error condition "evaluation")
       (begin
        (editor-beep)
-       (return-to-command-loop #f))))
+       (return-to-command-loop condition))))
 
 (define (default-report-error condition error-type-name)
   (let ((report-string (condition/report-string condition)))