From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 11 Aug 1989 16:17:58 +0000 (+0000)
Subject: Cause `edwin-initialization' to be executed inside the command loop so
X-Git-Tag: 20090517-FFI~11840
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e54f2f236084cf75f941aa821ad7b1b70a8c21d6;p=mit-scheme.git

Cause `edwin-initialization' to be executed inside the command loop so
that all of the editor's dynamic-state is bound.
---

diff --git a/v7/src/edwin/comred.scm b/v7/src/edwin/comred.scm
index 79f138b11..e6c866c8b 100644
--- a/v7/src/edwin/comred.scm
+++ b/v7/src/edwin/comred.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.79 1989/08/11 10:51:02 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.80 1989/08/11 16:17:44 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -61,39 +61,31 @@
   (set! command-history (make-circular-list command-history-limit false))
   unspecific)
 
-(define (command-history-list)
-  (let loop ((history command-history))
-    (if (car history)
-	(let loop ((history (cdr history)) (result (list (car history))))
-	  (if (eq? history command-history)
-	      result
-	      (loop (cdr history) (cons (car history) result))))
-	(let ((history (cdr history)))
-	  (if (eq? history command-history)
-	      '()
-	      (loop history))))))
-
-(define (top-level-command-reader)
+(define (top-level-command-reader initialization)
   (let loop ()
     (with-keyboard-macro-disabled
      (lambda ()
        (intercept-^G-interrupts (lambda () unspecific)
-				command-reader)))
+	 (lambda ()
+	   (command-reader initialization)))))
     (loop)))
 
-(define (command-reader)
+(define (command-reader #!optional initialization)
   (define (command-reader-loop)
-    (let ((value
-	   (call-with-current-continuation
-	    (lambda (continuation)
-	      (fluid-let ((*command-continuation* continuation)
-			  (*command-char*)
-			  (*command*)
-			  (*next-message* false))
-		(start-next-command))))))
-      (if (not (eq? value 'ABORT)) (value)))
+    (let ((value (with-command-variables start-next-command)))
+      (if (not (eq? value 'ABORT))
+	  (value)))
     (command-reader-loop))
 
+  (define (with-command-variables start-next-command)
+    (call-with-current-continuation
+     (lambda (continuation)
+       (fluid-let ((*command-continuation* continuation)
+		   (*command-char*)
+		   (*command*)
+		   (*next-message* false))
+	 (start-next-command)))))
+
   (define (start-next-command)
     (reset-command-state!)
     (let ((char (with-editor-interrupts-disabled keyboard-read-char)))
@@ -110,7 +102,14 @@
 
   (fluid-let ((*command-message*)
 	      (*non-undo-count* 0))
-    (with-command-argument-reader command-reader-loop)))
+    (with-command-argument-reader
+     (lambda ()
+       (if (and (not (default-object? initialization)) initialization)
+	   (with-command-variables
+	    (lambda ()
+	      (reset-command-state!)
+	      (initialization))))
+       (command-reader-loop)))))
 
 (define (reset-command-state!)
   (reset-command-argument-reader!)
@@ -166,7 +165,20 @@
   (if (and *command-message*
 	   (eq? (car *command-message*) tag))
       (apply if-received (cdr *command-message*))
-      (if-not-received)))
+      (if-not-received)))
+
+(define (command-history-list)
+  (let loop ((history command-history))
+    (if (car history)
+	(let loop ((history (cdr history)) (result (list (car history))))
+	  (if (eq? history command-history)
+	      result
+	      (loop (cdr history) (cons (car history) result))))
+	(let ((history (cdr history)))
+	  (if (eq? history command-history)
+	      '()
+	      (loop history))))))
+
 (define (%dispatch-on-command window command record?)
   (set! *command* command)
   (guarantee-command-loaded command)
diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index d5e1452ab..7e8dc7787 100644
--- a/v7/src/edwin/editor.scm
+++ b/v7/src/edwin/editor.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.190 1989/08/11 11:50:27 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.191 1989/08/11 16:17:58 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -68,18 +68,15 @@
 			       (dynamic-wind
 				(lambda () (update-screens! true))
 				(lambda ()
-				  ;; Should this be in a dynamic wind? -- Jinx
-				  (if edwin-initialization
-				      (edwin-initialization))
 				  (let ((message (cmdl-message/null)))
 				    (push-cmdl (lambda (cmdl)
 						 cmdl ;ignore
-						 (top-level-command-reader)
+						 (top-level-command-reader
+						  edwin-initialization)
 						 message)
 					       false
 					       message)))
 				(lambda () unspecific)))))))))))))))))
-  ;; Should this be here or in a dynamic wind? -- Jinx
   (if edwin-finalization (edwin-finalization))
   unspecific)
 
@@ -88,7 +85,8 @@
 
 ;; Set this before entering the editor to get something done after the
 ;; editor's dynamic environment is initialized, but before the command
-;; loop is started.  [Should this bind the ^G interrupt also? -- CPH](define edwin-initialization false)
+;; loop is started.
+(define edwin-initialization false)
 
 ;; Set this while in the editor to get something done after leaving
 ;; the editor's dynamic environment; for example, this can be used to