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

.

Browse Source 
original commit: 65ca42ace367a2704f0ddd35af21b908d41db0f8
This commit is contained in:
Matthew Flatt 2003-05-09 16:44:10 +00:00
parent c7499274c5
commit 24fccbc8d7
1 changed files with 78 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/mred/mred.ss
View File

@ -6675,8 +6675,6 @@
(check-top-level-parent/false 'get-font-from-user parent)
(check-instance 'get-font-from-user wx:font% 'font% #t font)
(check-style 'get-font-from-user #f null style)
(if (eq? (system-type) 'windows-no-more)
(wx:get-font-from-user message (and parent (mred->wx parent)) font)
(letrec ([ok? #f]
[f (make-object dialog% "Choose Font" parent 500 300)]
[refresh-sample (lambda (b e) (let ([f (get-font)])
@ -6685,7 +6683,7 @@
(let ([s (send (send edit get-style-list) find-named-style "Standard")])
(send s set-delta (font->delta f))))))]
[p (make-object horizontal-pane% f)]
[face (make-object list-box% "Font:"
[face (make-object list-box% #f
(let ([l (wx:get-face-list)])
(if (memq (system-type) '(macos macosx))
(sort l (lambda (a b)
@ -6750,10 +6748,11 @@
(send size set-value (send font get-point-size)))
(refresh-sample (void) (void)))])
(send bp set-alignment 'right 'center)
(send face min-width (max 200 (let-values ([(w h) (send face get-graphical-min-size)]) w)))
(reset-font font)
(send f center)
(send f show #t)
(and ok? (get-font))))]))
(and ok? (get-font)))]))
(define (play-sound f async?)
(if (not (eq? (system-type) 'unix))