suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

racket/gui: fix problem with reparent and container sequences

Browse Source 
In a container sequence, hides and shows are delayed, but
reparenting needs the hide operation to really complete.
This commit is contained in:
Matthew Flatt 2013-08-21 09:20:12 -06:00
parent 3201f1330a
commit 76aa80c0e9
4 changed files with 26 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/gui-pkgs/gui-lib/mred/private/mrcontainer.rkt
View File

@ -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?

9
pkgs/gui-pkgs/gui-lib/mred/private/wxpanel.rkt
View File

@ -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]

6
pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt
View File

@ -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?

7
pkgs/gui-pkgs/gui-lib/mred/private/wxwindow.rkt
View File

@ -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?)