From 60d4eaf2279697012f4f07e720cedb0b2038b4a9 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 16 Sep 2010 07:18:46 -0600
Subject: [PATCH] centralize default-font configuration

---
 collects/mred/private/gdi.rkt     | 71 +------------------------------
 collects/racket/draw/font-dir.rkt |  8 ++--
 collects/racket/draw/font.rkt     |  2 +-
 3 files changed, 7 insertions(+), 74 deletions(-)

diff --git a/collects/mred/private/gdi.rkt b/collects/mred/private/gdi.rkt
index 659e38efc3..01bcbf9ce4 100644
--- a/collects/mred/private/gdi.rkt
+++ b/collects/mred/private/gdi.rkt
@@ -224,78 +224,11 @@
      [() (get-face-list 'all)]
      [(a) (sort (wx:get-face-list a) compare-face-names)]))
 
-  (define x-has-xft? 'unknown)
-  (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)
     (unless (memq family '(default decorative roman script swiss modern system symbol))
       (raise-type-error 'get-family-builtin-face "family symbol" family))
-    (case (system-type)
-      [(unix)
-       ;; Detect Xft by looking for a font with a space in front of its name:
-       (when (eq? x-has-xft? 'unknown)
-	 (set! x-has-xft? (ormap (lambda (s) (regexp-match #rx"^ " s)) (wx:get-face-list))))
-       (if x-has-xft?
-	   (case family
-	     [(system) " Sans"]
-	     [(default) " Sans"]
-	     [(roman) " Serif"]
-	     [(decorative) " Nimbus Sans L"]
-	     [(modern) " Monospace"]
-	     [(swiss) " Nimbus Sans L"]
-	     [(script) " URW Chancery L"]
-	     [(symbol) " Standard Symbols L,Nimbus Sans L"])
-	   (case family
-	     [(system) "-b&h-lucida"]
-	     [(default) "-b&h-lucida"]
-	     [(roman) "-adobe-times"]
-	     [(decorative) "-adobe-helvetica"]
-	     [(modern) "-adobe-courier"]
-	     [(swiss) "-b&h-lucida"]
-	     [(script) "-itc-zapfchancery"]
-	     [(symbol) "-adobe-symbol"]))]
-      [(windows)
-       (case family
-	 [(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"]
-	 [(roman) "Times New Roman"]
-	 [(decorative) "Arial"]
-	 [(modern) "Courier New"]
-	 [(swiss) "Arial"]
-	 [(script) "Arial"]
-	 [(symbol) "Symbol"])]
-      [(macos)
-       (case family
-	 [(system) "systemfont"]
-	 [(default) "applicationfont"]
-	 [(roman) "Times"]
-	 [(decorative) "Geneva"]
-	 [(modern) "Monaco"]
-	 [(swiss) "Helvetica"]
-	 [(script) "Zaph Chancery"]
-	 [(symbol) "Symbol"])]
-      [(macosx)
-       (case family
-	 [(system) "systemfont"]
-	 [(default) "applicationfont"]
-	 [(roman) "Times"]
-	 [(decorative) "Arial"]
-	 [(modern) "Courier New"]
-	 [(swiss) "Helvetica"]
-	 [(script) "Apple Chancery"]
-	 [(symbol) "Symbol"])]))
+    (let ([id (send wx:the-font-name-directory find-family-default-font-id family)])
+      (send wx:the-font-name-directory get-screen-name id 'normal 'normal)))
 
   (define small-delta (case (system-type)
 			[(windows) 0]
diff --git a/collects/racket/draw/font-dir.rkt b/collects/racket/draw/font-dir.rkt
index 11df1891ed..64e2a8178b 100644
--- a/collects/racket/draw/font-dir.rkt
+++ b/collects/racket/draw/font-dir.rkt
@@ -46,7 +46,7 @@
                              [family-symbol? family])
       (hash-ref table (cons string family) 0))
 
-    (define (default-font s)
+    (define/private (default-font s)
       (case s
         [(modern) "Monospace"]
         [(roman) "Serif"]
@@ -67,9 +67,9 @@
          [(symbol? s) (default-font s)]
          [else "Serif"])))
 
-    (def/public (get-screen-script-name [exact-integer? id]
-                                        [weight-symbol? w]
-                                        [style-symbol? s])
+    (def/public (get-screen-name [exact-integer? id]
+                                 [weight-symbol? w]
+                                 [style-symbol? s])
       (let ([s (or (hash-ref screen-table (list id w s) #f)
                    (hash-ref reverse-table id #f))])
         (cond
diff --git a/collects/racket/draw/font.rkt b/collects/racket/draw/font.rkt
index ca187ac1c5..4616dacc0e 100644
--- a/collects/racket/draw/font.rkt
+++ b/collects/racket/draw/font.rkt
@@ -71,7 +71,7 @@
                                                        weight
                                                        style)
                                                  (send the-font-name-directory
-                                                       get-screen-script-name
+                                                       get-screen-name
                                                        id
                                                        weight
                                                        style)))