diff --git a/basis/colors/constants/constants-docs.factor b/basis/colors/constants/constants-docs.factor index 49d6fce3a1..73dd0c0ccc 100644 --- a/basis/colors/constants/constants-docs.factor +++ b/basis/colors/constants/constants-docs.factor @@ -23,7 +23,7 @@ HELP: COLOR: } ; ARTICLE: "colors.constants" "Standard color database" -"The " { $vocab-link "colors.constants" } " vocabulary bundles the X11 " { $snippet "rgb.txt" } " database and provides words for looking up color values." +"The " { $vocab-link "colors.constants" } " vocabulary bundles the X11 " { $snippet "rgb.txt" } " database and Factor's " { $snippet "factor-colors.txt" } " theme database to provide words for looking up color values by name." { $subsection named-color } { $subsection named-colors } { $subsection POSTPONE: COLOR: } ; diff --git a/basis/colors/constants/constants.factor b/basis/colors/constants/constants.factor index 98e7d43411..7c9b3ff535 100644 --- a/basis/colors/constants/constants.factor +++ b/basis/colors/constants/constants.factor @@ -19,7 +19,9 @@ IN: colors.constants [ parse-color ] H{ } map>assoc ; MEMO: rgb.txt ( -- assoc ) - "resource:basis/colors/constants/rgb.txt" utf8 file-lines parse-rgb.txt ; + "resource:basis/colors/constants/rgb.txt" + "resource:basis/colors/constants/factor-colors.txt" + [ utf8 file-lines parse-rgb.txt ] bi@ assoc-union ; PRIVATE> diff --git a/basis/colors/constants/factor-colors.txt b/basis/colors/constants/factor-colors.txt new file mode 100644 index 0000000000..9d7649ab3d --- /dev/null +++ b/basis/colors/constants/factor-colors.txt @@ -0,0 +1,5 @@ +! Factor UI theme colors +227 226 219 FactorLightTan +172 167 147 FactorDarkTan + 81 91 105 FactorLightSlateBlue + 55 62 72 FactorDarkSlateBlue diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index 2270088490..6e75adc8aa 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -87,7 +87,7 @@ ALIAS: $slot $snippet : ($code) ( presentation quot -- ) [ - snippet-style get [ + code-char-style get [ last-element off [ ($code-style) ] dip with-nesting ] with-style @@ -307,7 +307,7 @@ M: f ($instance) : ($see) ( word quot -- ) [ - snippet-style get [ + code-char-style get [ code-style get swap with-nesting ] with-style ] ($block) ; inline diff --git a/basis/help/stylesheet/stylesheet.factor b/basis/help/stylesheet/stylesheet.factor index c7811a605d..6c0b18e8e9 100644 --- a/basis/help/stylesheet/stylesheet.factor +++ b/basis/help/stylesheet/stylesheet.factor @@ -17,7 +17,7 @@ H{ SYMBOL: link-style H{ - { foreground COLOR: dark-blue } + { foreground COLOR: DodgerBlue4 } { font-style bold } } link-style set-global @@ -33,7 +33,8 @@ H{ { font-size 18 } { font-style bold } { wrap-margin 500 } - { page-color COLOR: light-gray } + { foreground COLOR: FactorDarkSlateBlue } + { page-color COLOR: FactorLightTan } { border-width 5 } } title-style set-global @@ -58,12 +59,18 @@ SYMBOL: snippet-style H{ { font-name "monospace" } { font-size 12 } - { foreground COLOR: navy-blue } + { foreground COLOR: DarkOrange4 } } snippet-style set-global +SYMBOL: code-char-style +H{ + { font-name "monospace" } + { font-size 12 } +} code-char-style set-global + SYMBOL: code-style H{ - { page-color COLOR: gray80 } + { page-color COLOR: FactorLightTan } { border-width 5 } { wrap-margin f } } code-style set-global @@ -74,7 +81,7 @@ H{ { font-style bold } } input-style set-global SYMBOL: url-style H{ { font-name "monospace" } - { foreground COLOR: blue } + { foreground COLOR: DodgerBlue4 } } url-style set-global SYMBOL: warning-style @@ -101,7 +108,7 @@ H{ SYMBOL: table-style H{ { table-gap { 5 5 } } - { table-border COLOR: light-gray } + { table-border COLOR: FactorLightTan } } table-style set-global SYMBOL: list-style diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor index 76cf8806f4..90e2388934 100644 --- a/basis/prettyprint/backend/backend.factor +++ b/basis/prettyprint/backend/backend.factor @@ -1,11 +1,12 @@ ! Copyright (C) 2003, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays byte-arrays byte-vectors continuations -generic hashtables assocs kernel math namespaces make sequences -strings sbufs vectors words prettyprint.config prettyprint.custom -prettyprint.sections quotations io io.pathnames io.styles math.parser -effects classes.tuple math.order classes.tuple.private classes -combinators colors ; +USING: accessors arrays assocs byte-arrays byte-vectors classes +classes.tuple classes.tuple.private colors colors.constants +combinators continuations effects generic hashtables io +io.pathnames io.styles kernel make math math.order math.parser +namespaces prettyprint.config prettyprint.custom +prettyprint.sections prettyprint.stylesheet quotations sbufs +sequences strings vectors words words.symbol ; IN: prettyprint.backend M: effect pprint* effect>string "(" ")" surround text ; @@ -20,17 +21,6 @@ M: effect pprint* effect>string "(" ")" surround text ; ?effect-height 0 < [ end-group ] when ; ! Atoms -: word-style ( word -- style ) - dup "word-style" word-prop >hashtable [ - [ - [ presented set ] - [ - [ parsing-word? ] [ delimiter? ] [ t eq? ] tri or or - [ bold font-style set ] when - ] bi - ] bind - ] keep ; - : word-name* ( word -- str ) name>> "( no name )" or ; @@ -59,6 +49,9 @@ M: real pprint* number>string text ; M: f pprint* drop \ f pprint-word ; +: pprint-effect ( effect -- ) + [ effect>string ] [ effect-style ] bi styled-text ; + ! Strings : ch>ascii-escape ( ch -- str ) H{ @@ -82,12 +75,6 @@ M: f pprint* drop \ f pprint-word ; ] when ] when ; -: string-style ( obj -- hash ) - [ - presented set - T{ rgba f 0.3 0.3 0.3 1.0 } foreground set - ] H{ } make-assoc ; - : unparse-string ( str prefix suffix -- str ) [ [ % do-string-limit [ unparse-ch ] each ] dip % ] "" make ; diff --git a/basis/prettyprint/stylesheet/stylesheet.factor b/basis/prettyprint/stylesheet/stylesheet.factor new file mode 100644 index 0000000000..2be959cc9b --- /dev/null +++ b/basis/prettyprint/stylesheet/stylesheet.factor @@ -0,0 +1,34 @@ +! Copyright (C) 2009 Your name. +! See http://factorcode.org/license.txt for BSD license. +USING: colors.constants hashtables io.styles kernel namespaces +words words.symbol ; +IN: prettyprint.stylesheet + +: word-style ( word -- style ) + dup "word-style" word-prop >hashtable [ + [ + [ presented set ] [ + [ parsing-word? ] [ delimiter? ] [ symbol? ] tri + or or [ COLOR: DarkSlateGray ] [ COLOR: black ] if + foreground set + ] bi + ] bind + ] keep ; + +: string-style ( obj -- style ) + [ + presented set + COLOR: LightSalmon4 foreground set + ] H{ } make-assoc ; + +: vocab-style ( vocab -- style ) + [ + presented set + COLOR: cornsilk4 foreground set + ] H{ } make-assoc ; + +: effect-style ( effect -- style ) + [ + presented set + COLOR: DarkGreen foreground set + ] H{ } make-assoc ; \ No newline at end of file diff --git a/basis/see/see.factor b/basis/see/see.factor index 1b3bd4bfb5..3b15e0ee6e 100644 --- a/basis/see/see.factor +++ b/basis/see/see.factor @@ -39,7 +39,7 @@ M: word print-stack-effect? drop t ; : stack-effect. ( word -- ) [ print-stack-effect? ] [ stack-effect ] bi and - [ effect>string comment. ] when* ; + [ pprint-effect ] when* ; { $values { "label" gadget } { "quot" { $quotation "( button -- )" } } { "button" "a new " { $link button } } } diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor index ec11bac2d3..352190c95f 100644 --- a/basis/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -10,7 +10,7 @@ combinators.smart ; FROM: models => change-model ; IN: ui.gadgets.buttons -TUPLE: button < border pressed? selected? quot ; +TUPLE: button < border pressed? selected? quot tooltip ; >>pressed? relayout-1 ; +: button-enter ( button -- ) + dup dup tooltip>> [ swap show-status ] [ drop ] if* button-update ; + +: button-leave ( button -- ) + dup "" swap show-status button-update ; + : button-clicked ( button -- ) dup button-update dup button-rollover? @@ -43,8 +49,8 @@ PRIVATE> button H{ { T{ button-up } [ button-clicked ] } { T{ button-down } [ button-update ] } - { mouse-leave [ button-update ] } - { mouse-enter [ button-update ] } + { mouse-leave [ button-leave ] } + { mouse-enter [ button-enter ] } } set-gestures : new-button ( label quot class -- button ) @@ -113,30 +119,18 @@ PRIVATE> [ append theme-image ] tri-curry@ tri ] 2dip ; -CONSTANT: button-background - T{ rgba - f - 0.8901960784313725 - 0.8862745098039215 - 0.8588235294117647 - 1.0 - } +CONSTANT: button-background COLOR: FactorLightTan +CONSTANT: button-clicked-background COLOR: FactorDarkSlateBlue -CONSTANT: button-clicked-background - T{ rgba - f - 0.2156862745098039 - 0.2431372549019608 - 0.2823529411764706 - 1.0 - } - : ( -- pen ) - "button" button-background COLOR: black dup - "button-clicked" button-clicked-background COLOR: white dup dup + "button" button-background button-clicked-background + dup + "button-clicked" button-clicked-background COLOR: white + dup dup ; : border-button-theme ( gadget -- gadget ) + dup children>> first font>> t >>bold? drop horizontal >>orientation >>interior dup dup interior>> pen-pref-dim >>min-dim @@ -235,9 +229,12 @@ PRIVATE> : command-button-quot ( target command -- quot ) '[ _ _ invoke-command ] ; +: gesture>tooltip ( gesture -- str ) + [ gesture>string "Shortcut: " prepend ] [ "Shortcut Unassigned" ] if* ; + : ( target gesture command -- button ) - [ command-string swap ] keep command-button-quot - '[ drop @ ] ; + swapd [ command-name swap ] keep command-button-quot + '[ drop @ ] swap gesture>tooltip >>tooltip ; : ( target -- toolbar ) diff --git a/basis/ui/gadgets/labels/labels.factor b/basis/ui/gadgets/labels/labels.factor index eb992f1428..83d15911e7 100644 --- a/basis/ui/gadgets/labels/labels.factor +++ b/basis/ui/gadgets/labels/labels.factor @@ -4,7 +4,7 @@ USING: accessors arrays hashtables io kernel math math.functions namespaces make opengl sequences strings splitting ui.gadgets ui.gadgets.tracks ui.gadgets.packs fonts ui.render ui.pens.solid ui.baseline-alignment ui.text colors colors.constants models -combinators ; +combinators opengl.gl ; IN: ui.gadgets.labels ! A label gadget draws a string. diff --git a/basis/ui/gadgets/status-bar/status-bar.factor b/basis/ui/gadgets/status-bar/status-bar.factor index 0d3015508e..5c4b5d9823 100644 --- a/basis/ui/gadgets/status-bar/status-bar.factor +++ b/basis/ui/gadgets/status-bar/status-bar.factor @@ -1,13 +1,23 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors models models.delay models.arrow -sequences ui.gadgets.labels ui.gadgets.tracks -ui.gadgets.worlds ui.gadgets ui ui.private kernel calendar summary ; +USING: accessors calendar colors colors.constants fonts kernel +models models.arrow models.delay sequences summary ui +ui.gadgets ui.gadgets.labels ui.gadgets.tracks +ui.gadgets.worlds ui.pens.solid ui.private ; IN: ui.gadgets.status-bar +: status-bar-font ( -- font ) + sans-serif-font clone + COLOR: FactorDarkSlateBlue >>background + COLOR: white >>foreground ; + +: status-bar-theme ( label -- label ) + status-bar-font >>font + COLOR: FactorDarkSlateBlue >>interior ; + : ( model -- gadget ) 1/10 seconds [ "" like ] - reverse-video-theme + status-bar-theme t >>root? ; : open-status-window ( gadget title/attributes -- ) diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor index 21d827da9b..d3aa56a694 100644 --- a/basis/ui/tools/browser/browser.factor +++ b/basis/ui/tools/browser/browser.factor @@ -11,7 +11,7 @@ ui.gadgets.viewports ui.tools.common ui.tools.browser.popups ui.tools.browser.history ; IN: ui.tools.browser -TUPLE: browser-gadget < tool history pane scroller search-field popup ; +TUPLE: browser-gadget < tool history scroller search-field popup ; { 650 400 } browser-gadget set-tool-dim @@ -59,9 +59,8 @@ M: browser-gadget set-history-value dup >>history dup >>search-field dup { 3 3 } { 1 0 } >>fill f track-add - dup >>pane - dup pane>> >>scroller - dup scroller>> 1 track-add ; + dup dup { 10 0 } { 1 1 } >>fill + >>scroller scroller>> 1 track-add ; M: browser-gadget graft* [ add-definition-observer ] [ call-next-method ] bi ; diff --git a/basis/vocabs/prettyprint/prettyprint.factor b/basis/vocabs/prettyprint/prettyprint.factor index 66bc277ef7..2813485da3 100644 --- a/basis/vocabs/prettyprint/prettyprint.factor +++ b/basis/vocabs/prettyprint/prettyprint.factor @@ -1,12 +1,13 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel sorting sequences vocabs io io.styles arrays assocs -namespaces sets parser colors prettyprint.backend prettyprint.sections -vocabs.parser make fry math.order ; +USING: accessors arrays assocs colors colors.constants fry io +io.styles kernel make math.order namespaces parser +prettyprint.backend prettyprint.sections prettyprint.stylesheet +sequences sets sorting vocabs vocabs.parser ; IN: vocabs.prettyprint : pprint-vocab ( vocab -- ) - [ vocab-name ] [ vocab ] bi present-text ; + [ vocab-name ] [ vocab vocab-style ] bi styled-text ; : pprint-in ( vocab -- ) [ \ IN: pprint-word pprint-vocab ] with-pprint ; @@ -85,7 +86,7 @@ PRIVATE> "To avoid doing this in the future, add the following forms" print "at the top of the source file:" print nl ] with-style - { { page-color T{ rgba f 0.8 0.8 0.8 1.0 } } } + { { page-color COLOR: FactorLightTan } } [ manifest get pprint-manifest ] with-nesting nl nl ] print-use-hook set-global \ No newline at end of file