diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/mrcontainer.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/mrcontainer.rkt index fb137f74ad..d46841232e 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/mrcontainer.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/mrcontainer.rkt @@ -40,7 +40,8 @@ (define-local-member-name has-wx-child? - adopt-wx-child) + adopt-wx-child + forget-wx-child) (define (make-container% %) ; % implements area<%> (class* % (area-container<%> internal-container<%>) @@ -156,14 +157,14 @@ is-shown? show) (define/public (reparent new-parent) - (check-container-parent '(subwindow<%> reparent) new-parent) + (check-container-parent '(method subwindow<%> reparent) new-parent) (unless (as-entry (lambda () (let ([p1 (send (mred->wx this) get-top-level)] [p2 (send (mred->wx new-parent) get-top-level)]) (eq? (send p1 get-eventspace) (send p1 get-eventspace))))) (raise-arguments-error - (who->name '(subwindow<%> reparent)) + (who->name '(method subwindow<%> reparent)) "current parent's eventspace is not the same as the eventspace of the new parent" "subwindow" this "new parent" new-parent)) @@ -171,7 +172,7 @@ (when p (when (eq? p this) (raise-arguments-error - (who->name '(subwindow<%> reparent)) + (who->name '(method subwindow<%> reparent)) (if (eq? new-parent this) "cannot set parent to self" "cannot set parent to a descedant") @@ -192,6 +193,7 @@ (or (eq? p wx) (loop (send p get-parent))))) ;; Ok --- really reparent: + (send wx ensure-forgotten) (send new-parent adopt-wx-child wx) (set-parent new-parent)))))) (when added? diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wxpanel.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wxpanel.rkt index 1fd00cfdc7..e37bc346cc 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wxpanel.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wxpanel.rkt @@ -144,8 +144,15 @@ (set! hidden-child (car children)) (let ([i (send hidden-child get-info)]) (set-min-width (child-info-x-min i)) - (set-min-height (child-info-y-min i))))] + (set-min-height (child-info-y-min i))))]) + + (override* + [ensure-forgotten (lambda () + (for ([c (in-list children)]) + (send c ensure-forgotten)) + (super ensure-forgotten))]) + (public* [border (case-lambda [() curr-border] diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt index 037d983f0e..090cc0bba0 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt @@ -226,6 +226,12 @@ (when (zero? seq-count) (delay-updates #f)))] + [forget-child + (lambda (child) + (unless (hash-ref show-ht child #t) + (send child show #f)) + (hash-remove! show-ht child))] + [show-child (lambda (child show?) (if perform-updates? diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wxwindow.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wxwindow.rkt index af73db10bd..0d3a9dd575 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wxwindow.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wxwindow.rkt @@ -92,7 +92,12 @@ (is-a? window wx:dialog%)) (set! top-level window)] [else (loop (send window get-parent))]))) - top-level)]) + top-level)] + [ensure-forgotten + (lambda () + ;; This value or its ancestor is going to be adopted elsewhere, + ;; so really forget it, make sure it's hidden, etc. + (send (get-top-level) forget-child this))]) (public* [really-show (lambda (on?)