Set text color almost everywhere

basis/help/stylesheet/stylesheet.factor

@@ -26,6 +26,7 @@ SYMBOL: default-span-style
 H{
     { font-name $ default-sans-serif-font-name }
     { font-size $ font-size-span }
+    { foreground $ text-color }
     { font-style plain }
 } default-span-style set-global
 

basis/prettyprint/stylesheet/stylesheet.factor

@@ -21,7 +21,8 @@ GENERIC: word-style ( word -- style )
 
 M: word word-style
     [ presented associate ]
-    [ "word-style" word-prop ] bi assoc-union! ;
+    [ "word-style" word-prop ] bi assoc-union!
+    text-color foreground pick set-at ;
 
 M: highlighted-word word-style
     call-next-method

basis/ui/gadgets/buttons/buttons.factor

@@ -134,7 +134,7 @@ PRIVATE>
     <button-pen> ;
 
 : border-button-label-theme ( gadget -- )
-    dup label? [ [ clone t >>bold? ] change-font ] when drop ;
+    dup label? [ [ clone t >>bold? text-color >>foreground ] 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? ] change-font
+    [ t >>bold? text-color >>foreground ] change-font
     { 0 4 } <border>
     title-bar-interior >>interior
     f track-add ;

basis/ui/gadgets/labels/labels.factor

@@ -3,7 +3,7 @@
 USING: accessors arrays colors.constants combinators fonts fry
 kernel make math.functions models namespaces sequences splitting
 strings ui.baseline-alignment ui.gadgets ui.gadgets.tracks
-ui.pens.solid ui.render ui.text ;
+ui.pens.solid ui.render ui.text ui.tools.common ;
 IN: ui.gadgets.labels
 
 ! A label gadget draws a string.
@@ -92,7 +92,7 @@ M: label-control model-changed
         swap >>model ;
 
 : text-theme ( gadget -- gadget )
-    monospace-font >>font ;
+    monospace-font >>font theme-font-colors ;
 
 : reverse-video-theme ( label -- label )
     sans-serif-font reverse-video-font >>font

basis/ui/tools/browser/browser.factor

@@ -101,6 +101,7 @@ 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/common/common.factor

@@ -49,3 +49,6 @@ SLOT: scroller
 
 : white-interior ( track -- track )
     content-background <solid> >>interior ;
+
+: theme-font-colors ( gadget -- gadget )
+    [ content-background >>background text-color >>foreground ] change-font ;

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> add-gadget ] dip
+            [ "To continue, pick one of the options below:" <label> theme-font-colors add-gadget ] dip
             restart-list>> add-gadget
         ] [ drop ] if
     ] bi ;

basis/ui/tools/inspector/inspector.factor

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

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

@@ -1,14 +1,16 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs calendar colors colors.constants
-documents documents.elements fry kernel words sets splitting math
+combinators combinators.short-circuit definitions.icons
-math.vectors models.delay models.arrow combinators.short-circuit
+documents documents.elements fonts fry generic help.vocabs
-parser present sequences tools.completion help.vocabs generic fonts
+kernel math math.vectors models.arrow models.delay parser
-definitions.icons ui.images ui.commands ui.operations ui.gadgets
+present sequences sets splitting tools.completion ui.commands
-ui.gadgets.editors ui.gadgets.glass ui.gadgets.scrollers
+ui.gadgets ui.gadgets.editors ui.gadgets.glass
-ui.gadgets.tables ui.gadgets.tracks ui.gadgets.labeled ui.gadgets.theme
+ui.gadgets.labeled ui.gadgets.scrollers ui.gadgets.tables
-ui.gadgets.worlds ui.gadgets.wrappers ui.gestures ui.pens.solid
+ui.gadgets.theme ui.gadgets.tracks ui.gadgets.worlds
-ui.tools.listener.history combinators vocabs ui.tools.listener.popups ;
+ui.gadgets.wrappers ui.gestures ui.images ui.operations
+ui.pens.solid ui.tools.common ui.tools.listener.history
+ui.tools.listener.popups vocabs words ;
 IN: ui.tools.listener.completion
 
 ! We don't directly depend on the listener tool but we use a few slots
@@ -139,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
+        monospace-font >>font theme-font-colors
         t >>selection-required?
         t >>single-click?
         30 >>min-cols

basis/ui/tools/listener/listener.factor

@@ -73,6 +73,7 @@ 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
@@ -95,12 +96,18 @@ M: interactor stream-element-type drop +character+ ;
 GENERIC: (print-input) ( object -- )
 
 M: input (print-input)
-    dup presented associate
+    dup presented associate [
-    [ string>> H{ { font-style bold } } format ] with-nesting nl ;
+        string>>
+        H{ { font-style bold } { foreground $ text-color } }
+        format
+    ] with-nesting nl ;
 
 M: word (print-input)
-    "Command: " H{ { font-name "sans-serif" } { font-style bold } }
+    "Command: "
-    format . ;
+    H{ { font-name "sans-serif" }
+       { font-style bold }
+       { foreground $ text-color }
+    } format . ;
 
 : print-input ( object interactor -- )
     output>> [ (print-input) ] with-output-stream* ;

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
+        monospace-font >>font theme-font-colors
         [ 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>
-            dup font>> t >>bold? drop
+            [ t >>bold? text-color >>foreground ] change-font
             f track-add
-        self name>> <label> f track-add
+        self name>> <label> [ text-color >>foreground ] change-font f track-add
         over status>> <thread-status>
             dup font>> t >>bold? drop
             f track-add