diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt index 586e34cf..b847499e 100644 --- a/collects/mred/private/wx/gtk/canvas.rkt +++ b/collects/mred/private/wx/gtk/canvas.rkt @@ -179,7 +179,7 @@ [gl-config #f]) (inherit get-gtk set-size get-size get-client-size - on-size register-as-child get-top-win + on-size get-top-win set-auto-size adjust-client-delta) (define is-combo? (memq 'combo style)) @@ -347,12 +347,9 @@ (define/public (queue-backing-flush) (gtk_widget_queue_draw client-gtk)) - (define/public (reset-child-dcs) + (define/override (reset-child-dcs) (when (dc . is-a? . dc%) (reset-dc))) - (define/override (maybe-register-as-child parent on?) - (register-as-child parent on?) - (when on? (reset-child-dcs))) (send dc start-backing-retained) diff --git a/collects/mred/private/wx/gtk/frame.rkt b/collects/mred/private/wx/gtk/frame.rkt index 36d2a531..64b1e7e4 100644 --- a/collects/mred/private/wx/gtk/frame.rkt +++ b/collects/mred/private/wx/gtk/frame.rkt @@ -228,6 +228,15 @@ "eventspace has been shutdown")) (super show on?)) + (define saved-child #f) + (define/override (register-child child on?) + (unless on? (error 'register-child-in-frame "did not expect #f")) + (unless (or (not saved-child) (eq? child saved-child)) + (error 'register-child-in-frame "expected only one child")) + (set! saved-child child)) + (define/override (register-child-in-parent on?) + (void)) + (define/override (direct-show on?) (super direct-show on?) (register-frame-shown this on?)) diff --git a/collects/mred/private/wx/gtk/panel.rkt b/collects/mred/private/wx/gtk/panel.rkt index 0fd06faa..5a54ed8b 100644 --- a/collects/mred/private/wx/gtk/panel.rkt +++ b/collects/mred/private/wx/gtk/panel.rkt @@ -17,7 +17,6 @@ (define (panel-mixin %) (class % - (inherit register-as-child) (define lbl-pos 'horizontal) (define children null) @@ -27,7 +26,7 @@ (define/public (get-label-position) lbl-pos) (define/public (set-label-position pos) (set! lbl-pos pos)) - (define/public (reset-child-dcs) + (define/override (reset-child-dcs) (when (pair? children) (for ([child (in-list children)]) (send child reset-child-dcs)))) @@ -35,10 +34,6 @@ (define/override (set-size x y w h) (super set-size x y w h) (reset-child-dcs)) - - (define/override (maybe-register-as-child parent on?) - (register-as-child parent on?) - (when on? (reset-child-dcs))) (define/override (register-child child on?) (let ([now-on? (and (memq child children) #t)]) diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt index 1bf5c8b2..e6da632d 100644 --- a/collects/mred/private/wx/gtk/window.rkt +++ b/collects/mred/private/wx/gtk/window.rkt @@ -3,6 +3,7 @@ racket/class ffi/unsafe/atomic "../../syntax.rkt" + "../../lock.rkt" "../common/event.rkt" "../common/freeze.rkt" "../common/queue.rkt" @@ -370,13 +371,17 @@ (define shown? #f) (define/public (direct-show on?) - (if on? - (gtk_widget_show gtk) - (gtk_widget_hide gtk)) - (set! shown? (and on? #t)) - (maybe-register-as-child parent on?)) + (as-entry + (lambda () + (if on? + (gtk_widget_show gtk) + (gtk_widget_hide gtk)) + (set! shown? (and on? #t)) + (register-child-in-parent on?))) + (when on? (reset-child-dcs))) (define/public (show on?) (direct-show on?)) + (define/public (reset-child-dcs) (void)) (define/public (is-shown?) shown?) (define/public (is-shown-to-root?) (and shown? @@ -454,12 +459,11 @@ (define/public (on-size w h) (void)) - (define/public (maybe-register-as-child parent on?) - (void)) - (define/public (register-as-child parent on?) - (send parent register-child this on?)) (define/public (register-child child on?) (void)) + (define/public (register-child-in-parent on?) + (when parent + (send parent register-child this on?))) (def/public-unimplemented on-drop-file) (def/public-unimplemented get-handle)