diff --git a/gui-lib/mred/private/wx/gtk/canvas.rkt b/gui-lib/mred/private/wx/gtk/canvas.rkt index e09ef4b9..c9d2b71b 100644 --- a/gui-lib/mred/private/wx/gtk/canvas.rkt +++ b/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)))) + (request-flush-delay (get-flush-window) transparent?)) (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)) @@ -611,7 +615,7 @@ ;; called atomically (unless for-gl? (gtk_widget_queue_draw client-gtk))) - + (define/override (reset-child-dcs) (when (dc . is-a? . dc%) (reset-dc))) @@ -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")) diff --git a/gui-lib/mred/private/wx/gtk/dc.rkt b/gui-lib/mred/private/wx/gtk/dc.rkt index ab42364e..42e159b7 100644 --- a/gui-lib/mred/private/wx/gtk/dc.rkt +++ b/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)) - (void))) + (request-flush-delay (send canvas get-flush-window) is-transparent?)) (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 diff --git a/gui-lib/mred/private/wx/gtk/panel.rkt b/gui-lib/mred/private/wx/gtk/panel.rkt index ec197c0e..fb9fdec8 100644 --- a/gui-lib/mred/private/wx/gtk/panel.rkt +++ b/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) diff --git a/gui-lib/mred/private/wx/gtk/tab-panel.rkt b/gui-lib/mred/private/wx/gtk/tab-panel.rkt index 5c434a16..a7c1bbe3 100644 --- a/gui-lib/mred/private/wx/gtk/tab-panel.rkt +++ b/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)) diff --git a/gui-lib/mred/private/wx/gtk/window.rkt b/gui-lib/mred/private/wx/gtk/window.rkt index 54112f3f..a4e1831f 100644 --- a/gui-lib/mred/private/wx/gtk/window.rkt +++ b/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)))