Added synchronous interface to X events.

Makefile

@@ -1,7 +1,7 @@
 ### update this to fit your system
-SCSH_PREFIX = /usr/local
+SCSH_PREFIX = /afs/wsi/i386_fbsd43/scsh-0.6.1/
 X11_PATH = /usr/X11R6
-LIB_DL = -ldl
+LIB_DL = 
 
 ### the following does not have to be changed (hopefully)
 SCHEME_INCLUDE = $(SCSH_PREFIX)/include
@@ -53,6 +53,7 @@ SCM_FILES = scheme/xlib/types.scm \
 	scheme/xlib/text.scm scheme/xlib/utility.scm \
 	scheme/xlib/visual-type.scm scheme/xlib/visual.scm \
 	scheme/xlib/window-type.scm scheme/xlib/window.scm \
+	scheme/xlib/sync-event.scm \
 	scheme/xlib/wm.scm \
 	scheme/libs/xpm.scm
 
@@ -100,3 +101,6 @@ $(SCX): $(SCX_IMAGE) main.o $(OBJECTS)
 
 clean:
 	rm -f $(SCX_VM) $(SCX) $(SCX_IMAGE) *.o c/*.o c/xlib/*.o c/libs/*.o
+
+tags:
+	find . -name "*.c" -or -name "*.h" -or -name "*.scm" | etags -

scheme/xlib/sync-event.scm

@@ -0,0 +1,36 @@
+(define-record-type sync-x-event :sync-x-event
+  (really-make-sync-x-event event next)
+  sync-x-event?
+  (event sync-x-event-event)
+  (next really-next-sync-x-event really-set-next-sync-x-event))
+
+(define (make-sync-x-event event)
+  (really-make-sync-x-event event (make-placeholder)))
+
+(define (next-sync-x-event sync-x-event)
+  (placeholder-value (really-make-sync-x-event sync-x-event)))
+
+(define (set-next-sync-x-event! sync-x-event next-sync-x-event)
+  (placeholder-set! 
+   (really-next-sync-x-event sync-x-event) 
+   next-sync-x-event))
+
+(define (advance-most-recent-sync-x-event!)
+  (set! *most-recent-sync-x-event*
+	(next-sync-x-event *most-recent-sync-x-event*)))
+
+(define *most-recent-sync-x-event* (make-sync-x-event 'no-event))
+
+(define (most-recent-sync-x-event)
+  *most-recent-sync-x-event*)
+
+(define (with-sync-x-events dpy thunk)
+  (spawn (lambda ()
+	   (let lp ()
+	     (let ((next (wait-event dpy)))
+	       (set-next-sync-x-event! *most-recent-sync-x-event*
+				  (make-sync-x-event next))
+	       (advance-most-recent-sync-x-event!)))))
+  (thunk))
+	 
+	       

scheme/xlib/xlib-interfaces.scm

@@ -287,13 +287,22 @@
 	  special-pixmap:none special-pixmap:copy-from-parent
 	  special-pixmap:parent-relative))
 
-(define-interface xlib-event-interface
+(define-interface xlib-event-internal-interface
-  (export event-ready?
+  (export next-event
+	  peek-event
+	  event-ready?
 	  events-pending
 	  events-queued
-	  ((queued-mode) :syntax)
+	  ((queued-mode) :syntax)))
-	  next-event
+
-	  peek-event
+(define-interface xlib-sync-x-events-interface
+  (export sync-x-event-event
+	  most-recent-sync-x-event
+	  with-sync-x-events
+	  next-sync-x-event))
+
+(define-interface xlib-event-interface
+  (export 
    wait-event
    send-event
 	  
@@ -653,7 +662,7 @@
    keymap-event-send-event?
    keymap-event-display
    keymap-event-bit-vector
-))
+   ))
 
 (define-interface xlib-text-interface
   (export text-width
@@ -909,4 +918,5 @@
 		      xlib-grab-interface
 		      xlib-visual-interface
 		      xlib-region-interface
+		      xlib-sync-x-events-interface
 		      ))

scheme/xlib/xlib-packages.scm

@@ -79,7 +79,8 @@
 	finite-types)
   (files graphics))
 
-(define-structure xlib-event xlib-event-interface
+(define-structures ((xlib-event xlib-event-interface)
+		    (xlib-event-internal xlib-event-internal-interface))
   (open scsh-level-0 ;; for port->channel
 	scheme
 	external-calls
@@ -91,6 +92,14 @@
 	xlib-internal-types)
   (files event event-types))
 
+(define-structure xlib-sync-x-events xlib-sync-x-events-interface
+  (open scheme
+	placeholders
+	define-record-types
+	threads
+	xlib-event)
+  (files sync-event))
+
 (define-structure xlib-font xlib-font-interface
   (open scheme
 	signals  ;; for error
@@ -231,5 +240,6 @@
 	xlib-grab
 	xlib-visual
 	xlib-region
+	xlib-sync-x-events
 	)
   (optimize auto-integrate))