replaced the timeout in wait-event with a select on a pipe that wakes up

a wait-event call in the after-function.

scheme/xlib/display.scm

@@ -26,38 +26,22 @@
 
 (define-exported-binding "scx-display" :display)
 
-;(define (wakeup-display dpy)
-;  (placeholder-set! dpy #t))
+(define (wakeup-display dpy)
+  (write-char #\x (cdr (display:wakeup dpy))))
 
-;(define (sleep-display dpy)
-;  (let ((ph (make-placeholder)))
-;    (set-display:wakeup! dpy ph)
-;    (placeholder-value ph)))
+(define (display-wakeup-inport dpy)
+  (car (display:wakeup dpy)))
 
 (define (initialize-display dpy)
-;  (set-display:wakeup! dpy (make-placeholder))
-;  ;; spawn a thread that weaks up a waiting wait-event call if the
-;  ;; inport has data available
-;  (spawn (lambda ()
-;	   (let loop ()
-;	     (block-on-message-inport dpy)
-;	     (wakeup-display dpy)
-;	     (loop))))
-  ;; the after-function may also send a wakup
-  #t)
+  (call-with-values pipe
+		    (lambda (r w)
+		      (set-display:wakeup! dpy (cons r w)))))
 
 (define-exported-binding "scx-initialize-display" initialize-display)
 
 (define (display-message-inport display)
   (fdes->inport (display:connection-number display)))
 
-(define (block-on-message-inport dpy . maybe-timeout)
-  (let ((port (display-message-inport dpy)))
-    (call-with-values
-     (lambda () (apply select (vector port) (vector) (vector) maybe-timeout))
-     (lambda (ready-read ready-write ex)
-       (member port (vector->list ready-read))))))
-
 (define-enumerated-type byte-order :byte-order
   byte-order? byte-orders byte-order-name byte-order-index
   (lsb-first msb-first))
@@ -178,10 +162,10 @@
       ((display:after-function display) display)
       ;; else the default behaviour ;; TODO: check if this is the real one
       (display-flush display))
-  )
+  
   ;; if events are in the queue now, then wakeup a wait-event call
-  ;;(if (> (events-queued display (queued-mode already)) 0)
-  ;;    (wakeup-display display)))
+  (if (> (events-queued display (queued-mode already)) 0)
+      (wakeup-display display)))
 
 (define-exported-binding "scx-general-after-function" general-after-function)
 

scheme/xlib/event.scm

@@ -7,24 +7,29 @@
   (if (> (events-queued dpy (queued-mode after-flush)) 0)
       (next-event dpy)
       (begin
-	;;(sleep-display dpy)
-	(block-on-message-inport dpy 0.1)
+	(really-wait-event dpy)
 	(wait-event dpy))))
 
-;(define (block-on-message-inport 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!))))
-
-;;; Only here until scsh provides us with select
-;(import-lambda-definition add-pending-channel (channel)
-;  "scx_add_pending_channel")
+(define (really-wait-event dpy . maybe-timeout)
+  ;; selects on the port to the X-server and on the internal wakeup
+  ;; pipe. We get woke up, if a Xlib-call reads events and puts them
+  ;; in the Xlib-internal event queue in our back. See
+  ;; general-after-function.
+  (let* ((message-port (display-message-inport dpy))
+	 (wakeup-port (display-wakeup-inport dpy))
+	 (l (select-port-channels (if (null? maybe-timeout)
+				      #f
+				      (car maybe-timeout))
+				  message-port
+				  wakeup-port)))
+    ;; read all characters from the wakeup-port
+    (if (member wakeup-port l)
+	(let loop ()
+	  (if (char-ready? wakeup-port)
+	      (begin
+		(read-char wakeup-port)
+		(loop)))))
+    (member message-port l)))
 
 ;; How to find out if there are events available *********************