Wait on events by using the VM's select.

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);
 }
   

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
-;(define (wait-event dpy) ; needs ports, locks
+  (let ((port (display-message-inport dpy)))
-;  (let ((port (display-message-inport dpy)))
+    (disable-interrupts!)
-;    (display "obtaining port lock..." (current-error-port))
+    (if (not (char-ready? 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)))
-
-;; The old, ugly version that works...
-(define (wait-event dpy)
-  (if (event-ready? dpy)
-      (next-event dpy)
 	(begin 
-	(sleep 20) ; sleep for 20 ms
+	  (obtain-lock (port-lock port))
-	(wait-event dpy))))
+	  (add-pending-channel (port->channel port))
+	  (wait-for-channel (port->channel port)) ;; enables interrupts
+	  (release-lock (port-lock port)))
+	(enable-interrupts!))
+    (next-event dpy)))
+
+;;; Only here until scsh provides us with select
+(import-lambda-definition add-pending-channel (channel)
+  "scx_add_pending_channel")

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))