From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 26 Oct 1993 00:37:59 +0000 (+0000)
Subject: Change RETURN-TO-COMMAND-LOOP to accept a condition as its sole
X-Git-Tag: 20090517-FFI~7704
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f7d2abf33f5b3bacaab0078dae6cf51713b8e077;p=mit-scheme.git
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 78e827218..a5362b059 100644
--- 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 2dc662c14..2020b21eb 100644
--- 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 7f481709d..bf5c61664 100644
--- 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)
diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index ef26d4350..b35a15f99 100644
--- 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 e79738828..c712422e5 100644
--- 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)))