diff --git a/gui-lib/mred/private/wx/gtk/canvas.rkt b/gui-lib/mred/private/wx/gtk/canvas.rkt index f9ab2656..5d0f5819 100644 --- a/gui-lib/mred/private/wx/gtk/canvas.rkt +++ b/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) diff --git a/gui-lib/mred/private/wx/gtk/list-box.rkt b/gui-lib/mred/private/wx/gtk/list-box.rkt index 2b0f1043..60677a33 100644 --- a/gui-lib/mred/private/wx/gtk/list-box.rkt +++ b/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 diff --git a/gui-lib/mred/private/wx/gtk/panel.rkt b/gui-lib/mred/private/wx/gtk/panel.rkt index f1c89522..b97d2bac 100644 --- a/gui-lib/mred/private/wx/gtk/panel.rkt +++ b/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)])