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

restore `event-dispatch-handler'

Browse Source 
original commit: 10ad58a747b2eaec89e101a89e99ed5c913b3f33
This commit is contained in:
Matthew Flatt 2011-01-15 18:10:39 -07:00
parent dcdd232176
commit b20c4281f5
1 changed files with 5 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -366,8 +366,9 @@
(define (queue-refresh-event eventspace thunk) (define (queue-refresh-event eventspace thunk)
((eventspace-queue-proc eventspace) (cons 'refresh thunk))) ((eventspace-queue-proc eventspace) (cons 'refresh thunk)))
(define (handle-event thunk) (define (handle-event thunk e)
(let/ec esc (let/ec esc
((event-dispatch-handler) e)
(let ([done? #f]) (let ([done? #f])
(dynamic-wind (dynamic-wind
void void
@ -386,7 +387,7 @@
(if (eq? (current-thread) (eventspace-handler-thread e)) (if (eq? (current-thread) (eventspace-handler-thread e))
(let ([v (sync/timeout 0 ((eventspace-queue-proc e)))]) (let ([v (sync/timeout 0 ((eventspace-queue-proc e)))])
(if v (if v
(begin (handle-event v) #t) (begin (handle-event v e) #t)
#f)) #f))
#f))] #f))]
[(evt) [(evt)
@ -407,7 +408,7 @@
evt) evt)
(handle-evt ((eventspace-queue-proc e)) (handle-evt ((eventspace-queue-proc e))
(lambda (v) (lambda (v)
(when v (handle-event v)) (when v (handle-event v e))
(yield evt)))) (yield evt))))
(sync evt))) (sync evt)))
(if (evt? evt) (if (evt? evt)
@ -424,7 +425,7 @@
(let ([v (sync/timeout 0 ((eventspace-queue-proc e) #f #f))]) (let ([v (sync/timeout 0 ((eventspace-queue-proc e) #f #f))])
(if v (if v
(begin (begin
(handle-event v) (handle-event v e)
(loop #t)) (loop #t))
result))))))) result)))))))