ui.theme.switching: default font colors.

basis/fonts/fonts.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors colors.constants combinators kernel math ;
+USING: accessors colors.constants combinators kernel math
+namespaces ;
 IN: fonts
 
 CONSTANT: default-serif-font-name "serif"
@@ -9,16 +10,18 @@ CONSTANT: default-monospace-font-name "monospace"
 
 CONSTANT: default-font-size 12
 
-TUPLE: font
+SYMBOL: default-font-foreground-color
-name
+COLOR: black default-font-foreground-color set-global
-size
+
-bold?
+SYMBOL: default-font-background-color
-italic?
+COLOR: white default-font-background-color set-global
-{ foreground initial: COLOR: black }
+
-{ background initial: COLOR: white } ;
+TUPLE: font name size bold? italic? foreground background ;
 
 : <font> ( -- font )
-    font new ; inline
+    font new
+        default-font-foreground-color get >>foreground
+        default-font-background-color get >>background ; inline
 
 : font-with-foreground ( font color -- font' )
     [ clone ] dip >>foreground ; inline

basis/ui/gadgets/buttons/buttons.factor

@@ -134,7 +134,7 @@ PRIVATE>
     <button-pen> ;
 
 : border-button-label-theme ( gadget -- )
-    dup label? [ [ clone t >>bold? text-color >>foreground ] change-font ] when drop ;
+    dup label? [ [ clone t >>bold? ] change-font ] when drop ;
 
 : border-button-theme ( gadget -- gadget )
     dup gadget-child border-button-label-theme

basis/ui/gadgets/labeled/labeled.factor

@@ -21,7 +21,7 @@ M: labeled-gadget focusable-child* content>> ;
 
 : add-title-bar ( title track -- track )
     swap >label
-    [ t >>bold? text-color >>foreground ] change-font
+    [ t >>bold? ] change-font
     { 0 4 } <border>
     title-bar-interior >>interior
     f track-add ;

basis/ui/gadgets/labels/labels.factor

@@ -67,10 +67,10 @@ M: label cap-height*
 <PRIVATE
 
 : label-background ( label -- color )
-    gadget-background background get or ; inline
+    gadget-background [ background get ] unless* ; inline
 
 : label-foreground ( label -- color )
-    gadget-foreground foreground get or ; inline
+    gadget-foreground [ foreground get ] unless* ; inline
 
 PRIVATE>
 
@@ -91,13 +91,6 @@ M: label-control model-changed
     "" label-control new-label
         swap >>model ;
 
-: text-theme ( gadget -- gadget )
-    monospace-font >>font theme-font-colors ;
-
-: reverse-video-theme ( label -- label )
-    sans-serif-font reverse-video-font >>font
-    COLOR: black <solid> >>interior ;
-
 GENERIC: >label ( obj -- gadget )
 M: string >label <label> ;
 M: array >label <label> ;

basis/ui/gadgets/panes/panes.factor

@@ -321,7 +321,7 @@ M: paragraph dispose drop ;
 
 : gadget-write ( string gadget -- )
     swap dup empty?
-    [ 2drop ] [ <label> text-theme add-gadget drop ] if ;
+    [ 2drop ] [ <label> monospace-font >>font add-gadget drop ] if ;
 
 M: pack stream-write gadget-write ;
 

basis/ui/gadgets/theme/theme.factor

@@ -3,10 +3,5 @@
 USING: accessors io.pathnames sequences ui.images ui.theme ;
 IN: ui.gadgets.theme
 
-SLOT: font ! Temporarily necessary to fix Windows bootstrap.
-
 : theme-image ( name -- image-name )
     "vocab:ui/gadgets/theme/" prepend-path ".tiff" append <image-name> ;
-
-: theme-font-colors ( gadget -- gadget )
-    [ content-background >>background text-color >>foreground ] change-font ;

basis/ui/theme/switching/switching.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2016 Nicolas Pénet.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs fry hashtables help.stylesheet help.tips io.styles
+USING: assocs fonts fry hashtables help.stylesheet help.tips
-kernel listener namespaces prettyprint.stylesheet sequences
+io.styles kernel listener namespaces prettyprint.stylesheet
-ui.theme ui.tools.listener vocabs.prettyprint words ;
+sequences ui.theme ui.tools.listener vocabs.prettyprint words ;
 IN: ui.theme.switching
 
 <PRIVATE
@@ -11,6 +11,10 @@ IN: ui.theme.switching
     '[ _ _ rot ?set-at ] change-global ;
 
 : update-stylesheet ( -- )
+    ! fonts
+    text-color default-font-foreground-color set-global
+    content-background default-font-background-color set-global
+
     ! help.stylesheet
     default-span-style text-color foreground update-style
     link-style link-color foreground update-style

basis/ui/tools/browser/browser.factor

@@ -101,7 +101,6 @@ CONSTANT: next 1
 
 : <search-field> ( browser -- field )
     '[ _ search-browser ] <action-field>
-        [ theme-font-colors ] change-editor
         "Search" >>default-text
         10 >>min-cols
         10 >>max-cols

basis/ui/tools/debugger/debugger.factor

@@ -36,7 +36,7 @@ M: restart-renderer row-columns
     [ error>> <error-pane> add-gadget ]
     [
         dup restart-hook>> [
-            [ "To continue, pick one of the options below:" <label> theme-font-colors add-gadget ] dip
+            [ "To continue, pick one of the options below:" <label> add-gadget ] dip
             restart-list>> add-gadget
         ] [ drop ] if
     ] bi ;
@@ -49,7 +49,7 @@ PRIVATE>
         swap >>restarts
         swap >>continuation
         swap >>error
-        dup <restart-list> theme-font-colors >>restart-list
+        dup <restart-list> >>restart-list
         dup <error-display> margins white-interior f track-add
         add-toolbar ;
 

basis/ui/tools/inspector/inspector.factor

@@ -74,7 +74,7 @@ M: hashtable make-slot-descriptions
 : <inspector-table> ( model -- table )
     [ make-slot-descriptions ] <arrow> inspector-renderer <table>
         [ invoke-primary-operation ] >>action
-        monospace-font >>font theme-font-colors
+        monospace-font >>font
         line-color >>column-line-color
         6 >>gap
         15 >>min-rows

basis/ui/tools/listener/completion/completion.factor

@@ -141,7 +141,7 @@ GENERIC# accept-completion-hook 1 ( item popup -- )
 : <completion-table> ( interactor completion-mode -- table )
     [ completion-element ] [ completion-quot ] [ nip ] 2tri
     [ <completion-model> ] dip <table>
-        monospace-font >>font theme-font-colors
+        monospace-font >>font
         t >>selection-required?
         t >>single-click?
         30 >>min-cols

basis/ui/tools/listener/listener.factor

@@ -74,7 +74,6 @@ M: color-completion (word-at-caret) 2drop f ;
 
 : <interactor> ( -- gadget )
     interactor new-editor
-        theme-font-colors
         <flag> >>flag
         dup one-word-elt <element-model> >>token-model
         dup <word-model> >>word-model

basis/ui/tools/traceback/traceback.factor

@@ -28,7 +28,7 @@ M: stack-entry-renderer row-value drop object>> ;
         10 >>max-rows
         40 >>min-cols
         40 >>max-cols
-        monospace-font >>font theme-font-colors
+        monospace-font >>font
         [ i:inspector ] >>action
         t >>single-click? ;
 

basis/ui/tools/walker/walker.factor

@@ -78,9 +78,9 @@ M: thread-status model-changed
 : add-thread-status ( track -- track )
     horizontal <track> { 5 5 } >>gap
         "Thread:" <label>
-            [ t >>bold? text-color >>foreground ] change-font
+            [ t >>bold? ] change-font
             f track-add
-        self name>> <label> [ text-color >>foreground ] change-font f track-add
+        self name>> <label> f track-add
         over status>> <thread-status>
             dup font>> t >>bold? drop
             f track-add

extra/ui/gadgets/lists/lists.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel locals math math.order math.rectangles
+USING: accessors fonts kernel locals math math.order
-math.vectors models namespaces opengl sequences ui.commands
+math.rectangles math.vectors models namespaces opengl sequences
-ui.gadgets ui.gadgets.labels ui.gadgets.packs
+ui.commands ui.gadgets ui.gadgets.labels ui.gadgets.packs
 ui.gadgets.presentations ui.gadgets.scrollers
 ui.gadgets.viewports ui.gestures ui.render ui.theme ;
 IN: ui.gadgets.lists
@@ -32,7 +32,8 @@ TUPLE: list < pack index presenter color hook ;
     hook>> [ [ list? ] find-parent ] prepend ;
 
 : <list-presentation> ( hook elt presenter -- gadget )
-    [ call( elt -- obj ) ] [ drop ] 2bi [ >label text-theme ] dip
+    [ call( elt -- obj ) ] [ drop ] 2bi
+    [ >label monospace-font >>font ] dip
     <presentation>
     swap >>hook ; inline