- fixed a bug with the default-screen

- fixed sync-event queue problem

scheme/examples/hello.scm

@@ -56,9 +56,11 @@
 		    (draw-text dpy win gc 20 40
 			       (make-text-items text (change-font font2)
 						(with-delta 20 text))))
+		   ((motion-event? e) #t)
 		   (else #f)))
 		(loop))))))
-      (call-with-event-channel dpy win (event-mask exposure button-press)
+      (call-with-event-channel dpy win (event-mask exposure button-press
+						   pointer-motion)
 			       handler)
       (close-display dpy))))
 

scheme/xlib/display.scm

@@ -120,16 +120,13 @@
 ;; *** convenience functions *****************************************
 
 (define (default-root-window display)
-  (screen:root-window (list-ref (display:screens display)
-				(display:default-screen display))))
+  (screen:root-window (display:default-screen display)))
 
 (define (black-pixel display)
-  (screen:black-pixel (list-ref (display:screens display)
-				(display:default-screen display))))
+  (screen:black-pixel (display:default-screen display)))
 
 (define (white-pixel display)
-  (screen:white-pixel (list-ref (display:screens display)
-				(display:default-screen display))))
+  (screen:white-pixel (display:default-screen display)))
 
 (import-lambda-definition next-request (display)
   "scx_Next_Request")

scheme/xlib/sync-event.scm

@@ -100,19 +100,22 @@
 (define (call-with-event-channel display window event-mask fun)
   (let ((r (make-request display window event-mask))
 	(channel (make-channel)))
-    (spawn-event-filter (most-recent-sync-x-event)
-			channel display window event-mask)
+    (spawn-event-filter channel display window event-mask)
+    ;; we send the first sync-event to the thread to really have the
+    ;; most recent one, without keeping it in an environment.
+    (send channel (most-recent-sync-x-event))
     (dynamic-wind
      (lambda () (add-request! r))
      (lambda () (fun channel))
      (lambda () (remove-request! r)))))
 
-(define (spawn-event-filter se out-channel display window event-mask)
+(define (spawn-event-filter out-channel display window event-mask)
   (let ((pred (lambda (e)
 		(and (eq? (any-event-display e) display)
 		     (matches-event-mask? window event-mask e)))))
     (spawn (lambda ()
-	     (let loop ((se se))
+	     ;; the first sync-event is send to us through the channel
+	     (let loop ((se (receive out-channel)))
 	       (let ((nse (next-sync-x-event se pred)))
 		 (send out-channel (sync-x-event-event nse))
 		 (loop nse)))))))

scheme/xlib/xlib-packages.scm

@@ -14,7 +14,8 @@
 
 (define-structures ((xlib xlib-interface)
 		    (xlib-internal xlib-internal-interface))
-  (open scsh-level-0
+  (open rendezvous-channels
+	scsh-level-0
 	scheme
 	list-lib
 	srfi-13 ;; strings
@@ -31,8 +32,7 @@
 	channel-i/o
 	interrupts
 	ascii
-	conditions
-	rendezvous-channels)
+	conditions)
   (files display
 	 visual
 	 colormap