racket/gui: fix reparent' with a pane%' target

original commit: 6afc9d5e8c354dbe444e6f8bf16c6a87c4bc7191
This commit is contained in:
Matthew Flatt 2012-04-03 18:01:30 -06:00
parent 2d667d8eac
commit 15cf494c3e
2 changed files with 6 additions and 2 deletions

View File

@ -55,7 +55,8 @@
[get-x (lambda () pos-x)] [get-x (lambda () pos-x)]
[get-y (lambda () pos-y)] [get-y (lambda () pos-y)]
[get-width (lambda () width)] [get-width (lambda () width)]
[get-height (lambda () height)]) [get-height (lambda () height)]
[adopt-child (lambda (c) (send (get-parent) adopt-child c))])
(sequence (super-init)))) (sequence (super-init))))
(define tab-h-border (if (eq? (system-type) 'unix) (define tab-h-border (if (eq? (system-type) 'unix)

View File

@ -519,7 +519,10 @@
(let ([v (send c get-selection)]) (let ([v (send c get-selection)])
(when (positive? v) (when (positive? v)
(define f (new frame% [label "New Parent"])) (define f (new frame% [label "New Parent"]))
(send (list-ref items (sub1 v)) reparent f) (define p (if (zero? (random 2))
(new vertical-pane% [parent f])
f))
(send (list-ref items (sub1 v)) reparent p)
(send f show #t) (send f show #t)
(send c set-selection 0))))) (send c set-selection 0)))))
(cons (make-object popup-test-canvas% (cons (make-object popup-test-canvas%