fonts: change <font> to take a name, make all the defaults configurable

mrjbq7 · Nov 15, 2024 · 6d7bf20 · 6d7bf20
1 parent 80c9c4a
commit 6d7bf20
Show file tree

Hide file tree

Showing 5 changed files with 30 additions and 28 deletions.
diff --git a/basis/fonts/fonts-docs.factor b/basis/fonts/fonts-docs.factor
@@ -1,11 +1,11 @@
 ! Copyright (C) 2009 Slava Pestov
 ! See https://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel colors ;
+USING: help.markup help.syntax kernel colors strings ;
 IN: fonts
 
 HELP: <font>
-{ $values { "font" font } }
-{ $description "Creates a new font." } ;
+{ $values { "name" string } { "font" font } }
+{ $description "Creates a new font with the given " { $snippet "name" } " and " { $link default-font-size } ", " { $link default-font-foreground } ", and " { $link default-font-background } "." } ;
 
 HELP: font
 { $class-description "The class of fonts." } ;

diff --git a/basis/fonts/fonts.factor b/basis/fonts/fonts.factor
@@ -3,24 +3,32 @@
 USING: accessors colors combinators kernel math namespaces ;
 IN: fonts
 
-CONSTANT: default-serif-font-name "serif"
-CONSTANT: default-sans-serif-font-name "sans-serif"
-CONSTANT: default-monospace-font-name "monospace"
+: default-serif-font-name ( -- name )
+    \ default-serif-font-name get "serif" or ;
 
-CONSTANT: default-font-size 12
+: default-sans-serif-font-name ( -- name )
+    \ default-sans-serif-font-name get "sans-serif" or ;
 
-SYMBOL: default-font-foreground-color
-COLOR: black default-font-foreground-color set-global
+: default-monospace-font-name ( -- name )
+    \ default-monospace-font-name get "monospace" or ;
 
-SYMBOL: default-font-background-color
-COLOR: white default-font-background-color set-global
+: default-font-size ( -- size )
+    \ default-font-size get 12 or ;
+
+: default-font-foreground ( -- color )
+    \ default-font-foreground get COLOR: black or ;
+
+: default-font-background ( -- color )
+    \ default-font-background get COLOR: white or ;
 
 TUPLE: font name size bold? italic? foreground background ;
 
-: <font> ( -- font )
+: <font> ( name -- font )
     font new
-        default-font-foreground-color get >>foreground
-        default-font-background-color get >>background ; inline
+        swap >>name
+        default-font-size >>size
+        default-font-foreground >>foreground
+        default-font-background >>background ; inline
 
 : font-with-foreground ( font color -- font' )
     [ clone ] dip >>foreground ; inline
@@ -49,19 +57,13 @@ TUPLE: font name size bold? italic? foreground background ;
     ] when* ;
 
 : serif-font ( -- font )
-    <font>
-        default-serif-font-name >>name
-        default-font-size >>size ;
+    default-serif-font-name <font> ;
 
 : sans-serif-font ( -- font )
-    <font>
-        default-sans-serif-font-name >>name
-        default-font-size >>size ;
+    default-sans-serif-font-name <font> ;
 
 : monospace-font ( -- font )
-    <font>
-        default-monospace-font-name >>name
-        default-font-size >>size ;
+    default-monospace-font-name <font> ;
 
 : strip-font-colors ( font -- font' )
     clone f >>background f >>foreground ;

diff --git a/basis/ui/theme/switching/tools/tools.factor b/basis/ui/theme/switching/tools/tools.factor
@@ -7,8 +7,8 @@ IN: ui.theme.switching.tools
 
 : update-tools-style ( -- )
     ! fonts
-    text-color default-font-foreground-color set-global
-    content-background default-font-background-color set-global
+    text-color \ default-font-foreground set-global
+    content-background \ default-font-background set-global
 
     ! help.stylesheet
     default-style text-color foreground update-style

diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
@@ -204,7 +204,7 @@ M: interactor dispose drop ;
 
 TUPLE: listener-gadget < tool error-summary output scroller input ;
 
-listener-gadget default-font-size  { 50 58 } n*v set-tool-dim
+listener-gadget default-font-size { 50 58 } n*v set-tool-dim
 
 : listener-streams ( listener -- input output )
     [ input>> ] [ output>> <pane-stream> listener-output-style get <style-stream> ] bi ;
@@ -416,7 +416,7 @@ interactor "completion" f {
 
 : introduction. ( -- )
     [
-        H{ { font-size $ default-font-size } } [
+        default-font-size font-size associate [
             { $tip-of-the-day } print-element nl
             { $strong "Press " { $snippet "F1" } " at any time for help." } print-element nl
             vm-info print-element

diff --git a/extra/ui/gadgets/comboboxes/comboboxes.factor b/extra/ui/gadgets/comboboxes/comboboxes.factor
@@ -25,4 +25,4 @@ combobox H{
 : <combobox> ( options -- combobox )
     [ first [ combobox new-label ] [ disp-string <basic> ] bi >>model ] keep
     <basic> combo-table new-table white-interior [ 1array ] >>quot >>table 
-    default-font-foreground-color get <solid> >>boundary ;
+    default-font-foreground <solid> >>boundary ;