From ac61d5fcef5338824df41187d58ea510d089d0ee Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Tue, 4 Dec 2001 14:18:57 +0000
Subject: [PATCH] Wait on events by using the VM's select.

---
 c/xlib/event.c                | 11 +++++++++++
 scheme/xlib/event.scm         | 34 ++++++++++++++--------------------
 scheme/xlib/xlib-packages.scm |  5 +++--
 3 files changed, 28 insertions(+), 22 deletions(-)

diff --git a/c/xlib/event.c b/c/xlib/event.c
index a22868e..a591950 100644
--- a/c/xlib/event.c
+++ b/c/xlib/event.c
@@ -349,10 +349,21 @@ s48_value scx_Get_Motion_Events(s48_value Xdisplay, s48_value Xwindow,
   return v;
 }
 
+s48_value scx_add_pending_channel (channel){
+  int socket_fd;
+  S48_CHECK_CHANNEL(channel);
+  socket_fd = S48_UNSAFE_EXTRACT_FIXNUM(S48_UNSAFE_CHANNEL_OS_INDEX(channel));
+
+  if (! s48_add_pending_fd(socket_fd, 1)) // 1 for: yes, is input 
+    s48_raise_out_of_memory_error();
+
+  return S48_UNSPECIFIC;
+}
 void scx_init_event(void) {
   S48_EXPORT_FUNCTION(scx_Next_Event);
   S48_EXPORT_FUNCTION(scx_Peek_Event);
   S48_EXPORT_FUNCTION(scx_Events_Pending);
   S48_EXPORT_FUNCTION(scx_Get_Motion_Events);
+  S48_EXPORT_FUNCTION(scx_add_pending_channel);
 }
   
diff --git a/scheme/xlib/event.scm b/scheme/xlib/event.scm
index 859ab66..30975b7 100644
--- a/scheme/xlib/event.scm
+++ b/scheme/xlib/event.scm
@@ -147,24 +147,18 @@
 ;; wait-event blocks the current thread until an event is available,
 ;; and then it returns this new event.
 
-;; This does not work yet! We are working on it.
-;(define (wait-event dpy) ; needs ports, locks
-;  (let ((port (display-message-inport dpy)))
-;    (display "obtaining port lock..." (current-error-port))
-;    (obtain-lock (port-lock port))
-;    (display " ...got it\n" (current-error-port))
-;
-;    (display "waiting for events..." (current-error-port))
-;    (wait-for-channel (port->channel port))
-;    (display " ...receiving events.\n" (current-error-port))
-;
-;    (release-lock (port-lock port))
-;    (next-event dpy)))
+(define (wait-event dpy) ; needs ports, locks
+  (let ((port (display-message-inport dpy)))
+    (disable-interrupts!)
+    (if (not (char-ready? port))
+	(begin 
+	  (obtain-lock (port-lock port))
+	  (add-pending-channel (port->channel port))
+	  (wait-for-channel (port->channel port)) ;; enables interrupts
+	  (release-lock (port-lock port)))
+	(enable-interrupts!))
+    (next-event dpy)))
 
-;; The old, ugly version that works...
-(define (wait-event dpy)
-  (if (event-ready? dpy)
-      (next-event dpy)
-      (begin
-	(sleep 20) ; sleep for 20 ms
-	(wait-event dpy))))
+;;; Only here until scsh provides us with select
+(import-lambda-definition add-pending-channel (channel)
+  "scx_add_pending_channel")
diff --git a/scheme/xlib/xlib-packages.scm b/scheme/xlib/xlib-packages.scm
index b60d90a..05d1d09 100644
--- a/scheme/xlib/xlib-packages.scm
+++ b/scheme/xlib/xlib-packages.scm
@@ -72,12 +72,13 @@
   (files graphics))
 
 (define-structure xlib-event xlib-event-interface
-  (open scheme
+  (open scsh-level-0 ;; for port->channel
+	scheme
 	external-calls
 	threads  ;; for sleep
 	ports locks  ;; for locking the port
 	channel-i/o ;; for wait-for-channel
-	scsh-level-0 ;; for port->channel
+	interrupts
 	xlib-types)
   (files event))