From ba5c8d5b07b7e37322cd6f4fee2a0a193ac2b467 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Mon, 11 Sep 2006 13:47:27 +0000
Subject: [PATCH] Font size changes; prefs setting overrides default

svn: r4308
---
 .../syntax-browser/typesetter.ss              | 23 +++++++++++--------
 .../macro-debugger/syntax-browser/widget.ss   | 16 ++++++++++---
 2 files changed, 27 insertions(+), 12 deletions(-)

diff --git a/collects/macro-debugger/syntax-browser/typesetter.ss b/collects/macro-debugger/syntax-browser/typesetter.ss
index bfc136822d..f68074ca56 100644
--- a/collects/macro-debugger/syntax-browser/typesetter.ss
+++ b/collects/macro-debugger/syntax-browser/typesetter.ss
@@ -9,7 +9,8 @@
            "interfaces.ss"
            "util.ss")
 
-  (provide typesetter-for-text%)
+  (provide typesetter-for-text%
+           code-style)
 
   ;; typesetter-for-text%
   (define typesetter-for-text%
@@ -34,13 +35,6 @@
 
       (define output-port (make-text-port text end-anchor))
 
-      (define base-style
-        (send (send text get-style-list) find-named-style "Standard")
-        #;(let ([sd (make-object style-delta% 'change-family 'modern)])
-            (when (current-syntax-font-size)
-              (send sd set-delta 'change-size (current-syntax-font-size)))
-          sd))
-
       (define/private (get-start-position)
         (send text get-snip-position start-anchor))
 
@@ -70,7 +64,7 @@
         (let ([end (get-end-position)])
           (send text delete (sub1 end) end))
         (send text change-style
-              base-style
+              (code-style text)
               (get-start-position)
               (get-end-position))
         (send colorer apply-styles)
@@ -104,6 +98,17 @@
                               (send text get-snip-position end-anchor))
                         #t)))
 
+  ;; code-style : text<%> -> style<%>
+  (define (code-style text)
+    (let* ([style-list (send text get-style-list)]
+           [style (send style-list find-named-style "Standard")]
+           [font-size (current-syntax-font-size)])
+      (if font-size
+          (send style-list find-or-create-style
+                style
+                (make-object style-delta% 'change-size font-size))
+          style)))
+
   (define anchor-snip%
     (class snip%
       (define/override (copy)
diff --git a/collects/macro-debugger/syntax-browser/widget.ss b/collects/macro-debugger/syntax-browser/widget.ss
index 68cf4d1e28..507d1828a0 100644
--- a/collects/macro-debugger/syntax-browser/widget.ss
+++ b/collects/macro-debugger/syntax-browser/widget.ss
@@ -36,6 +36,17 @@
         (new syntax-controller%
              (properties-controller this)))
 
+      ;; FIXME: Why doesn't this work?
+      #;
+      (when (current-syntax-font-size)
+        (let* ([style-list (send -text get-style-list)]
+               [standard (send style-list find-named-style "Standard")])
+          (send style-list replace-named-style "Standard"
+                (send style-list find-or-create-style
+                      standard
+                      (make-object style-delta% 'change-size
+                                   (current-syntax-font-size))))))
+
       (send -text lock #t)
       (send -split-panel set-percentages 
             (let ([pp (pref:props-percentage)]) (list (- 1 pp) pp)))
@@ -125,9 +136,8 @@
                   (send new-colorer highlight-syntaxes hi-stxs hi-color)))))))
 
       (define/private (calculate-columns)
-        (define style-list (send -text get-style-list))
-        (define standard (send style-list find-named-style "Standard"))
-        (define char-width (send standard get-text-width (send -ecanvas get-dc)))
+        (define style (code-style -text))
+        (define char-width (send style get-text-width (send -ecanvas get-dc)))
         (define-values (canvas-w canvas-h) (send -ecanvas get-client-size))
         (sub1 (inexact->exact (floor (/ canvas-w char-width)))))