From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 3 Apr 1997 04:44:32 +0000 (+0000)
Subject: Change event-reading loop to block when waiting for an event while
X-Git-Tag: 20090517-FFI~5219
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=da45c64dc00a7c2437368ef662086ce734655c50;p=mit-scheme.git

Change event-reading loop to block when waiting for an event while
none of the Edwin windows is active.  This is safe because we won't
get any events until one of them becomes active, and at that time the
activation messages will cause a return from the block.
---

diff --git a/v7/src/edwin/win32.scm b/v7/src/edwin/win32.scm
index 60ee16e24..a93034eb8 100644
--- a/v7/src/edwin/win32.scm
+++ b/v7/src/edwin/win32.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: win32.scm,v 1.7 1997/01/02 04:39:45 cph Exp $
+;;;	$Id: win32.scm,v 1.8 1997/04/03 04:44:32 cph Exp $
 ;;;
 ;;;	Copyright (c) 1994-97 Massachusetts Institute of Technology
 ;;;
@@ -532,13 +532,15 @@
 		 (set-interrupt-enables! mask)
 		 event:process-status)
 		(else
-		 (let ((handle* (win32-screen-current-focus)))
+		 (let ((handle* (win32-screen-current-focus))
+		       (wait
+			(lambda ()
+			  (test-for-input-on-descriptor
+			   ;; console-channel-descriptor here
+			   ;; means "input from message queue".
+			   console-channel-descriptor block?))))
 		   (if (eqv? handle handle*)
-		       (let ((flag
-			      (test-for-input-on-descriptor
-			       ;; console-channel-descriptor here
-			       ;; means "input from message queue".
-			       console-channel-descriptor block?)))
+		       (let ((flag (wait)))
 			 (set-interrupt-enables! mask)
 			 (case flag
 			   ((#F) #f)
@@ -554,7 +556,9 @@
 						 select-screen
 						 screen*))
 			     (and block?
-				  (read-event-1 handle block?))))))))))))
+				  (begin
+				    (wait)
+				    (read-event-1 handle block?)))))))))))))
 
 (define (read-event-2 handle)
   (and handle