From 10dd1e0a697b0a1743067b69ebf57e9d5f637506 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 25 Feb 1992 22:41:00 +0000
Subject: [PATCH] Don't attempt to update screens unless there is no immediate
 input. Doing so is wasted effort since the update will abort almost
 immediately.  Also don't update screens for PEEK-NO-HANG; let the caller take
 care of updating if that is desirable.

---
 v7/src/edwin/xterm.scm | 56 +++++++++++++++++++++++++++---------------
 1 file changed, 36 insertions(+), 20 deletions(-)

diff --git a/v7/src/edwin/xterm.scm b/v7/src/edwin/xterm.scm
index 74f83c6d1..18681564f 100644
--- a/v7/src/edwin/xterm.scm
+++ b/v7/src/edwin/xterm.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xterm.scm,v 1.30 1992/02/18 14:12:29 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xterm.scm,v 1.31 1992/02/25 22:41:00 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -306,44 +306,60 @@
 			  (begin
 			    (set! start 1)
 			    (string-ref string 0)))))))))
-      (let ((read-until-result
-	     (lambda (time-limit)
+      (let ((guarantee-result
+	     (lambda ()
 	       (let loop ()
-		 (update-screens! false)
-		 (let ((event (get-next-event time-limit)))
+		 (let ((event
+			(or (get-next-event 0)
+			    (begin
+			      (update-screens! false)
+			      (get-next-event false)))))
 		   (cond ((not event)
-			  (if (not time-limit)
-			      (error "#F returned from blocking read"))
-			  false)
+			  (error "#F returned from blocking read"))
 			 ((not (vector? event))
 			  (process-change-event event)
 			  (loop))
-			 ((fix:= event-type:key-press (vector-ref event 0))
-			  (or (process-key-press-event event) (loop)))
 			 (else
-			  (or (process-special-event event) (loop)))))))))
+			  (or (if (fix:= event-type:key-press
+					 (vector-ref event 0))
+				  (process-key-press-event event)
+				  (process-special-event event))
+			      (loop)))))))))
 	(values
 	 (lambda ()			;halt-update?
 	   (or pending-result
-	       (fix:< start end)
 	       pending-event
+	       (fix:< start end)
 	       (let ((event (read-event queue display 0)))
 		 (if event (set! pending-event event))
 		 event)))
 	 (lambda ()			;peek-no-hang
 	   (or pending-result
 	       (fix:< start end)
-	       (let ((result (read-until-result 0)))
-		 (if result
-		     (set! pending-result result))
-		 result)))
+	       (let loop ()
+		 (let ((event (get-next-event 0)))
+		   (cond ((not event)
+			  false)
+			 ((not (vector? event))
+			  (process-change-event event)
+			  (loop))
+			 (else
+			  (let ((result
+				 (if (fix:= event-type:key-press
+					    (vector-ref event 0))
+				     (process-key-press-event event)
+				     (process-special-event event))))
+			    (if result
+				(begin
+				  (set! pending-result result)
+				  result)
+				(loop)))))))))
 	 (lambda ()			;peek
 	   (or pending-result
 	       (if (fix:< start end)
 		   (string-ref string start)
-		   (let ((result (read-until-result false)))
-		     (if result
-			 (set! pending-result result))
+		   (let ((result (guarantee-result)))
+		     (set! pending-result result)
 		     result))))
 	 (lambda ()			;read
 	   (cond (pending-result
@@ -355,7 +371,7 @@
 		    (set! start (fix:+ start 1))
 		    char))
 		 (else
-		  (read-until-result false)))))))))
+		  (guarantee-result)))))))))
 
 (define (read-event queue display time-limit)
   (dynamic-wind
-- 
2.25.1