fix canvases in tab panels

collects/mred/private/wx/cocoa/panel.rkt

@@ -16,12 +16,35 @@
 
 (define (panel-mixin %)
   (class %
+    (inherit register-as-child)
+
     (define lbl-pos 'horizontal)
+    (define children null)
+
     (super-new)
     
     (define/public (get-label-position) lbl-pos)
     (define/public (set-label-position pos) (set! lbl-pos pos))
 
+    (define/public (fix-dc)
+      (for ([child (in-list children)])
+        (send child fix-dc)))
+    
+    (define/override (set-size x y w h)
+      (super set-size x y w h)
+      (fix-dc))
+    
+    (define/override (maybe-register-as-child parent on?)
+      (register-as-child parent on?))
+    
+    (define/override (register-child child on?)
+      (let ([now-on? (and (memq child children) #t)])
+        (unless (eq? on? now-on?)
+          (set! children 
+                (if on?
+                    (cons child children)
+                    (remq child children))))))
+    
     (def/public-unimplemented on-paint)
     (define/public (set-item-cursor x y) (void))
     (def/public-unimplemented get-item-cursor)))
@@ -31,29 +54,6 @@
         x y w h
         style
         label)
-  (inherit register-as-child)
-
-  (define children null)
-
-  (define/public (fix-dc)
-    (for ([child (in-list children)])
-      (send child fix-dc)))
-
-  (define/override (set-size x y w h)
-    (super set-size x y w h)
-    (fix-dc))
-
-  (define/override (maybe-register-as-child parent on?)
-    (register-as-child parent on?))
-  
-  (define/override (register-child child on?)
-    (let ([now-on? (and (memq child children) #t)])
-      (unless (eq? on? now-on?)
-        (set! children 
-              (if on?
-                  (cons child children)
-                  (remq child children))))))
-
   (super-new [parent parent]
              [cocoa
               (as-objc-allocation

collects/mred/private/wx/gtk/canvas.rkt

@@ -84,7 +84,8 @@
           [ignored-name #f]
           [gl-config #f])
 
-    (inherit get-gtk set-size get-client-size)
+    (inherit get-gtk set-size get-size get-client-size 
+             on-size register-as-child)
 
     (define client-gtk (gtk_drawing_area_new))
     (define-values (gtk hscroll-adj vscroll-adj hscroll-gtk vscroll-gtk resize-box)
@@ -196,9 +197,19 @@
 
     (define/override (refresh)
       (gtk_widget_queue_draw client-gtk))
+    
+    (define/public (reset-child-dcs)
+      (send dc reset-dc #t))
+    (define/override (maybe-register-as-child parent on?)
+      (register-as-child parent on?))
 
     (define/override (internal-on-client-size w h)
-      (send dc reset-dc-size))
+      (send dc reset-dc #f))
+    (define/override (on-client-size w h) 
+      (let ([xb (box 0)]
+            [yb (box 0)])
+        (get-size xb yb)
+        (on-size (unbox xb) (unbox yb))))
 
     (define/public (show-scrollbars h? v?)
       (when hscroll-gtk

collects/mred/private/wx/gtk/dc.rkt

@@ -9,13 +9,13 @@
          racket/draw/local
          ffi/unsafe/alloc)
 
-(provide dc% reset-dc-size)
+(provide dc% reset-dc)
 
 (define-gdk gdk_cairo_create (_fun _pointer -> _cairo_t)
   #:wrap (allocator cairo_destroy))
 
 (define-local-member-name
-  reset-dc-size)
+  reset-dc)
 
 (define dc-backend%
   (class default-dc-backend%
@@ -31,8 +31,9 @@
                  (set! c (gdk_cairo_create w))
                  c))))
 
-    (define/public (reset-dc-size)
+    (define/public (reset-dc force?)
-      (when (eq? 'windows (system-type))
+      (when (or force?
+                (eq? 'windows (system-type)))
         ;; FIXME: ensure that the dc is not in use
         (as-entry
          (lambda ()

collects/mred/private/wx/gtk/panel.rkt

@@ -17,12 +17,36 @@
 
 (define (panel-mixin %)
   (class %
-    (define lbl-pos 'vertical)
+    (inherit register-as-child)
+
+    (define lbl-pos 'horizontal)
+    (define children null)
+
     (super-new)
 
     (define/public (get-label-position) lbl-pos)
     (define/public (set-label-position pos) (set! lbl-pos pos))
 
+    (define/public (reset-child-dcs)
+      (when (pair? children)
+        (for ([child (in-list children)])
+          (send child reset-child-dcs))))
+    
+    (define/override (set-size x y w h)
+      (super set-size x y w h)
+      (reset-child-dcs))
+    
+    (define/override (maybe-register-as-child parent on?)
+      (register-as-child parent on?))
+    
+    (define/override (register-child child on?)
+      (let ([now-on? (and (memq child children) #t)])
+        (unless (eq? on? now-on?)
+          (set! children 
+                (if on?
+                    (cons child children)
+                    (remq child children))))))
+
     (def/public-unimplemented on-paint)
     (define/public (set-item-cursor x y) (void))
     (def/public-unimplemented get-item-cursor)))

collects/mred/private/wx/gtk/tab-panel.rkt

@@ -45,7 +45,8 @@
           style
           labels)
     
-    (inherit set-size set-auto-size get-gtk)
+    (inherit set-size set-auto-size get-gtk
+             reset-child-dcs)
 
     (define gtk (gtk_notebook_new))
     ;; Reparented so that it's always in the current page's bin:
@@ -56,7 +57,9 @@
 
     (define (select-bin bin-gtk)
       (set! current-bin-gtk bin-gtk)
-      (gtk_box_pack_start bin-gtk client-gtk #t #t 0))
+      (gtk_box_pack_start bin-gtk client-gtk #t #t 0)
+      ;; re-parenting can change the underlying window dc:
+      (reset-child-dcs))
 
     (define pages
       (for/list ([lbl labels])

collects/mred/private/wx/gtk/window.rkt

@@ -255,7 +255,8 @@
       (if on?
           (gtk_widget_show gtk)
           (gtk_widget_hide gtk))
-      (set! shown? (and on? #t)))
+      (set! shown? (and on? #t))
+      (maybe-register-as-child parent on?))
     (define/public (show on?)
       (direct-show on?))
     (define/public (is-shown?) shown?)
@@ -325,8 +326,16 @@
     (define/public (on-char e) (void))
     (define/public (on-event e) (void))
 
+    (define/public (on-size w h) (void))
+
+    (define/public (maybe-register-as-child parent on?)
+      (void))
+    (define/public (register-as-child parent on?)
+      (send parent register-child this on?))
+    (define/public (register-child child on?)
+      (void))
+
     (def/public-unimplemented on-drop-file)
-    (def/public-unimplemented on-size)
     (def/public-unimplemented get-handle)
     (def/public-unimplemented set-phantom-size)
     (def/public-unimplemented popup-menu)