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

.

Browse Source 
original commit: 43e1d0c3ca0e355db6aeff81c50564b0389b0307
This commit is contained in:
Matthew Flatt 2000-02-20 04:28:05 +00:00
parent c36e157147
commit 6abbf695a5
1 changed files with 13 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/mred/wrap/mred.ss
View File

@ -4766,18 +4766,18 @@
(send blue get-value)))))]))
(define get-font-from-user
(if (eq? (system-type) 'windows)
wx:get-font-from-user
(case-lambda
[() (get-font-from-user #f #f #f null)]
[(message) (get-font-from-user message #f #f null)]
[(message parent) (get-font-from-user message parent #f null)]
[(message parent font) (get-font-from-user message parent font null)]
[(message parent font style)
(check-string/false 'get-font-from-user message)
(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)
(case-lambda
[() (get-font-from-user #f #f #f null)]
[(message) (get-font-from-user message #f #f null)]
[(message parent) (get-font-from-user message parent #f null)]
[(message parent font) (get-font-from-user message parent font null)]
[(message parent font style)
(check-string/false 'get-font-from-user message)
(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)
(wx:get-font-from-user message (and parent (mred->wx parent)) font style)
(letrec ([ok? #f]
[f (make-object dialog% "Choose Font" parent 500 300)]
[refresh-sample (lambda (b e) (let ([f (get-font)])
@ -4816,7 +4816,7 @@
(refresh-sample (void) (void))
(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))