diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt index 7a5e4ab3..c7052e65 100644 --- a/collects/mred/private/wx/cocoa/canvas.rkt +++ b/collects/mred/private/wx/cocoa/canvas.rkt @@ -10,6 +10,7 @@ "types.rkt" "window.rkt" "dc.rkt" + "queue.rkt" "../common/event.rkt" "../common/queue.rkt" "../../syntax.rkt" @@ -40,7 +41,9 @@ (CGContextFillRect cg (make-NSRect (make-NSPoint 0 0) (make-NSSize 32000 32000)))) (tellv ctx restoreGraphicsState)))) - (send wx queue-paint)) + (send wx queue-paint) + ;; ensure that `nextEventMatchingMask:' returns + (post-dummy-event)) (-a _void (viewWillMoveToWindow: [_id w]) (when wx (queue-window-event wx (lambda () (send wx fix-dc))))) @@ -76,15 +79,26 @@ (define canvas-style style) + ;; Avoid multiple queued paints: (define paint-queued? #f) + ;; To handle paint requests that happen while on-paint + ;; is being called already: + (define now-drawing? #f) + (define refresh-after-drawing? #f) + (define/public (queue-paint) ;; can be called from any thread, including the event-pump thread (unless paint-queued? (set! paint-queued? #t) (queue-window-event this (lambda () (set! paint-queued? #f) - (on-paint))))) - + (set! now-drawing? #t) + (fix-dc) + (on-paint) + (set! now-drawing? #f) + (when refresh-after-drawing? + (set! refresh-after-drawing? #f) + (refresh)))))) (define/override (refresh) (tellv content-cocoa setNeedsDisplay: #:type _BOOL #t)) @@ -312,9 +326,13 @@ (define/public (get-canvas-background) bg-col) (define/public (set-canvas-background col) (set! bg-col col)) (define/public (get-canvas-background-for-clearing) - (and (not (memq 'transparent canvas-style)) - (not (memq 'no-autoclear canvas-style)) - bg-col)) + (if now-drawing? + (begin + (set! refresh-after-drawing? #t) + #f) + (and (not (memq 'transparent canvas-style)) + (not (memq 'no-autoclear canvas-style)) + bg-col))) (define/public (do-scroll direction scroller) ;; Called from the Cocoa handler thread diff --git a/collects/mred/private/wx/cocoa/queue.rkt b/collects/mred/private/wx/cocoa/queue.rkt index a4d5f99d..dddec0df 100644 --- a/collects/mred/private/wx/cocoa/queue.rkt +++ b/collects/mred/private/wx/cocoa/queue.rkt @@ -19,6 +19,7 @@ set-eventspace-hook! set-front-hook! set-menu-bar-hooks! + post-dummy-event ;; from common/queue: current-eventspace diff --git a/collects/mred/private/wx/gtk/queue.rkt b/collects/mred/private/wx/gtk/queue.rkt index 443f8739..e5cd5cf2 100644 --- a/collects/mred/private/wx/gtk/queue.rkt +++ b/collects/mred/private/wx/gtk/queue.rkt @@ -37,7 +37,7 @@ (define-glib g_main_context_query (_fun _GMainContext _int _pointer - _GPollFD-pointer + _pointer ;; GPollFD array _int -> _int))