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

.

Browse Source 
original commit: e0108f44c3208a7be19e33b1da46b0b651f54b36
This commit is contained in:
Matthew Flatt 2005-02-10 14:55:26 +00:00
parent 6d2e94ca84
commit 0836d7a841
2 changed files with 4 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/mred/private/moredialogs.ss
View File

@ -153,10 +153,9 @@
(let* ([f (make-object dialog% title parent box-width)]
[ok? #f]
[done (lambda (?) (lambda (b e) (set! ok? ?) (send f show #f)))])
(send f set-label-position 'vertical)
(let ([t (make-object text-field% message f (lambda (t e) (when (eq? (send e get-event-type) 'text-field-enter)
((done #t) #f #f)))
init-val (cons 'single style))]
init-val (list* 'single 'vertical-label style))]
[p (make-object horizontal-pane% f)])
(send p set-alignment 'right 'center)
(send f stretchable-height #f)
@ -191,13 +190,12 @@
[update-ok (lambda (l) (send ok-button enable (not (null? (send l get-selections)))))]
[ok? #f]
[done (lambda (?) (lambda (b e) (set! ok? ?) (send f show #f)))])
(send f set-label-position 'vertical)
(let ([l (make-object list-box% message choices f
(lambda (l e)
(update-ok l)
(when (eq? (send e get-event-type) 'list-box-dclick)
((done #t) #f #f)))
style)]
(cons 'vertical-label style))]
[p (make-object horizontal-pane% f)])
(for-each (lambda (i)
(when (>= i (send l get-number))

14
collects/mred/private/mrcontainer.ss
View File

@ -128,21 +128,11 @@
(unless (eq? alignment no-val) (set-alignment . alignment)))))
(define area-container-window<%>
(interface (window<%> area-container<%>)
set-control-font get-control-font
set-label-font get-label-font
set-label-position get-label-position))
(interface (window<%> area-container<%>)))
(define (make-area-container-window% %) ; % implements window<%> (and area-container<%>)
(class100* % (area-container-window<%>) (mk-wx get-wx-pan mismatches label parent cursor)
(private-field [get-wx-panel get-wx-pan])
(public
[get-control-font (entry-point (lambda () (send (get-wx-panel) get-control-font)))]
[set-control-font (entry-point (lambda (x) (send (get-wx-panel) set-control-font x)))]
[get-label-font (entry-point (lambda () (send (get-wx-panel) get-label-font)))]
[set-label-font (entry-point (lambda (x) (send (get-wx-panel) set-label-font x)))]
[get-label-position (entry-point (lambda () (send (get-wx-panel) get-label-position)))]
[set-label-position (entry-point (lambda (x) (send (get-wx-panel) set-label-position x)))])
(private-field [get-wx-panel get-wx-pan])
(sequence
(super-init mk-wx get-wx-panel mismatches label parent cursor)))))