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

.

Browse Source 
original commit: 96e9864584080ea7c2223266a6f30c22b3318746
This commit is contained in:
Matthew Flatt 2003-05-21 22:04:42 +00:00
parent e7d905dc16
commit 995b292103
1 changed files with 15 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/mred/mred.ss
View File

@ -7207,6 +7207,13 @@
(let-values ([(w h d a) (send dc get-text-extent string font)]) (let-values ([(w h d a) (send dc get-text-extent string font)])
(values (inexact->exact w) (inexact->exact h)))]))) (values (inexact->exact w) (inexact->exact h)))])))
(define mswin-system #f)
(define mswin-default #f)
(define (look-for-font name)
(if (ormap (lambda (n) (string-ci=? name n)) (wx:get-face-list))
name
"MS San Serif"))
(define (get-family-builtin-face family) (define (get-family-builtin-face family)
(unless (memq family '(default decorative roman script swiss modern system symbol)) (unless (memq family '(default decorative roman script swiss modern system symbol))
(raise-type-error 'get-default-face "family symbol" family)) (raise-type-error 'get-default-face "family symbol" family))
@ -7223,7 +7230,14 @@
[(symbol) "-adobe-symbol"])] [(symbol) "-adobe-symbol"])]
[(windows) [(windows)
(case family (case family
[(system) "MS Sans Serif"] [(system)
(unless mswin-system
(set! mswin-system (look-for-font "Tahoma")))
mswin-system]
[(default)
(unless mswin-default
(set! mswin-default (look-for-font "Microsoft Sans Serif")))
mswin-default]
[(default) "MS Sans Serif"] [(default) "MS Sans Serif"]
[(roman) "Times New Roman"] [(roman) "Times New Roman"]
[(decorative) "Arial"] [(decorative) "Arial"]