42 lines
1.2 KiB
Scheme
42 lines
1.2 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 (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)))))
|
|
|
|
|
|
|