scx/scheme/xlib/sync-event.scm

33 lines
1.1 KiB
Scheme

(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 (init-sync-x-events dpy)
(let ((most-recent-sync-x-event (make-sync-x-event 'no-event)))
(spawn (lambda ()
(let lp ()
(let ((next (wait-event dpy)))
(set-next-sync-x-event! most-recent-sync-x-event
(make-sync-x-event next))
(set! most-recent-sync-x-event
(placeholder-value (really-next-sync-x-event
most-recent-sync-x-event))))
(lp))))
(lambda () most-recent-sync-x-event)))