diff --git a/scheme/xlib/sync-event.scm b/scheme/xlib/sync-event.scm index 74bc717..7051cf1 100644 --- a/scheme/xlib/sync-event.scm +++ b/scheme/xlib/sync-event.scm @@ -7,8 +7,12 @@ (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 (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! @@ -17,20 +21,21 @@ (define (advance-most-recent-sync-x-event!) (set! *most-recent-sync-x-event* - (next-sync-x-event *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 (with-sync-x-events dpy thunk) +(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!))))) - (thunk)) + (advance-most-recent-sync-x-event!)) + (lp))))) +