! Copyright (C) 2009 Keith Lazuka, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: assocs colors combinators
-combinators.short-circuit hashtables io.styles kernel literals
-namespaces sequences ui.theme words words.symbol ;
+USING: assocs colors io.styles kernel namespaces sequences words ;
IN: prettyprint.stylesheet
<PRIVATE
{ POSTPONE: USING: POSTPONE: USE: POSTPONE: IN: }
[
- { { foreground $ dim-color } }
+ { { foreground COLOR: gray35 } }
"word-style" set-word-prop
] each
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 ;
-: vocab-style ( vocab -- style )
- dim-color colored-presentation-style ;
+SYMBOL: base-vocab-style
+H{
+ { foreground COLOR: gray35 }
+} base-vocab-style set-global
-SYMBOL: stack-effect-style
+: vocab-style ( vocab -- style )
+ presented base-vocab-style get clone [ set-at ] keep ;
+SYMBOL: base-effect-style
H{
- { foreground $ stack-effect-color }
+ { foreground COLOR: FactorDarkSlateBlue }
{ font-style plain }
-} stack-effect-style set-global
+} base-effect-style set-global
: effect-style ( effect -- style )
- presented associate stack-effect-style get assoc-union! ;
+ presented base-effect-style get clone [ set-at ] keep ;