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)])))))))) [position (get-scroll-pos direction)]))))))))
(constrained-reply (get-eventspace) (constrained-reply (get-eventspace)
(lambda () (lambda ()
(let loop () (pre-event-sync #t) (when (yield) (loop)))) (let loop () (pre-event-sync #t) (when (yield/no-sync) (loop))))
(void))) (void)))
(define/public (on-scroll e) (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) (constrained-reply (send wx get-eventspace)
(lambda () (lambda ()
(pre-event-sync #t) (pre-event-sync #t)
(let loop () (when (yield) (loop)))) (let loop () (when (yield/no-sync) (loop))))
(void)))))] (void)))))]
[-a _void (windowDidMove: [_id notification]) [-a _void (windowDidMove: [_id notification])
(when wxb (when wxb

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

@ -30,7 +30,7 @@
(queue-window-event wx (lambda () (send wx changed))) (queue-window-event wx (lambda () (send wx changed)))
(constrained-reply (constrained-reply
(send wx get-eventspace) (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)))))) (void))))))
(defclass slider% item% (defclass slider% item%

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

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