GTK 3: try to make panels work right

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

@@ -317,9 +317,15 @@
                           (memq 'auto-hscroll style))]
                  [vs? (or (memq 'vscroll style)
                           (memq 'auto-vscroll style))])
-            (let ([border (and has-border?
-			       (as-gtk-allocation (gtk_hbox_new #f 0)))]
-		  [h (if has-border?
+            (let ([container (and gtk3?
+				  ;; See `panel%` for information on why an extra
+				  ;; event-box layer is needed here.
+				  (as-gtk-allocation (gtk_event_box_new)))]
+	          [border (and has-border?
+			       (if gtk3?
+				   (gtk_hbox_new #f 0)
+				   (as-gtk-allocation (gtk_hbox_new #f 0))))]
+		  [h (if (or has-border? gtk3?)
 			 (gtk_hbox_new #f 0)
 			 (as-gtk-allocation (gtk_hbox_new #f 0)))]
                   [v (gtk_vbox_new #f 0)]
@@ -340,6 +346,9 @@
               (when has-border?
                 (gtk_container_set_border_width h margin)
                 (connect-expose/draw-border border h))
+	      (when container
+		(gtk_container_add container (or border h))
+		(gtk_widget_show (or border h)))
               (when border (gtk_box_pack_start border h #t #t 0))
               (gtk_box_pack_start h v #t #t 0)
               (gtk_box_pack_start v client-gtk #t #t 0)
@@ -365,7 +374,8 @@
                 (gtk_widget_show container-gtk))
               (let ([req (make-GtkRequisition 0 0)])
                 (gtk_widget_size_request vscroll req)
-                (values client-gtk container-gtk (or border h) hadj vadj 
+                (values client-gtk container-gtk (or container border h)
+			hadj vadj 
                         (and hs? h2)
                         (and vs? v2)
                         (and hs? vs? resize-box)

gui-lib/mred/private/wx/gtk/list-box.rkt

@@ -10,9 +10,10 @@
          "types.rkt"
          "window.rkt"
          "const.rkt"
+	 "panel.rkt"
          "../common/event.rkt")
 
-(provide 
+(provide
  (protect-out list-box%))
 
 ;; ----------------------------------------
@@ -143,9 +144,21 @@
       (when (and (= (get-selection) -1)
                  (pair? data))
         (set-selection 0))))
-    
-  (define gtk (as-gtk-allocation (gtk_scrolled_window_new #f #f)))
-  (gtk_scrolled_window_set_policy gtk GTK_POLICY_AUTOMATIC GTK_POLICY_ALWAYS)
+
+  (define-values (gtk scrolled-gtk)
+    (cond
+     [gtk3?
+      ;; See `panel%` for information on why an extra
+      ;; event-box layer is needed here.
+      (define gtk (as-gtk-allocation (gtk_event_box_new)))
+      (define scrolled-gtk (gtk_scrolled_window_new #f #f))
+      (gtk_container_add gtk scrolled-gtk)
+      (gtk_widget_show scrolled-gtk)
+      (values gtk scrolled-gtk)]
+     [else
+      (define scrolled-gtk (as-gtk-allocation (gtk_scrolled_window_new #f #f)))
+      (values scrolled-gtk scrolled-gtk)]))
+  (gtk_scrolled_window_set_policy scrolled-gtk GTK_POLICY_AUTOMATIC GTK_POLICY_ALWAYS)
 
   (define headers? (memq 'column-headers style))
   (define click-headers? (and headers?
@@ -194,7 +207,7 @@
           (gtk_tree_view_move_column_after client-gtk column-gtk prev)
           (loop column-gtk (cdr l))))))
 
-  (gtk_container_add gtk client-gtk)
+  (gtk_container_add scrolled-gtk client-gtk)
   (gtk_widget_show client-gtk)
 
   (define selection

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

@@ -18,6 +18,7 @@
 
               gtk_fixed_new
               gtk_fixed_move
+              gtk_event_box_new
 
               gtk_container_set_border_width
               connect-expose/draw-border))
@@ -25,9 +26,6 @@
 (define-gtk gtk_fixed_new (_fun -> _GtkWidget))
 (define-gtk gtk_event_box_new (_fun -> _GtkWidget))
 
-(define-gtk gtk_event_box_set_visible_window (_fun _GtkWidget _gboolean -> _void)
-  #:make-fail make-not-available)
-
 (define-gtk gtk_fixed_move (_fun _GtkWidget _GtkWidget _int _int -> _void))
 
 (define-gtk gtk_container_set_border_width (_fun _GtkWidget _int -> _void))
@@ -140,6 +138,8 @@
       (gtk_fixed_move (get-container-gtk) child-gtk (->screen x) (->screen y))
       (gtk_widget_set_size_request child-gtk (->screen w) (->screen h)))))
 
+(define-gdk gdk_window_has_native (_fun _GdkWindow -> _gboolean))
+
 (define panel%
   (class (panel-container-mixin (panel-mixin window%))
     (init parent
@@ -149,9 +149,21 @@
     
     (inherit get-gtk set-auto-size set-size
              adjust-client-delta)
-    
-    (define gtk (as-gtk-allocation (gtk_event_box_new)))
-    (when gtk3? (gtk_event_box_set_visible_window gtk #f))
+
+    ;; With GTK+ 3, an event box draws solid over
+    ;; the background, which interferes with themes
+    ;; can controls that have their own background.
+    ;; The gtk_event_box_set_visible_window function
+    ;; is supposed to avoid that, but somehow that
+    ;; blocks events to children. So, use a fixed
+    ;; box instead, and ensure that no child forces
+    ;; it to be a native window at the GDK level.
+    ;; In particular, scrolls force the enclosing
+    ;; parent to have a native window, so add a layer
+    ;; as needed around scrolls.
+    (define gtk (as-gtk-allocation (if gtk3?
+				       (gtk_fixed_new)
+				       (gtk_event_box_new))))
     (define border-gtk (atomically
                         (and (memq 'border style)
                              (let ([border-gtk (gtk_fixed_new)])