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) (define (make-sync-x-event event)
(really-make-sync-x-event event (make-placeholder))) (really-make-sync-x-event event (make-placeholder)))
(define (next-sync-x-event sync-x-event) (define (next-sync-x-event sync-x-event pred)
(placeholder-value (really-make-sync-x-event sync-x-event))) (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) (define (set-next-sync-x-event! sync-x-event next-sync-x-event)
(placeholder-set! (placeholder-set!
@ -17,20 +21,21 @@
(define (advance-most-recent-sync-x-event!) (define (advance-most-recent-sync-x-event!)
(set! *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* (make-sync-x-event 'no-event))
(define (most-recent-sync-x-event) (define (most-recent-sync-x-event)
*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 () (spawn (lambda ()
(let lp () (let lp ()
(let ((next (wait-event dpy))) (let ((next (wait-event dpy)))
(set-next-sync-x-event! *most-recent-sync-x-event* (set-next-sync-x-event! *most-recent-sync-x-event*
(make-sync-x-event next)) (make-sync-x-event next))
(advance-most-recent-sync-x-event!))))) (advance-most-recent-sync-x-event!))
(thunk)) (lp)))))