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

improved the container default placing scheme to eliminate redundant panels

Browse Source 
original commit: 8d520ec0510a0678457fb6e584d4a442f85d0a68
This commit is contained in:
Robby Findler 1997-10-16 20:40:13 +00:00
parent e8295ee015
commit 25d4ca5c19
1 changed files with 12 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/mred/prefs.ss
View File

@ -333,14 +333,13 @@
(set-preference pref (bool->pref (send command checked?))))] (set-preference pref (bool->pref (send command checked?))))]
[pref-value (get-preference pref)] [pref-value (get-preference pref)]
[initial-value (pref->bool pref-value)] [initial-value (pref->bool pref-value)]
[h (make-object mred:horizontal-panel% main)] [c (make-object mred:check-box% main callback title)])
[c (make-object mred:check-box% h callback title)]
[p (make-object mred:horizontal-panel% h)])
(send c set-value initial-value) (send c set-value initial-value)
(add-preference-callback pref (add-preference-callback pref
(lambda (p v) (lambda (p v)
(send c set-value (pref->bool v))))))] (send c set-value (pref->bool v))))))]
[id (lambda (x) x)]) [id (lambda (x) x)])
(send main minor-align-left)
(make-check 'mred:highlight-parens "Highlight between matching parens?" id id) (make-check 'mred:highlight-parens "Highlight between matching parens?" id id)
(make-check 'mred:fixup-parens "Correct parens?" id id) (make-check 'mred:fixup-parens "Correct parens?" id id)
(make-check 'mred:paren-match "Flash paren match?" id id) (make-check 'mred:paren-match "Flash paren match?" id id)
@ -505,23 +504,20 @@
(ppanel-panel (car (list-tail ppanels (sub1 (length ppanels)))))))])) (ppanel-panel (car (list-tail ppanels (sub1 (length ppanels)))))))]))
'() "Preferences")] '() "Preferences")]
[panel (make-object mred:vertical-panel% frame)] [panel (make-object mred:vertical-panel% frame)]
[top-panel (make-object mred:horizontal-panel% panel)]
[single-panel (make-object mred:single-panel% panel -1 -1 -1 -1 wx:const-border)]
[bottom-panel (make-object mred:horizontal-panel% panel)]
[popup-callback [popup-callback
(lambda (choice command-event) (lambda (choice command-event)
(send single-panel active-child (send single-panel active-child
(ppanel-panel (list-ref ppanels (send command-event get-command-int)))))] (ppanel-panel (list-ref ppanels (send command-event get-command-int)))))]
[make-popup-menu [make-popup-menu
(lambda () (lambda ()
(let ([menu (make-object mred:choice% top-panel popup-callback (let ([menu (make-object mred:choice% panel popup-callback
"Category" -1 -1 -1 -1 "Category" -1 -1 -1 -1
(map ppanel-title ppanels))]) (map ppanel-title ppanels))])
(send menu stretchable-in-x #f) (send menu stretchable-in-x #f)
menu))] menu))]
[top-left (make-object mred:vertical-panel% top-panel)]
[popup-menu (make-popup-menu)] [popup-menu (make-popup-menu)]
[top-right (make-object mred:vertical-panel% top-panel)] [single-panel (make-object mred:single-panel% panel -1 -1 -1 -1 wx:const-border)]
[bottom-panel (make-object mred:horizontal-panel% panel)]
[ensure-constructed [ensure-constructed
(lambda () (lambda ()
(for-each (lambda (ppanel) (for-each (lambda (ppanel)
@ -540,20 +536,22 @@
(let ([new-popup (make-popup-menu)]) (let ([new-popup (make-popup-menu)])
(send new-popup set-selection (send popup-menu get-selection)) (send new-popup set-selection (send popup-menu get-selection))
(set! popup-menu new-popup) (set! popup-menu new-popup)
(send top-panel change-children (send panel change-children
(lambda (l) (list top-left new-popup top-right)))))] (lambda (l) (list new-popup
single-panel
bottom-panel)))))]
[ok-callback (lambda args [ok-callback (lambda args
(save-user-preferences) (save-user-preferences)
(hide-preferences-dialog))] (hide-preferences-dialog))]
[_1 (make-object mred:panel% bottom-panel)]
[ok-button (make-object mred:button% bottom-panel ok-callback "OK")] [ok-button (make-object mred:button% bottom-panel ok-callback "OK")]
[cancel-callback (lambda args [cancel-callback (lambda args
(hide-preferences-dialog) (hide-preferences-dialog)
(read-user-preferences))] (read-user-preferences))]
[cancel-button (make-object mred:button% bottom-panel cancel-callback "Cancel")]) [cancel-button (make-object mred:button% bottom-panel cancel-callback "Cancel")])
(send ok-button user-min-width (send cancel-button get-width)) (send ok-button user-min-width (send cancel-button get-width))
(send bottom-panel stretchable-in-y #f) (send* bottom-panel
(send top-panel stretchable-in-y #f) (stretchable-in-y #f)
(major-align-right))
(ensure-constructed) (ensure-constructed)
(send popup-menu set-selection 0) (send popup-menu set-selection 0)
(send frame show #t) (send frame show #t)