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

cocoa: fix problems with live-resize

Browse Source 
that were created by the queue-sync change
This commit is contained in:
Matthew Flatt 2011-01-26 12:57:01 -07:00
parent 2bd0145603
commit 8cbc701671
4 changed files with 19 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/mred/private/wx/cocoa/canvas.rkt
View File

@ -704,7 +704,7 @@
[position (get-scroll-pos direction)]))))))))
(constrained-reply (get-eventspace)
(lambda ()
(let loop () (pre-event-sync #t) (when (yield) (loop))))
(let loop () (pre-event-sync #t) (when (yield/no-sync) (loop))))
(void)))
(define/public (on-scroll e) (void))

2
collects/mred/private/wx/cocoa/frame.rkt
View File

@ -72,7 +72,7 @@
(constrained-reply (send wx get-eventspace)
(lambda ()
(pre-event-sync #t)
(let loop () (when (yield) (loop))))
(let loop () (when (yield/no-sync) (loop))))
(void)))))]
[-a _void (windowDidMove: [_id notification])
(when wxb

2
collects/mred/private/wx/cocoa/slider.rkt
View File

@ -30,7 +30,7 @@
(queue-window-event wx (lambda () (send wx changed)))
(constrained-reply
(send wx get-eventspace)
(lambda () (let loop () (pre-event-sync #t) (when (yield) (loop))))
(lambda () (let loop () (pre-event-sync #t) (when (yield/no-sync) (loop))))
(void))))))
(defclass slider% item%

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

@ -27,6 +27,7 @@
queue-event
queue-refresh-event
yield
yield/no-sync
yield-refresh
eventspace-event-evt
(rename-out [make-new-eventspace make-eventspace])
@ -291,7 +292,7 @@
(timed-alarm-evt (rbtree-min (unbox timer)))
(lambda (_) #f)))))]
[make-event-choice
(lambda (peek?)
(lambda (peek? sync?)
(choice-evt
(wrap-evt (semaphore-peek-evt newly-posted-sema)
(lambda (_) #f))
@ -300,6 +301,7 @@
(first refresh peek?)
(first med peek?)
(and (not peek?)
sync?
;; before going with low-priority events,
;; make sure we're sync'ed up with the
;; GUI platform's event queue:
@ -339,9 +341,9 @@
;; Dequeue as evt
(start-atomic)
(begin0
(make-event-choice #f)
(make-event-choice #f #t)
(end-atomic))]
[(only-refresh? peek?)
[(only-refresh? peek? sync?)
(start-atomic)
(begin0
(cond
@ -349,7 +351,7 @@
;; Dequeue only refresh event
(or (first refresh peek?) never-evt)]
[else
(make-event-choice #t)])
(make-event-choice peek? sync?)])
(end-atomic))]))))
frames
(semaphore-peek-evt done-sema)
@ -475,12 +477,20 @@
(sync/timeout wait-now evt)
(wait-now))]))]))
(define (yield/no-sync)
(let ([e (current-eventspace)])
(when (eq? (current-thread) (eventspace-handler-thread e))
(let ([v (sync/timeout 0 ((eventspace-queue-proc e) #f #f #f))])
(if v
(begin (handle-event v e) #t)
#f)))))
(define yield-refresh
(lambda ()
(let ([e (current-eventspace)])
(and (eq? (current-thread) (eventspace-handler-thread e))
(let loop ([result #f])
(let ([v (sync/timeout 0 ((eventspace-queue-proc e) #t #f))])
(let ([v (sync/timeout 0 ((eventspace-queue-proc e) #t #f #t))])
(if v
(begin
(handle-event v e)
@ -490,7 +500,7 @@
(define (eventspace-event-evt [e (current-eventspace)])
(unless (eventspace? e)
(raise-type-error 'eventspace-event-evt "eventspace" e))
(wrap-evt ((eventspace-queue-proc e) #f #t)
(wrap-evt ((eventspace-queue-proc e) #f #t #t)
(lambda (_) e)))
(define (main-eventspace? e)