racket/collects/mred/private/wxcontainer.rkt
2010-04-27 16:50:15 -06:00

41 lines
1.3 KiB
Racket

(module wxcontainer mzscheme
(require mzlib/class
mzlib/class100
mzlib/list
(prefix wx: "kernel.ss")
"lock.ss"
"helper.ss"
"wx.ss")
(provide (protect make-container-glue%
wx-make-container%))
(define (make-container-glue% %)
(class100 % (mr prxy . args)
(inherit do-place-children do-get-graphical-min-size get-children-info get-hidden-child)
(private-field [mred mr][proxy prxy])
(override
[get-graphical-min-size (lambda ()
(cond
[mred (let ([info
(map (lambda (i)
(list (child-info-x-min i) (child-info-y-min i)
(child-info-x-stretch i) (child-info-y-stretch i)))
(get-children-info))])
(let-values ([(w h) (as-exit (lambda () (send mred container-size
(if (get-hidden-child)
(cdr info) ; hidden child is first
info))))])
(list w h)))]
[else (do-get-graphical-min-size)]))]
[place-children (lambda (l w h)
(cond
[(null? l) null]
[mred (as-exit (lambda () (send mred place-children l w h)))]
[else (do-place-children l w h)]))])
(sequence
(apply super-init mred proxy args))))
;; make-container% - for panels and top-level windows
(define (wx-make-container% %) %))