From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 20 Aug 1993 00:14:28 +0000 (+0000)
Subject: Interaction between HANDLE-SIMPLE-EVENTS and KEYBOARD-READ-1 had a
X-Git-Tag: 20090517-FFI~8046
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=91e2009b003105fde8aaa50decc786bb3f64ed98;p=mit-scheme.git

Interaction between HANDLE-SIMPLE-EVENTS and KEYBOARD-READ-1 had a
window in which it was possible to process an event that caused a
redisplay to be needed, but subsequently avoid the redisplay test and
go directly into a blocking read.  This window has been eliminated.
---

diff --git a/v7/src/edwin/input.scm b/v7/src/edwin/input.scm
index 34a9eac03..b914f79e3 100644
--- a/v7/src/edwin/input.scm
+++ b/v7/src/edwin/input.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: input.scm,v 1.97 1993/08/19 00:18:39 cph Exp $
+;;;	$Id: input.scm,v 1.98 1993/08/20 00:14:28 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -178,13 +178,13 @@ B 3BAB8C
 (define (keyboard-peek)
   (if *executing-keyboard-macro?*
       (keyboard-macro-peek-key)
-      (keyboard-read-1 (editor-peek current-editor))))
+      (keyboard-read-1 (editor-peek current-editor) #t)))
 
 (define (keyboard-read)
   (set! keyboard-keys-read (+ keyboard-keys-read 1))
   (if *executing-keyboard-macro?*
       (keyboard-macro-read-key)
-      (let ((key (keyboard-read-1 (editor-read current-editor))))
+      (let ((key (keyboard-read-1 (editor-read current-editor) #f)))
 	(cond ((key? key)
 	       (set! auto-save-keystroke-count
 		     (fix:+ auto-save-keystroke-count 1))
@@ -205,9 +205,9 @@ B 3BAB8C
 	    (loop))))))
 
 (define (keyboard-peek-no-hang)
-  (handle-simple-events (editor-peek-no-hang current-editor)))
+  (handle-simple-events (editor-peek-no-hang current-editor) #t))
 
-(define (handle-simple-events thunk)
+(define (handle-simple-events thunk discard?)
   (let loop ()
     (let ((input (thunk)))
       (if (and (input-event? input)
@@ -220,53 +220,54 @@ B 3BAB8C
 				(car (input-event/operands input))))))))
 	  (begin
 	    (apply-input-event input)
-	    (let ((discard (editor-read current-editor)))
-	      (if (not (eq? discard thunk))
-		  (discard)))
+	    (if discard? ((editor-read current-editor)))
 	    (loop))
 	  input))))
 
 (define read-key-timeout/fast 500)
 (define read-key-timeout/slow 2000)
 
-(define (keyboard-read-1 reader)
+(define (keyboard-read-1 reader discard?)
   (remap-alias-key
-   (let ((peek-no-hang (editor-peek-no-hang current-editor)))
-     (if (not (peek-no-hang))
-	 (begin
-	   (if (let ((interval (ref-variable auto-save-interval))
-		     (count auto-save-keystroke-count))
-		 (and (fix:> count 20)
-		      (> interval 0)
-		      (> count interval)))
-	       (begin
-		 (do-auto-save)
-		 (set! auto-save-keystroke-count 0)))
-	   (update-screens! false)))
-     (let ((wait
-	    (lambda (timeout)
-	      (let ((t (+ (real-time-clock) timeout)))
-		(let loop ()
-		  (cond ((peek-no-hang) false)
-			((>= (real-time-clock) t) true)
-			(else (loop))))))))
-       ;; Perform the appropriate juggling of the minibuffer message.
-       (cond ((within-typein-edit?)
-	      (if message-string
+   (handle-simple-events
+    (lambda ()
+      (let ((peek-no-hang (editor-peek-no-hang current-editor)))
+	(if (not (peek-no-hang))
+	    (begin
+	      (if (let ((interval (ref-variable auto-save-interval))
+			(count auto-save-keystroke-count))
+		    (and (fix:> count 20)
+			 (> interval 0)
+			 (> count interval)))
 		  (begin
-		    (wait read-key-timeout/slow)
-		    (set! message-string false)
-		    (set! message-should-be-erased? false)
-		    (clear-current-message!))))
-	     ((and (or message-should-be-erased?
-		       (and command-prompt-string
-			    (not command-prompt-displayed?)))
-		   (wait read-key-timeout/fast))
-	      (set! message-string false)
-	      (set! message-should-be-erased? false)
-	      (if command-prompt-string
-		  (begin
-		    (set! command-prompt-displayed? true)
-		    (set-current-message! command-prompt-string))
-		  (clear-current-message!)))))
-     (handle-simple-events reader))))
\ No newline at end of file
+		    (do-auto-save)
+		    (set! auto-save-keystroke-count 0)))
+	      (update-screens! false)))
+	(let ((wait
+	       (lambda (timeout)
+		 (let ((t (+ (real-time-clock) timeout)))
+		   (let loop ()
+		     (cond ((peek-no-hang) false)
+			   ((>= (real-time-clock) t) true)
+			   (else (loop))))))))
+	  ;; Perform the appropriate juggling of the minibuffer message.
+	  (cond ((within-typein-edit?)
+		 (if message-string
+		     (begin
+		       (wait read-key-timeout/slow)
+		       (set! message-string false)
+		       (set! message-should-be-erased? false)
+		       (clear-current-message!))))
+		((and (or message-should-be-erased?
+			  (and command-prompt-string
+			       (not command-prompt-displayed?)))
+		      (wait read-key-timeout/fast))
+		 (set! message-string false)
+		 (set! message-should-be-erased? false)
+		 (if command-prompt-string
+		     (begin
+		       (set! command-prompt-displayed? true)
+		       (set-current-message! command-prompt-string))
+		     (clear-current-message!)))))
+	(reader)))
+    discard?)))
\ No newline at end of file