From 968e69403f5c11b1e5d9a27ac89b0d1a0fe7f242 Mon Sep 17 00:00:00 2001
From: frese <frese>
Date: Thu, 13 Mar 2003 15:17:36 +0000
Subject: [PATCH] - fixed a bug with the default-screen - fixed sync-event
 queue problem

---
 scheme/examples/hello.scm     |  4 +++-
 scheme/xlib/display.scm       |  9 +++------
 scheme/xlib/sync-event.scm    | 11 +++++++----
 scheme/xlib/xlib-packages.scm |  6 +++---
 4 files changed, 16 insertions(+), 14 deletions(-)

diff --git a/scheme/examples/hello.scm b/scheme/examples/hello.scm
index 686b4d7..b0a3c9b 100755
--- a/scheme/examples/hello.scm
+++ b/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))))
 
diff --git a/scheme/xlib/display.scm b/scheme/xlib/display.scm
index c927c95..3d86ae2 100644
--- a/scheme/xlib/display.scm
+++ b/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")
diff --git a/scheme/xlib/sync-event.scm b/scheme/xlib/sync-event.scm
index 2b94976..753e446 100644
--- a/scheme/xlib/sync-event.scm
+++ b/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)))))))
diff --git a/scheme/xlib/xlib-packages.scm b/scheme/xlib/xlib-packages.scm
index 20b70a7..231602d 100644
--- a/scheme/xlib/xlib-packages.scm
+++ b/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