factor: trim using lists

[factor.git] / basis / prettyprint / stylesheet / stylesheet.factor

diff --git a/basis/prettyprint/stylesheet/stylesheet.factor b/basis/prettyprint/stylesheet/stylesheet.factor
index eaed7cba0c1a10119cf8e2b30c90dd6fbf4f997b..7f0e29155187fca1528b5260ee5cbc3ac3d9b6ea 100644 (file)
--- a/basis/prettyprint/stylesheet/stylesheet.factor
+++ b/basis/prettyprint/stylesheet/stylesheet.factor
@@ -1,50 +1,58 @@
-! Copyright (C) 2009 Your name.
+! Copyright (C) 2009 Keith Lazuka, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: colors.constants combinators combinators.short-circuit
-hashtables io.styles kernel namespaces sequences words
-words.symbol ;
+USING: assocs colors io.styles kernel namespaces sequences words ;
 IN: prettyprint.stylesheet
 
 <PRIVATE
 
-CONSTANT: dim-color COLOR: cornsilk4
+{ POSTPONE: USING: POSTPONE: USE: POSTPONE: IN: }
+[
+    { { foreground COLOR: gray35 } }
+    "word-style" set-word-prop
+] each
 
-: dimly-lit-word? ( word -- ? )
-    { POSTPONE: USING: POSTPONE: USE: POSTPONE: IN: } memq? ;
-
-: parsing-word-color ( word -- color )
-    dimly-lit-word? dim-color COLOR: DarkSlateGray ? ;
+PREDICATE: highlighted-word < word [ parsing-word? ] [ delimiter? ] bi or ;
 
 PRIVATE>
 
-: word-style ( word -- style )
-    dup "word-style" word-prop >hashtable [
-        [
-            [ presented set ] [
-                {
-                    { [ dup parsing-word? ] [ parsing-word-color ] }
-                    { [ dup delimiter? ] [ drop COLOR: DarkSlateGray ] }
-                    { [ dup symbol? ] [ drop COLOR: DarkSlateGray ] }
-                    [ drop COLOR: black ]
-                } cond foreground set
-            ] bi
-        ] bind
-    ] keep ;
-
-: string-style ( obj -- style )
-    [
-        presented set
-        COLOR: LightSalmon4 foreground set
-    ] H{ } make-assoc ;
+SYMBOL: base-word-style
+H{ } base-word-style set-global
+
+GENERIC: word-style ( word -- style )
+
+M: word word-style
+    [ presented base-word-style get clone [ set-at ] keep ]
+    [ "word-style" word-prop ] bi assoc-union! ;
+
+SYMBOL: highlighted-word-style
+H{
+    { foreground COLOR: DarkSlateGray }
+} highlighted-word-style set-global
+
+M: highlighted-word word-style
+    call-next-method highlighted-word-style get assoc-union! ;
+
+SYMBOL: base-string-style
+H{
+    { foreground COLOR: LightSalmon4 }
+} base-string-style set-global
+
+: string-style ( str -- 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 )
-    [
-        presented set
-        dim-color foreground set
-    ] H{ } make-assoc ;
+    presented base-vocab-style get clone [ set-at ] keep ;
+
+SYMBOL: base-effect-style
+H{
+    { foreground COLOR: FactorDarkSlateBlue }
+    { font-style plain }
+} base-effect-style set-global
 
 : effect-style ( effect -- style )
-    [
-        presented set
-        COLOR: DarkGreen foreground set
-    ] H{ } make-assoc ;
\ No newline at end of file
+    presented base-effect-style get clone [ set-at ] keep ;