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

.

Browse Source 
original commit: 65b87dc5d048e0b57a22c132fb044c9fabd3dd2d
This commit is contained in:
Matthew Flatt 2003-10-11 13:42:55 +00:00
parent 50b5d3d094
commit b4b0776dc2
2 changed files with 14 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/mred/mred.ss
View File

@ -541,7 +541,7 @@
(define (make-top-container% base% dlg?) (define (make-top-container% base% dlg?)
(class100 (wx-make-container% (wx-make-window% base% #t)) (parent . args) (class100 (wx-make-container% (wx-make-window% base% #t)) (parent . args)
(inherit get-x get-y get-width get-height set-size (inherit get-x get-y get-width get-height set-size
get-client-size is-shown? on-close) get-client-size is-shown? on-close enforce-size)
(rename [super-show show] [super-move move] [super-center center] (rename [super-show show] [super-move move] [super-center center]
[super-on-size on-size] [super-on-size on-size]
[super-enable enable] [super-enable enable]
@ -714,7 +714,9 @@
[(< frame-h min-h) min-h] [(< frame-h min-h) min-h]
[(and (> frame-h min-h) (not (child-info-y-stretch panel-info))) min-h] [(and (> frame-h min-h) (not (child-info-y-stretch panel-info))) min-h]
[else frame-h])]) [else frame-h])])
(values new-w new-h)))))] (values new-w new-h
min-w min-h
(child-info-x-stretch panel-info) (child-info-y-stretch panel-info))))))]
[set-panel-size [set-panel-size
(lambda () (lambda ()
@ -741,11 +743,14 @@
(unless already-trying? (unless already-trying?
(let ([new-width (get-width)] (let ([new-width (get-width)]
[new-height (get-height)]) [new-height (get-height)])
(let-values ([(correct-w correct-h) (correct-size new-width new-height)]) (let-values ([(correct-w correct-h min-w min-h sx? sy?) (correct-size new-width new-height)])
(cond (cond
[(and (= new-width correct-w) (= new-height correct-h)) [(and (= new-width correct-w) (= new-height correct-h))
;; Good size; do panel ;; Good size; do panel
(set! was-bad? #f) (set! was-bad? #f)
(enforce-size min-w min-h
(if sx? -1 min-w) (if sy? -1 min-h)
1 1)
(set-panel-size)] (set-panel-size)]
[(and (= last-width correct-w) (= last-height correct-h) [(and (= last-width correct-w) (= last-height correct-h)
was-bad?) was-bad?)
@ -757,7 +762,11 @@
(set! last-width correct-w) (set! last-width correct-w)
(set! last-height correct-h) (set! last-height correct-h)
(set! already-trying? #t) (set! already-trying? #t)
(enforce-size -1 -1 -1 -1 1 1)
(set-size -1 -1 correct-w correct-h) (set-size -1 -1 correct-w correct-h)
(enforce-size min-w min-h
(if sx? -1 min-w) (if sy? -1 min-h)
1 1)
(set! already-trying? #f) (set! already-trying? #f)
(resized)]))))))]) (resized)]))))))])

2
collects/mred/private/kernel.ss
View File

@ -490,6 +490,7 @@
on-toolbar-click on-toolbar-click
on-menu-click on-menu-click
on-menu-command on-menu-command
enforce-size
on-close on-close
on-activate on-activate
designate-root-frame designate-root-frame
@ -1105,6 +1106,7 @@
on-size on-size
on-set-focus on-set-focus
on-kill-focus on-kill-focus
enforce-size
on-close on-close
on-activate) on-activate)
(define-class radio-box% item% #f (define-class radio-box% item% #f