diff --git a/gui-lib/mred/private/wx/gtk/panel.rkt b/gui-lib/mred/private/wx/gtk/panel.rkt index b97d2bac..61ba6115 100644 --- a/gui-lib/mred/private/wx/gtk/panel.rkt +++ b/gui-lib/mred/private/wx/gtk/panel.rkt @@ -25,6 +25,7 @@ (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)) (define-gtk gtk_fixed_move (_fun _GtkWidget _GtkWidget _int _int -> _void)) @@ -154,16 +155,16 @@ ;; 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 + ;; avoids that, but 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)))) + ;; as needed around scrolls. Also, for tab panels, + ;; a non-hidden event box seems to be needed around + ;; the panel to deliver events to the tab. + (define gtk (as-gtk-allocation (gtk_event_box_new))) + (when gtk3? + (gtk_event_box_set_visible_window gtk #f)) (define border-gtk (atomically (and (memq 'border style) (let ([border-gtk (gtk_fixed_new)]) diff --git a/gui-lib/mred/private/wx/gtk/tab-panel.rkt b/gui-lib/mred/private/wx/gtk/tab-panel.rkt index a7c1bbe3..c8330eff 100644 --- a/gui-lib/mred/private/wx/gtk/tab-panel.rkt +++ b/gui-lib/mred/private/wx/gtk/tab-panel.rkt @@ -50,16 +50,30 @@ (inherit set-size set-auto-size infer-client-delta get-gtk reset-child-freezes reset-child-dcs get-height) - (define gtk (gtk_notebook_new)) + (define notebook-gtk (if gtk3? + (gtk_notebook_new) + (as-gtk-allocation (gtk_notebook_new)))) + (define gtk (if gtk3? + ;; For some reason, tabs in a hidden eventbox + ;; don't work right. Add a layer. + (let ([gtk (as-gtk-allocation (gtk_event_box_new))]) + (gtk_container_add gtk notebook-gtk) + (gtk_widget_show notebook-gtk) + gtk) + notebook-gtk)) ;; Reparented so that it's always in the current page's bin: (define client-gtk (gtk_fixed_new)) - (gtk_notebook_set_scrollable gtk #t) + (gtk_notebook_set_scrollable notebook-gtk #t) (super-new [parent parent] [gtk gtk] [client-gtk client-gtk] - [extra-gtks (list client-gtk)] + [extra-gtks (append + (if (eq? gtk notebook-gtk) + null + (list notebook-gtk)) + (list client-gtk))] [no-show? (memq 'deleted style)]) ; Once without tabs to set client-width delta: @@ -81,12 +95,12 @@ (for/list ([lbl labels]) (let ([bin-gtk (gtk_hbox_new #f 0)] [label-gtk (gtk_label_new_with_mnemonic lbl)]) - (gtk_notebook_append_page gtk bin-gtk label-gtk) + (gtk_notebook_append_page notebook-gtk bin-gtk label-gtk) (gtk_widget_show bin-gtk) (make-page bin-gtk label-gtk)))) (define/private (install-empty-page) - (gtk_notebook_append_page gtk empty-bin-gtk #f) + (gtk_notebook_append_page notebook-gtk empty-bin-gtk #f) (gtk_widget_show empty-bin-gtk)) (if (null? pages) @@ -97,8 +111,8 @@ (select-bin (page-bin-gtk (car pages))))) (gtk_widget_show client-gtk) - (connect-key-and-mouse gtk) - (connect-focus gtk) + (connect-key-and-mouse notebook-gtk) + (connect-focus notebook-gtk) ; With tabs to set client-width delta: (infer-client-delta #f #t) @@ -126,7 +140,7 @@ (swap-in (page-bin-gtk (list-ref pages i))) (when callback-ok? (queue-window-event this (lambda () (do-callback)))))) - (connect-changed gtk) + (connect-changed notebook-gtk) (define/override (get-client-gtk) client-gtk) @@ -141,14 +155,14 @@ (let ([page (let ([bin-gtk (gtk_hbox_new #f 0)] [label-gtk (gtk_label_new_with_mnemonic lbl)]) - (gtk_notebook_append_page gtk bin-gtk label-gtk) + (gtk_notebook_append_page notebook-gtk bin-gtk label-gtk) (gtk_widget_show bin-gtk) (make-page bin-gtk label-gtk))]) (set! pages (append pages (list page))) (when (null? (cdr pages)) (swap-in (page-bin-gtk (car pages))) (g_object_ref empty-bin-gtk) - (gtk_notebook_remove_page gtk 0)))) + (gtk_notebook_remove_page notebook-gtk 0)))) (define/private (do-delete i) (let ([page (list-ref pages i)]) @@ -159,11 +173,11 @@ (begin (install-empty-page) (set! pages null) - (gtk_notebook_set_current_page gtk 1) + (gtk_notebook_set_current_page notebook-gtk 1) (swap-in empty-bin-gtk)) - (gtk_notebook_set_current_page gtk (sub1 i))) - (gtk_notebook_set_current_page gtk (add1 i))))) - (gtk_notebook_remove_page gtk i) + (gtk_notebook_set_current_page notebook-gtk (sub1 i))) + (gtk_notebook_set_current_page notebook-gtk (add1 i))))) + (gtk_notebook_remove_page notebook-gtk i) (set! pages (remq page pages)))) (define/public (delete i) @@ -193,14 +207,14 @@ (define/override (gets-focus?) #t) (define/override (set-focus) - (gtk_widget_grab_focus gtk)) + (gtk_widget_grab_focus notebook-gtk)) (define/private (direct-set-selection i) - (gtk_notebook_set_current_page gtk i)) + (gtk_notebook_set_current_page notebook-gtk i)) (define/public (set-selection i) (atomically (set! callback-ok? #f) (direct-set-selection i) (set! callback-ok? #t))) (define/public (get-selection) - (gtk_notebook_get_current_page gtk)))) + (gtk_notebook_get_current_page notebook-gtk))))