queue and paint repairs

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)) 
+      (if now-drawing?
-           (not (memq 'no-autoclear canvas-style)) 
+          (begin
-           bg-col))
+            (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

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

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))
 

collects/racket/draw/dc.rkt

@@ -759,7 +759,11 @@
        (do-text cr #f s 0 0 font combine? offset 0.0)))
 
     (define/private (do-text cr draw? s x y font combine? offset angle)
-      (let ([s (if (zero? offset) s (substring s offset))])
+      (let* ([s (if (zero? offset) 
+                    s 
+                    (substring s offset))]
+             [blank? (equal? s "")]
+             [s (if (and (not draw?) blank?) " " s)])
         (unless context
           (set! context (pango_cairo_create_context cr)))
         (set-font-antialias context (send font get-smoothing))
@@ -788,7 +792,9 @@
                      (void)
                      (let ([logical (make-PangoRectangle 0 0 0 0)])
                        (pango_layout_get_extents layout #f logical)
-                       (values (integral (/ (PangoRectangle-width logical) (exact->inexact PANGO_SCALE)))
+                       (values (if blank?
+                                   0.0
+                                   (integral (/ (PangoRectangle-width logical) (exact->inexact PANGO_SCALE))))
                                (integral (/ (PangoRectangle-height logical) (exact->inexact PANGO_SCALE)))
                                (integral (/ (- (PangoRectangle-height logical)
                                                (pango_layout_get_baseline layout))
@@ -820,7 +826,7 @@
                                               (pango_layout_get_baseline layout))
                                            (exact->inexact PANGO_SCALE)))]
                           [la 0.0])
-                      (values (+ w lw) (max h lh) (max d ld) (max a la))))))))))
+                      (values (if blank? 0.0 (+ w lw)) (max h lh) (max d ld) (max a la))))))))))
     
     (def/public (get-char-width)
       10.0)