ui.theme: updates to color scheme.

Fixes circularity and adds theme switching to Mac menu.
Could use some simplification and reduction in color theme hooks.

basis/help/stylesheet/stylesheet.factor

@@ -108,19 +108,21 @@ H{
 SYMBOL: url-style
 H{
     { font-name $ default-monospace-font-name }
-    { foreground $ url-color }
+    { foreground $ link-color }
 } url-style set-global
 
 SYMBOL: warning-style
 H{
     { page-color $ warning-background-color }
+    { border-color $ warning-border-color }
     { inset { 5 5 } }
     { wrap-margin $ wrap-margin-full }
 } warning-style set-global
 
 SYMBOL: deprecated-style
 H{
     { page-color $ warning-background-color }
+    { border-color $ warning-border-color }
     { inset { 5 5 } }
     { wrap-margin $ wrap-margin-full }
 } deprecated-style set-global

basis/help/tips/tips-docs.factor

@@ -1,6 +1,6 @@
 USING: debugger editors help help.apropos help.markup
 help.syntax help.vocabs memory see stack-checker
-tools.destructors tools.time ui.theme.switching ;
+tools.destructors tools.time ;
 IN: help.tips
 
 TIP: "To look at the most recent error, run " { $link :error } ". To look at the most recent error's callstack, run " { $link :c } "." ;
@@ -27,8 +27,6 @@ TIP: "To save time on reloading big libraries such as the " { $vocab-link "furna
 
 TIP: "Use the " { $link leaks. } " combinator to track down resource leaks." ;
 
-TIP: "Use " { $link light-mode } " and " { $link dark-mode } " for a light or dark user interface." ;
-
 HELP: TIP:
 { $syntax "TIP: content ;" }
 { $values { "content" "a markup element" } }

basis/listener/listener.factor

@@ -4,7 +4,7 @@ USING: accessors colors colors.constants
 combinators.short-circuit compiler.units continuations debugger
 fry io io.styles kernel lexer literals locals math math.parser
 namespaces parser parser.notes prettyprint sequences sets
-source-files.errors system ui.theme vocabs vocabs.loader
+source-files.errors system vocabs vocabs.loader
 vocabs.parser ;
 IN: listener
 
@@ -17,8 +17,8 @@ GENERIC# prompt. 1 ( stream prompt -- )
 
 SYMBOL: prompt-style
 H{
-    { background $ prompt-background-color }
-    { foreground $ text-color }
+    { background T{ rgba f 1 0.7 0.7 1 } }
+    { foreground COLOR: black }
 } prompt-style set-global
 
 M: object prompt.

basis/prettyprint/stylesheet/stylesheet.factor

@@ -1,55 +1,60 @@
 ! Copyright (C) 2009 Keith Lazuka, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs colors combinators
+USING: assocs colors colors.constants combinators
 combinators.short-circuit hashtables io.styles kernel literals
-namespaces sequences ui.theme words words.symbol ;
+namespaces sequences words words.symbol ;
 IN: prettyprint.stylesheet
 
 <PRIVATE
 
 { POSTPONE: USING: POSTPONE: USE: POSTPONE: IN: }
 [
-    { { foreground $ dim-color } }
+    { { foreground COLOR: gray35 } }
     "word-style" set-word-prop
 ] each
 
 PREDICATE: highlighted-word < word [ parsing-word? ] [ delimiter? ] bi or ;
 
 PRIVATE>
 
+SYMBOL: base-word-style
+H{ } base-word-style set-global
+
 GENERIC: word-style ( word -- style )
 
 M: word word-style
-    [ presented associate ]
-    [ "word-style" word-prop ] bi assoc-union!
-    text-color foreground pick set-at ;
-
-M: highlighted-word word-style
-    call-next-method
-    highlighted-word-color foreground pick set-at ;
+    [ presented base-word-style get clone [ set-at ] keep ]
+    [ "word-style" word-prop ] bi assoc-union! ;
 
-<PRIVATE
+SYMBOL: highlighted-word-style
+H{
+    { foreground COLOR: DarkSlateGray }
+} highlighted-word-style set-global
 
-: colored-presentation-style ( obj color -- style )
-    2 <hashtable> [
-        [ presented foreground ] dip
-        [ set-at ] curry bi-curry@ bi*
-    ] keep ;
+M: highlighted-word word-style
+    call-next-method highlighted-word-style get assoc-union! ;
 
-PRIVATE>
+SYMBOL: base-string-style
+H{
+    { foreground COLOR: LightSalmon4 }
+} base-string-style set-global
 
 : string-style ( str -- style )
-    string-color colored-presentation-style ;
+    presented base-string-style get clone [ set-at ] keep ;
+
+SYMBOL: base-vocab-style
+H{
+    { foreground COLOR: gray35 }
+} base-vocab-style set-global
 
 : vocab-style ( vocab -- style )
-    dim-color colored-presentation-style ;
+    presented base-vocab-style get clone [ set-at ] keep ;
 
 SYMBOL: stack-effect-style
-
 H{
-    { foreground $ stack-effect-color }
+    { foreground COLOR: FactorDarkGreen }
     { font-style plain }
 } stack-effect-style set-global
 
 : effect-style ( effect -- style )
-    presented associate stack-effect-style get assoc-union! ;
+    presented stack-effect-style get clone [ set-at ] keep ;

basis/ui/backend/cocoa/tools/tools.factor

@@ -1,11 +1,11 @@
 ! Copyright (C) 2006, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax cocoa cocoa.nibs cocoa.application
-cocoa.classes cocoa.dialogs cocoa.pasteboard cocoa.runtime
-cocoa.subclassing core-foundation core-foundation.strings
-help.topics kernel memory namespaces parser system ui
-ui.tools.browser ui.tools.listener ui.backend.cocoa eval
-locals listener vocabs.refresh ;
+USING: alien.syntax cocoa cocoa.application cocoa.classes
+cocoa.dialogs cocoa.nibs cocoa.pasteboard cocoa.runtime
+cocoa.subclassing core-foundation.strings eval kernel listener
+locals memory namespaces system ui.backend.cocoa
+ui.theme.switching ui.tools.browser ui.tools.listener
+vocabs.refresh ;
 FROM: alien.c-types => int void ;
 IN: ui.backend.cocoa.tools
 
@@ -27,9 +27,9 @@ CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate
 
     METHOD: int applicationShouldHandleReopen: id app hasVisibleWindows: int flag [ flag 0 = [ show-listener ] when 1 ] ;
 
-    METHOD: id factorListener: id app [ show-listener f ] ;
+    METHOD: id showFactorListener: id app [ show-listener f ] ;
 
-    METHOD: id factorBrowser: id app [ show-browser f ] ;
+    METHOD: id showFactorBrowser: id app [ show-browser f ] ;
 
     METHOD: id newFactorListener: id app [ listener-window f ] ;
 
@@ -41,6 +41,10 @@ CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate
 
     METHOD: id saveFactorImageAs: id app [ menu-save-image f ] ;
 
+    METHOD: id switchLightTheme: id app [ light-mode f ] ;
+
+    METHOD: id switchDarkTheme: id app [ dark-mode f ] ;
+
     METHOD: id refreshAll: id app [ [ refresh-all ] \ refresh-all call-listener f ] ;
 ;
 

basis/ui/gadgets/labels/labels.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 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.tools.common ;
+strings ui.baseline-alignment ui.gadgets ui.gadgets.theme
+ui.gadgets.tracks ui.pens.solid ui.render ui.text ;
 IN: ui.gadgets.labels
 
 ! A label gadget draws a string.

basis/ui/gadgets/line-support/line-support.factor

@@ -3,7 +3,7 @@
 USING: accessors arrays combinators fry kernel math
 math.functions math.order math.ranges math.vectors namespaces
 opengl sequences ui.gadgets ui.gadgets.scrollers
-ui.gadgets.viewports ui.render ui.text ;
+ui.gadgets.viewports ui.render ui.text ui.theme ;
 IN: ui.gadgets.line-support
 
 ! Some code shared by table and editor gadgets

basis/ui/gadgets/menus/menus.factor

@@ -3,8 +3,8 @@
 USING: accessors kernel locals math.rectangles math.vectors
 namespaces opengl sequences sorting ui.commands ui.gadgets
 ui.gadgets.buttons ui.gadgets.glass ui.gadgets.packs
-ui.gadgets.theme ui.gadgets.worlds ui.gestures ui.operations
-ui.pens ui.pens.solid ui.tools.common ;
+ui.gadgets.worlds ui.gestures ui.operations
+ui.pens ui.pens.solid ui.theme ui.tools.common ;
 IN: ui.gadgets.menus
 
 : show-menu ( owner menu -- )

basis/ui/gadgets/panes/panes.factor

@@ -9,7 +9,7 @@ ui.gadgets.icons ui.gadgets.incremental ui.gadgets.labels
 ui.gadgets.menus ui.gadgets.packs ui.gadgets.paragraphs
 ui.gadgets.presentations ui.gadgets.private ui.gadgets.scrollers
 ui.gadgets.tracks ui.gestures ui.images ui.pens.solid ui.render
-ui.traverse ;
+ui.theme ui.traverse ;
 FROM: io.styles => foreground background ;
 FROM: ui.gadgets.wrappers => <wrapper> ;
 IN: ui.gadgets.panes

basis/ui/gadgets/presentations/presentations.factor

@@ -3,8 +3,7 @@
 USING: accessors kernel memoize namespaces ui.commands ui.gadgets
 ui.gadgets.borders ui.gadgets.buttons ui.gadgets.buttons.private
 ui.gadgets.glass ui.gadgets.menus ui.gadgets.status-bar
-ui.gadgets.theme ui.gadgets.worlds ui.gestures
-ui.operations ui.pens.solid ;
+ui.gadgets.worlds ui.gestures ui.operations ui.pens.solid ui.theme ;
 IN: ui.gadgets.presentations
 
 TUPLE: presentation < button object hook ;

basis/ui/gadgets/status-bar/status-bar.factor

@@ -3,7 +3,7 @@
 USING: accessors calendar colors.constants fonts kernel models
 models.arrow models.delay sequences summary ui
 ui.gadgets.borders ui.gadgets.labels ui.gadgets.tracks
-ui.gadgets.theme ui.gadgets.worlds ui.pens.solid ui.private ;
+ui.gadgets.worlds ui.pens.solid ui.private ui.theme ;
 IN: ui.gadgets.status-bar
 
 : status-bar-font ( -- font )

basis/ui/gadgets/tables/tables.factor

@@ -5,8 +5,8 @@ combinators.short-circuit fonts fry kernel locals math
 math.functions math.order math.rectangles math.vectors models
 namespaces opengl sequences splitting strings ui.commands
 ui.gadgets ui.gadgets.line-support ui.gadgets.menus
-ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.theme ui.gadgets.worlds
-ui.gestures ui.images ui.pens.solid ui.render ui.text ;
+ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.worlds
+ui.gestures ui.images ui.pens.solid ui.render ui.text ui.theme ;
 IN: ui.gadgets.tables
 
 ! Row rendererer protocol

basis/ui/gadgets/theme/theme.factor

@@ -1,7 +1,10 @@
 ! Copyright (C) 2009, 2010 Slava Pestov, Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io.pathnames sequences ui.images ;
+USING: accessors io.pathnames sequences ui.images ui.theme ;
 IN: ui.gadgets.theme
 
 : 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,31 +1,57 @@
 ! Copyright (C) 2016 Nicolas Pénet.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: fry hashtables help.stylesheet help.tips io.styles
-kernel listener namespaces ui.theme ui.tools.listener ;
+USING: assocs fry hashtables help.stylesheet help.tips io.styles
+kernel listener namespaces prettyprint.stylesheet sequences
+ui.theme ui.tools.listener vocabs.prettyprint words ;
 IN: ui.theme.switching
 
 : (update-style) ( style color elt -- )
     '[ _ _ rot ?set-at ] change-global ;
 
 : update-stylesheet ( -- )
+
+    ! help.stylesheet
     default-span-style text-color foreground (update-style)
     link-style link-color foreground (update-style)
     title-style title-color foreground (update-style)
+    help-path-style help-path-border-color table-border (update-style)
     heading-style heading-color foreground (update-style)
     snippet-style snippet-color foreground (update-style)
     code-style code-background-color page-color (update-style)
     output-style output-color foreground (update-style)
-    url-style url-color foreground (update-style)
+    url-style link-color foreground (update-style)
     warning-style warning-background-color page-color (update-style)
-    deprecated-style warning-background-color page-color (update-style)
-    table-style line-color table-border (update-style)
-    prompt-style prompt-background-color background (update-style)
-    prompt-style text-color foreground (update-style)
+    warning-style warning-border-color border-color (update-style)
+    deprecated-style deprecated-background-color page-color (update-style)
+    deprecated-style deprecated-border-color border-color (update-style)
+    table-style table-border-color table-border (update-style)
+
+    ! help.tips
     tip-of-the-day-style tip-background-color page-color (update-style)
+
+    ! ui.tools.listener
     listener-input-style text-color foreground (update-style)
-    listener-word-style text-color foreground (update-style) ;
+    listener-word-style text-color foreground (update-style)
+
+    ! prettyprint.stylesheet
+    { POSTPONE: USING: POSTPONE: USE: POSTPONE: IN: }
+    [ "word-style" word-prop [ dim-color foreground  ] dip set-at ] each
+    base-word-style text-color foreground (update-style)
+    highlighted-word-style highlighted-word-color foreground (update-style)
+    base-string-style string-color foreground (update-style)
+    base-vocab-style dim-color foreground (update-style)
+    stack-effect-style stack-effect-color foreground (update-style)
+
+    ! listener
+    prompt-style prompt-background-color background (update-style)
+    prompt-style text-color foreground (update-style)
+
+    ! vocabs.prettyprint
+    manifest-style vocab-background-color page-color (update-style)
+    manifest-style vocab-border-color border-color (update-style) ;
 
-: light-mode ( -- ) light-theme theme set-global update-stylesheet ;
-: dark-mode ( -- ) dark-theme theme set-global update-stylesheet ;
+: light-mode ( -- )
+    light-theme theme set-global update-stylesheet ;
 
-light-mode
+: dark-mode ( -- )
+    dark-theme theme set-global update-stylesheet ;