DrRacket now saves the font size preference on a per-monitor-configuration basis

collects/drracket/private/font.rkt

@@ -30,10 +30,8 @@
                                (parent options-panel)
                                (label (string-constant font-size))))
        (define (adjust-font-size f)
-         (preferences:set
+         (editor:set-current-preferred-font-size
-          'framework:standard-style-list:font-size
+          (f (editor:get-current-preferred-font-size))))
-          (f (preferences:get
-              'framework:standard-style-list:font-size))))
        (define size-slider
          (new slider%
               (label #f)
@@ -46,7 +44,7 @@
                   (λ (old-size)
                     (send size get-value)))))
               (init-value
-               (preferences:get 'framework:standard-style-list:font-size))))
+               (editor:get-current-preferred-font-size))))
        (define size-hp (new horizontal-pane% (parent size-panel)))
        (define (mk-size-button label chng)
          (new button%
@@ -196,7 +194,9 @@
          (send text end-edit-sequence))
        (preferences:add-callback
         'framework:standard-style-list:font-size
-        (λ (p v) (send size-slider set-value v)))
+        (λ (p v) (send size-slider set-value 
+                       (editor:font-size-pref->current-font-size
+                        v))))
        (preferences:add-callback
         drracket:language-configuration:settings-preferences-symbol
         (λ (p v)

collects/drracket/private/main.rkt

@@ -649,6 +649,8 @@
 
 (drracket:module-language:initialize-prefs-panel)
 
+(editor:set-change-font-size-when-monitors-change? #t)
+
 (let* ([find-frame
         (λ (item)
           (let loop ([item item])
@@ -751,6 +753,11 @@
 ;;   that is uninitialized (phase level 0); 
 ;;   reference appears in module: ...)
 
+;; we also do this as a low-priority callback since work above
+;; (specifically the call to editor:set-change-font-size-when-monitors-change?)
+;; may have triggered other low-priority callbacks that we
+;; want to complete before we open up that first DrRacket window.
+
 (queue-callback
  (λ ()
    
@@ -786,4 +793,5 @@
        (make-basic))
      (when (and (preferences:get 'drracket:open-in-tabs)
                 (not (null? no-dups)))
-       (handler:edit-file (car no-dups))))))
+       (handler:edit-file (car no-dups)))))
+ #f)

collects/drracket/private/module-language.rkt

@@ -1721,7 +1721,7 @@
         (set! msgs _msgs)
         (set! err? _err?)
         (set! copy-msg _copy-msg)
-        (set-the-height/dc-font (preferences:get 'framework:standard-style-list:font-size))
+        (set-the-height/dc-font (editor:get-current-preferred-font-size))
         (refresh))
       (define/override (on-event evt)
         (cond
@@ -1756,7 +1756,8 @@
       
       ;; need object to hold onto this function, so this is
       ;; intentionally a private field, not a method
-      (define (font-size-changed-callback _ new-size)
+      (define (font-size-changed-callback _ new-prefs)
+        (define new-size (editor:font-size-pref->current-font-size new-prefs))
         (set-the-height/dc-font new-size)
         (refresh))
       (preferences:add-callback
@@ -1784,7 +1785,7 @@
       
       (inherit min-height)
       (set-the-height/dc-font
-       (preferences:get 'framework:standard-style-list:font-size))))
+       (editor:get-current-preferred-font-size))))
   
   (define yellow-message%
     (class canvas%

collects/drracket/private/unit.rkt

@@ -3417,17 +3417,15 @@ module browser threading seems wrong.
         (let ()
           (define (font-adjust adj label key shortcut)
             (define (adj-font _1 _2)
-              (preferences:set
+              (editor:set-current-preferred-font-size
-               'framework:standard-style-list:font-size
+               (adj 
-               (adj (preferences:get
+                (editor:get-current-preferred-font-size))))
-                     'framework:standard-style-list:font-size))))
             (define (on-demand item)
               (define lab 
                 (format 
                  label 
                  (adj 
-                  (preferences:get
+                  (editor:get-current-preferred-font-size))))
-                   'framework:standard-style-list:font-size))))
               (send item set-label lab))
             (define item
              (new menu:can-restore-menu-item%

collects/framework/main.rkt

@@ -1510,6 +1510,85 @@
   (keymap)
   @{Initializes @racket[keymap] with Racket-mode keybindings.})
 
+ (proc-doc/names
+  editor:set-current-preferred-font-size
+  (-> exact-nonnegative-integer? void?)
+  (new-size)
+  @{Sets the font preference for the current monitor configuration to
+    @racket[new-size]. 
+    
+    See also @racket[editor:get-current-preferred-font-size]
+    and @racket[editor:font-size-pref->current-font-size].})
+ 
+ (proc-doc
+  editor:get-current-preferred-font-size
+  (-> exact-nonnegative-integer?)
+  @{Gets the current setting for the font size preference. Calls
+    @racket[editor:font-size-pref->current-font-size] with the
+    current preference setting.
+    
+    See also @racket[editor:set-current-preferred-font-size] and
+    @racket[editor:get-change-font-size-when-monitors-change?].
+    })
+ 
+ (proc-doc/names
+  editor:font-size-pref->current-font-size
+  (-> (vector/c 
+       ;; font sizes for specific monitor configurations
+       (hash/c 
+        ;; a particular monitor configuration: the widths and heights
+        (non-empty-listof (list/c exact-nonnegative-integer? 
+                                  exact-nonnegative-integer?))
+        ;; the font size for that configuration
+        exact-nonnegative-integer?
+        #:flat? #t)
+       
+       ;; default font size, when none of the configs above apply
+       exact-nonnegative-integer?
+       #:flat? #t)
+      exact-nonnegative-integer?)
+  (font-preference)
+  @{Determines the current monitor configuration and uses that to pick
+    one of the sizes from its argument. The argument is expected
+    to come from the preference value of @racket['framework:standard-style-list:font-size].
+    
+    Except if @racket[editor:get-change-font-size-when-monitors-change?] returns
+    @racket[#f], in which case the current monitor configuration is not considered
+    and the last-set size (the second position in the vector) is always returned.
+    
+    As background, the font size
+    preference is actually saved on a per-monitor configuration basis; specifically
+    the preference value (using the same contract as the argument of this function)
+    contains a table mapping a list of monitor sizes (but not their
+    positions) obtained by @racket[get-display-size] to the preferred font size
+    (plus a default size used for new configurations). 
+    
+    See also @racket[editor:get-current-preferred-font-size], 
+    @racket[editor:get-current-preferred-font-size], and
+    @racket[editor:get-change-font-size-when-monitors-change?].})
+ 
+ (proc-doc/names
+  editor:get-change-font-size-when-monitors-change?
+  (-> boolean?)
+  ()
+  @{Returns @racket[#t] when the framework will automatically
+            adjust the current font size in the @racket["Standard"]
+            style of the result of @racket[editor:get-standard-style-list]
+            based on the monitor configuration.
+            
+            Defaults to @racket[#f]
+            
+            See also @racket[editor:set-change-font-size-when-monitors-change?];
+            @racket[editor:font-size-pref->current-font-size].})
+ 
+ (proc-doc/names
+  editor:set-change-font-size-when-monitors-change?
+  (-> boolean? void?)
+  (b?)
+  @{Controls the result of @racket[editor:get-change-font-size-when-monitors-change?].
+                           
+                           See also @racket[editor:get-change-font-size-when-monitors-change?].})
+ 
  (proc-doc/names
   editor:set-default-font-color
   (-> (is-a?/c color%) void?)

collects/framework/private/editor.rkt

@@ -1,4 +1,4 @@
-#lang scheme/unit
+#lang racket/unit
 
   (require mzlib/class
            string-constants
@@ -360,35 +360,35 @@
                     delta))))
   
   (define (set-default-font-color color)
-    (let* ([scheme-standard (send standard-style-list find-named-style default-color-style-name)]
+    (let* ([the-standard (send standard-style-list find-named-style default-color-style-name)]
-           [scheme-delta (make-object style-delta%)])
+           [the-delta (make-object style-delta%)])
-      (send scheme-standard get-delta scheme-delta)
+      (send the-standard get-delta the-delta)
-      (send scheme-delta set-delta-foreground color)
+      (send the-delta set-delta-foreground color)
-      (send scheme-standard set-delta scheme-delta)))
+      (send the-standard set-delta the-delta)))
   
   (define (set-font-size size)
     (update-standard-style
-     (λ (scheme-delta)
+     (λ (the-delta)
-       (send scheme-delta set-size-mult 0)
+       (send the-delta set-size-mult 0)
-       (send scheme-delta set-size-add size))))
+       (send the-delta set-size-add size))))
   
   (define (set-font-name name)
     (update-standard-style
-     (λ (scheme-delta)
+     (λ (the-delta)
-       (send scheme-delta set-delta-face name)
+       (send the-delta set-delta-face name)
-       (send scheme-delta set-family 'modern))))
+       (send the-delta set-family 'modern))))
   
   (define (set-font-smoothing sym)
     (update-standard-style
-     (λ (scheme-delta)
+     (λ (the-delta)
-       (send scheme-delta set-smoothing-on sym))))
+       (send the-delta set-smoothing-on sym))))
   
   (define (update-standard-style cng-delta)
-    (let* ([scheme-standard (send standard-style-list find-named-style "Standard")]
+    (let* ([the-standard (send standard-style-list find-named-style "Standard")]
-           [scheme-delta (make-object style-delta%)])
+           [the-delta (make-object style-delta%)])
-      (send scheme-standard get-delta scheme-delta)
+      (send the-standard get-delta the-delta)
-      (cng-delta scheme-delta)
+      (cng-delta the-delta)
-      (send scheme-standard set-delta scheme-delta)))
+      (send the-standard set-delta the-delta)))
   
   (define standard-style-list<%>
     (interface (editor<%>)
@@ -396,7 +396,7 @@
   
   (define standard-style-list-mixin
     (mixin (editor<%>) (standard-style-list<%>)
-      (super-instantiate ())
+      (super-new)
       (inherit set-style-list set-load-overwrites-styles)
       (set-style-list standard-style-list)
       (set-load-overwrites-styles #f)))
@@ -421,16 +421,62 @@
   (define set-font-size-callback-size #f)
 
   (define (set-standard-style-list-pref-callbacks)
-    (set-font-size (preferences:get 'framework:standard-style-list:font-size))
+    (set-font-size (get-current-preferred-font-size))
     (set-font-name (preferences:get 'framework:standard-style-list:font-name))
     (set-font-smoothing (preferences:get 'framework:standard-style-list:smoothing))
-    (preferences:add-callback 'framework:standard-style-list:font-size (λ (p v) (set-font-size/callback v)))
+    (preferences:add-callback 'framework:standard-style-list:font-size 
+                              (λ (p v)
+                                (set-font-size/callback (font-size-pref->current-font-size v))))
     (preferences:add-callback 'framework:standard-style-list:font-name (λ (p v) (set-font-name v)))
     (preferences:add-callback 'framework:standard-style-list:smoothing (λ (p v) (set-font-smoothing v)))
     
     (unless (member (preferences:get 'framework:standard-style-list:font-name) (get-face-list))
       (preferences:set 'framework:standard-style-list:font-name (get-family-builtin-face 'modern))))
   
+  (define (get-current-preferred-font-size)
+    (font-size-pref->current-font-size (preferences:get 'framework:standard-style-list:font-size)))
+  
+  (define (font-size-pref->current-font-size v)
+    (define default-size (vector-ref v 1))
+    (cond
+      [change-font-size-when-monitors-change?
+       (define monitor-sizes (get-current-monitor-sizes))
+       (hash-ref (vector-ref v 0) monitor-sizes default-size)]
+      [else
+       default-size]))
+  
+  (define change-font-size-when-monitors-change? #f)
+  (define (get-change-font-size-when-monitors-change?)
+    change-font-size-when-monitors-change?)
+  (define (set-change-font-size-when-monitors-change? b?)
+    (unless (equal? change-font-size-when-monitors-change? b?)
+      (set! change-font-size-when-monitors-change? b?)
+      (set-current-preferred-font-size
+       (get-current-preferred-font-size))))
+  
+  
+  (define (set-current-preferred-font-size new-size)
+    (define old-pref (preferences:get 'framework:standard-style-list:font-size))
+    (define current-mons (get-current-monitor-sizes))
+    (define new-monitor-sizes
+      (hash-set (vector-ref old-pref 0)
+                current-mons
+                new-size))
+    (preferences:set 'framework:standard-style-list:font-size
+                     (vector new-monitor-sizes new-size)))
+  
+  (define (get-current-monitor-sizes)
+    (let loop ([m (get-display-count)]
+               [sizes '()])
+      (cond
+        [(zero? m) sizes]
+        [else
+         (define-values (w h) (get-display-size #:monitor (- m 1)))
+         (loop (- m 1)
+               (if (and w h)
+                   (cons (list w h) sizes)
+                   sizes))])))
+  
   ;; set-standard-style-list-delta : string (is-a?/c style-delta<%>) -> void
   (define (set-standard-style-list-delta name delta)
     (let* ([style-list (get-standard-style-list)]

collects/framework/private/frame.rkt

@@ -480,6 +480,9 @@
                 (set! latest-monitor-information new-monitor-information)
                 (queue-callback
                  (λ ()
+                   (when (editor:get-change-font-size-when-monitors-change?)
+                     (editor:set-current-preferred-font-size
+                      (editor:get-current-preferred-font-size)))
                    (for ([frame (in-list (get-top-level-windows))])
                      (when (is-a? frame size-pref<%>)
                        (send frame monitor-setup-changed)))

collects/framework/private/main.rkt

@@ -1,5 +1,6 @@
 #lang racket/unit
 (require racket/class
+         racket/contract
          "sig.rkt"
          "../preferences.rkt"
          mred/mred-sig)
@@ -143,11 +144,32 @@
 
 (preferences:set-default
  'framework:standard-style-list:font-size
- (let* ([txt (make-object text%)]
+ (vector (hash)
-        [stl (send txt get-style-list)]
+         (let* ([txt (make-object text%)]
-        [bcs (send stl basic-style)])
+                [stl (send txt get-style-list)]
-   (send bcs get-size))
+                [bcs (send stl basic-style)])
- (λ (x) (and (number? x) (exact? x) (integer? x) (positive? x))))
+           (send bcs get-size)))
+ (vector/c 
+  ;; font sizes for specific monitor configurations
+  (hash/c 
+   ;; a particular monitor configuration: the widths and heights
+   (non-empty-listof (list/c exact-nonnegative-integer? 
+                             exact-nonnegative-integer?))
+   ;; the font size for that configuration
+   exact-nonnegative-integer?
+   #:flat? #t)
+  ;; default font size, when none of the configs above apply
+  exact-nonnegative-integer?
+  #:flat? #t))
+
+(preferences:set-un/marshall
+ 'framework:standard-style-list:font-size
+ values
+ (λ (x)
+   (if (exact-nonnegative-integer? x)
+       ;; coerce old pref settings to new
+       (vector (hash) x)
+       x)))
 
 (preferences:set-default
  'framework:standard-style-list:smoothing

collects/framework/private/sig.rkt

@@ -162,7 +162,12 @@
      set-standard-style-list-delta
      set-default-font-color
      get-default-color-style-name
-     add-after-user-keymap))
+     add-after-user-keymap
+     get-current-preferred-font-size
+     set-current-preferred-font-size
+     font-size-pref->current-font-size
+     set-change-font-size-when-monitors-change?
+     get-change-font-size-when-monitors-change?))
   
   (define-signature pasteboard-class^
     (basic%

collects/framework/private/text.rkt

@@ -3744,14 +3744,14 @@ designates the character that triggers autocompletion
     
     (define/private (get-mt-font)
       (send the-font-list find-or-create-font
-            (preferences:get 'framework:standard-style-list:font-size)
+            (editor:get-current-preferred-font-size)
             'default
             'italic
             'normal))
     
     (define/private (get-reg-font)
       (send the-font-list find-or-create-font
-            (preferences:get 'framework:standard-style-list:font-size)
+            (editor:get-current-preferred-font-size)
             'default
             'normal
             'normal))