scx/scheme/xlib/sync-event.scm

(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 pred)
  (let ((next (placeholder-value (really-next-sync-x-event sync-x-event))))
    (if (pred (sync-x-event-event next))
	next
	(next-sync-x-event next pred))))
	

(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*
	(placeholder-value (really-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 (init-sync-x-events dpy)
  (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!))
	     (lp)))))