scsh-conservatory
/
scx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Minor corrections.

This commit is contained in:
mainzelm 2002-04-29 09:48:36 +00:00
parent b15642d63d
commit 2f6c034d6e
1 changed files with 11 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
scheme/xlib/sync-event.scm
View File

@ -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)))))