37 lines
1.1 KiB
Scheme
37 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)
|
||
|
|
(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))
|
||
|
|
|
||
|
|
|