suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

extend `sync/timeout' to allow a tail-position fail thunk for polling

Browse Source 
original commit: 2b4f1a69085fe9b9c41b1342bcbffd6bcafc88eb
This commit is contained in:
Matthew Flatt 2010-12-10 14:17:08 -07:00
parent 83ad612c98
commit 77b082f08f
1 changed files with 15 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/mred/private/wx/common/queue.rkt
View File

@ -399,20 +399,22 @@
[(and (eq? evt 'wait)
(not handler?))
#t]
;; `yield' is supposed to return immediately if the
;; event is already ready:
[(and (evt? evt) (sync/timeout 0 (wrap-evt evt (lambda (v) (list v)))))
=> (lambda (v) (car v))]
[handler?
(sync (if (eq? evt 'wait)
(wrap-evt e (lambda (_) #t))
evt)
(handle-evt ((eventspace-queue-proc e))
(lambda (v)
(when v (handle-event v))
(yield evt))))]
[else
(sync evt)]))]))
(define (wait-now)
(if handler?
(sync (if (eq? evt 'wait)
(wrap-evt e (lambda (_) #t))
evt)
(handle-evt ((eventspace-queue-proc e))
(lambda (v)
(when v (handle-event v))
(yield evt))))
(sync evt)))
(if (evt? evt)
;; `yield' is supposed to return immediately if the
;; event is already ready:
(sync/timeout wait-now evt)
(wait-now))]))]))
(define yield-refresh
(lambda ()