GTK+ 3: fix flicker with transparent canvases

Restore the use of freeze & thaw on transparent canvases, but
ensure that the implementation underlying the GDK window won't
change while a freeze is in effect.

gui-lib/mred/private/wx/gtk/canvas.rkt

@@ -393,7 +393,8 @@
      (define dc #f)
 
      (define transparent?
-       (memq 'transparent style))
+       (and (memq 'transparent style)
+            (not (memq 'gl style)))) ; 'transparent is incompatible with 'gl
 
      (super-new [parent parent]
                 [gtk gtk]
@@ -424,7 +425,7 @@
          (reset-auto-scroll))
        (on-size))
      
-     (set! dc (new dc% [canvas this] [transparent? (memq 'transparent style)]))
+     (set! dc (new dc% [canvas this] [transparent? transparent?]))
 
      (gtk_widget_realize gtk)
      (gtk_widget_realize client-gtk)
@@ -549,11 +550,9 @@
      ;; are defined by `canvas-mixin' from ../common/canvas-mixin
      (define/public (queue-paint) (void))
      (define/public (request-canvas-flush-delay)
-       (unless (and gtk3? transparent?)
+       (request-flush-delay (get-flush-window) transparent?))
-         (request-flush-delay (get-flush-window))))
      (define/public (cancel-canvas-flush-delay req)
-       (unless (and gtk3? transparent?)
+       (cancel-flush-delay req))
-         (cancel-flush-delay req)))
      (define/public (queue-canvas-refresh-event thunk)
        (queue-window-refresh-event this thunk))
      (define/public (skip-pre-paint?) #f)
@@ -590,6 +589,11 @@
 		  flush-win-box)))))
      (define/public (unrealize)
        (unrealize-win-box flush-win-box))
+     (define/override (reset-child-freezes)
+       ;; A transparent canvas can't have a native window, so we
+       ;; need to release any freezes befre the window implementation
+       ;; might change.
+       (when transparent? (unrealize)))
 
      (define/public (begin-refresh-sequence)
        (send dc suspend-flush))
@@ -737,7 +741,7 @@
            (->long (dispatch which gtk_adjustment_get_value 0))))
      
      (define clear-bg?
-       (and (not (memq 'transparent style))
+       (and (not transparent?)
             (not (memq 'no-autoclear style))))
      (define gc #f)
      (define bg-col (make-object color% "white"))

gui-lib/mred/private/wx/gtk/dc.rkt

@@ -75,6 +75,8 @@
 				  (gdk_window_get_display gdk-win)
 				  (gdk_display_get_default)))]
 		   [visual (gdk_window_get_visual gdk-win)])
+	      ;; We must not get here for a transparent canvas,
+	      ;; because getting an XID will force a native window.
 	      (values (XCreatePixmap xdisplay
 				     (gdk_x11_window_get_xid gdk-win)
 				     (scale w) (scale h)
@@ -180,7 +182,7 @@
     (inherit end-delay)
     (define canvas cnvs)
     (define gl #f)
-    (define can-delay? (not (and gtk3? transparent?)))
+    (define is-transparent? transparent?)
 
     (super-new [transparent? transparent?])
 
@@ -221,12 +223,9 @@
       (send canvas flush))
 
     (define/override (request-delay)
-      (if can-delay?
+      (request-flush-delay (send canvas get-flush-window) is-transparent?))
-	  (request-flush-delay (send canvas get-flush-window))
-	  (void)))
     (define/override (cancel-delay req)
-      (when can-delay?
+      (cancel-flush-delay req))))
-	(cancel-flush-delay req)))))
 
 (define (do-backing-flush canvas dc win-or-cr)
   (send dc on-backing-flush

gui-lib/mred/private/wx/gtk/panel.rkt

@@ -93,6 +93,12 @@
       ;; in atomic mode
       (send child set-parent this))
 
+    (define/override (reset-child-freezes)
+      (super reset-child-freezes)
+      (when (pair? children)
+        (for ([child (in-list children)])
+          (send child reset-child-freezes))))
+
     (define/override (reset-child-dcs)
       (super reset-child-dcs)
       (when (pair? children)

gui-lib/mred/private/wx/gtk/tab-panel.rkt

@@ -48,7 +48,7 @@
           labels)
     
     (inherit set-size set-auto-size infer-client-delta get-gtk
-             reset-child-dcs get-height)
+             reset-child-freezes reset-child-dcs get-height)
 
     (define gtk (gtk_notebook_new))
     ;; Reparented so that it's always in the current page's bin:
@@ -70,6 +70,9 @@
 
     (define (select-bin bin-gtk)
       (set! current-bin-gtk bin-gtk)
+      ;; re-parenting can change the underlying window, so
+      ;; make sure no freeze in places:
+      (reset-child-freezes)
       (gtk_box_pack_start bin-gtk client-gtk #t #t 0)
       ;; re-parenting can change the underlying window dc:
       (reset-child-dcs))

gui-lib/mred/private/wx/gtk/window.rkt

@@ -639,6 +639,7 @@
     (define/public (show on?)
       (atomically
        (direct-show on?)))
+    (define/public (reset-child-freezes) (void))
     (define/public (reset-child-dcs) (void))
     (define/public (is-shown?) shown?)
     (define/public (is-shown-to-root?)
@@ -657,6 +658,7 @@
     (define/public (get-parent) parent)
     (define/public (set-parent p)
       ;; in atomic mode
+      (reset-child-freezes)
       (g_object_ref gtk)
       (gtk_container_remove (send parent get-container-gtk) gtk)
       (set! parent p)
@@ -875,7 +877,7 @@
       (for ([i (in-range (mcdr win-box))])
         (gdk_window_thaw_updates win)))))
 
-(define (request-flush-delay win-box)
+(define (request-flush-delay win-box transparent?)
   (do-request-flush-delay 
    win-box
    (lambda (win-box)
@@ -885,7 +887,12 @@
             ;; implementation, so force a native implementation of the
             ;; window to try to avoid it changing out from underneath
             ;; us between the freeze and thaw actions.
-            (gdk_window_ensure_native win)
+	    ;; With Gtk3, we can't use a native window for transparent
+	    ;; windows; that means we have to be extra careful that
+	    ;; the underlying window doesn't change while a freeze is
+	    ;; in effect; the `reset-child-freezes` helps with that.
+            (unless (and transparent? gtk3?)
+              (gdk_window_ensure_native win))
             (begin
               (gdk_window_freeze_updates win)
               (set-mcdr! win-box (add1 (mcdr win-box)))