From 312456d1bb861163dfb8fbd82f0eb735b65587c8 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 19 Aug 2015 08:18:20 -0600 Subject: [PATCH] GTK+ 3: treat `combo-field%` canvas like transparent canvases The canvas part of a `combo-field%` needs to be non-native (in the GdkWindow sense), so treat it like a transparent canvas. --- gui-lib/mred/private/wx/gtk/canvas.rkt | 19 ++++++++++--------- gui-lib/mred/private/wx/gtk/dc.rkt | 16 ++++++++-------- gui-lib/mred/private/wx/gtk/window.rkt | 4 ++-- 3 files changed, 20 insertions(+), 19 deletions(-) diff --git a/gui-lib/mred/private/wx/gtk/canvas.rkt b/gui-lib/mred/private/wx/gtk/canvas.rkt index c9d2b71b..f9ab2656 100644 --- a/gui-lib/mred/private/wx/gtk/canvas.rkt +++ b/gui-lib/mred/private/wx/gtk/canvas.rkt @@ -284,6 +284,12 @@ (define is-combo? (memq 'combo style)) (define has-border? (or (memq 'border style) (memq 'control-border style))) + (define for-gl? (memq 'gl style)) + (define transparent? + (and (memq 'transparent style) + (not for-gl?))) ; 'transparent is incompatible with 'gl + + (define transparentish? (or transparent? is-combo?)) (define margin (if has-border? 1 0)) @@ -385,17 +391,12 @@ (let ([client-gtk (as-gtk-allocation (gtk_drawing_area_new))]) (values client-gtk client-gtk client-gtk #f #f #f #f #f #f 0))]))) - (define for-gl? (memq 'gl style)) (when for-gl? (prepare-widget-gl-context client-gtk gl-config) (gtk_widget_set_double_buffered client-gtk #f)) (define dc #f) - (define transparent? - (and (memq 'transparent style) - (not (memq 'gl style)))) ; 'transparent is incompatible with 'gl - (super-new [parent parent] [gtk gtk] [client-gtk client-gtk] @@ -425,7 +426,7 @@ (reset-auto-scroll)) (on-size)) - (set! dc (new dc% [canvas this] [transparent? transparent?])) + (set! dc (new dc% [canvas this] [transparentish? transparentish?])) (gtk_widget_realize gtk) (gtk_widget_realize client-gtk) @@ -475,7 +476,7 @@ (when (and gtk3? is-combo?) ;; Needed for sizing: - (gtk_combo_box_append_text gtk (make-string 10 #\X))) + (gtk_combo_box_append_text gtk (make-string 8 #\X))) (set-auto-size) (adjust-client-delta (+ (* 2 margin) @@ -550,7 +551,7 @@ ;; are defined by `canvas-mixin' from ../common/canvas-mixin (define/public (queue-paint) (void)) (define/public (request-canvas-flush-delay) - (request-flush-delay (get-flush-window) transparent?)) + (request-flush-delay (get-flush-window) transparentish?)) (define/public (cancel-canvas-flush-delay req) (cancel-flush-delay req)) (define/public (queue-canvas-refresh-event thunk) @@ -593,7 +594,7 @@ ;; 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))) + (when transparentish? (unrealize))) (define/public (begin-refresh-sequence) (send dc suspend-flush)) diff --git a/gui-lib/mred/private/wx/gtk/dc.rkt b/gui-lib/mred/private/wx/gtk/dc.rkt index 42e159b7..49cc1222 100644 --- a/gui-lib/mred/private/wx/gtk/dc.rkt +++ b/gui-lib/mred/private/wx/gtk/dc.rkt @@ -178,13 +178,13 @@ (define dc% (class backing-dc% (init [(cnvs canvas)] - transparent?) + transparentish?) (inherit end-delay) (define canvas cnvs) (define gl #f) - (define is-transparent? transparent?) + (define is-transparentish? transparentish?) - (super-new [transparent? transparent?]) + (super-new [transparent? transparentish?]) (define/override (get-gl-context) (or gl @@ -194,11 +194,11 @@ (define/override (make-backing-bitmap w h) (cond - [(and (eq? 'unix (system-type)) - (send canvas get-canvas-background)) + [(and (not is-transparentish?) + (eq? 'unix (system-type))) (make-object x11-bitmap% w h (send canvas get-client-gtk))] - [(and (eq? 'windows (system-type)) - (send canvas get-canvas-background)) + [(and (not is-transparentish?) + (eq? 'windows (system-type))) (make-object win32-bitmap% w h (widget-window (send canvas get-client-gtk)))] [else ;; Transparent canvas always use a Cairo bitmap: @@ -223,7 +223,7 @@ (send canvas flush)) (define/override (request-delay) - (request-flush-delay (send canvas get-flush-window) is-transparent?)) + (request-flush-delay (send canvas get-flush-window) is-transparentish?)) (define/override (cancel-delay req) (cancel-flush-delay req)))) diff --git a/gui-lib/mred/private/wx/gtk/window.rkt b/gui-lib/mred/private/wx/gtk/window.rkt index a4e1831f..9ae6f6c0 100644 --- a/gui-lib/mred/private/wx/gtk/window.rkt +++ b/gui-lib/mred/private/wx/gtk/window.rkt @@ -877,7 +877,7 @@ (for ([i (in-range (mcdr win-box))]) (gdk_window_thaw_updates win))))) -(define (request-flush-delay win-box transparent?) +(define (request-flush-delay win-box transparentish?) (do-request-flush-delay win-box (lambda (win-box) @@ -891,7 +891,7 @@ ;; 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?) + (unless (and transparentish? gtk3?) (gdk_window_ensure_native win)) (begin (gdk_window_freeze_updates win)