colors.constants: better prettyprinting of COLOR: syntax.

diff --git a/basis/colors/constants/constants-docs.factor b/basis/colors/constants/constants-docs.factor
index 840a77f472808fb4a9982845d18d140ec30a8860..14a22d9809f978489fc395e0c246efc673b6deeb 100644 (file)
--- a/basis/colors/constants/constants-docs.factor
+++ b/basis/colors/constants/constants-docs.factor
@@ -1,7 +1,7 @@
 IN: colors.constants
 USING: help.markup help.syntax strings colors ;
 
-HELP: named-color
+HELP: lookup-color
 { $values { "name" string } { "color" color } }
 { $description "Outputs a named color from the color database." }
 { $notes "In most cases, " { $link POSTPONE: COLOR: } " should be used instead." }
@@ -25,7 +25,7 @@ HELP: COLOR:
 ARTICLE: "colors.constants" "Standard color database"
 "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."
 { $subsections
-    named-color
+    lookup-color
     named-colors
     POSTPONE: COLOR:
 } ;

diff --git a/basis/colors/constants/constants-tests.factor b/basis/colors/constants/constants-tests.factor
index 4c453df53c8ec09ae080f037091864b8353b350a..08d4d55e9cbd8602b80baa227af8ca987f2cad53 100644 (file)
--- a/basis/colors/constants/constants-tests.factor
+++ b/basis/colors/constants/constants-tests.factor
@@ -2,4 +2,4 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: colors colors.constants tools.test ;
 
-{ t } [ COLOR: light-green rgba? ] unit-test
+{ t } [ COLOR: light-green value>> rgba? ] unit-test

diff --git a/basis/colors/constants/constants.factor b/basis/colors/constants/constants.factor
index 0fc48c295b83e0ea679da55a8900c15cd9ae8700..2d64aa8c77fecea5bdda29e3edaf2262872bbe44 100644 (file)
--- a/basis/colors/constants/constants.factor
+++ b/basis/colors/constants/constants.factor
@@ -1,7 +1,10 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel assocs math math.parser memoize io.encodings.utf8
-io.files lexer parser colors sequences splitting ascii ;
+
+USING: accessors ascii assocs colors io.encodings.utf8 io.files
+kernel lexer math math.parser sequences splitting vocabs.loader
+;
+
 IN: colors.constants
 
 <PRIVATE
@@ -28,7 +31,13 @@ PRIVATE>
 
 ERROR: no-such-color name ;
 
-: named-color ( name -- color )
+: lookup-color ( name -- color )
     dup colors at [ ] [ no-such-color ] ?if ;
 
-SYNTAX: COLOR: scan-token named-color suffix! ;
+TUPLE: named-color < color name value ;
+
+M: named-color >rgba value>> >rgba ;
+
+SYNTAX: COLOR: scan-token dup lookup-color named-color boa suffix! ;
+
+{ "colors.constants" "prettyprint" } "colors.constants.prettyprint" require-when

diff --git a/basis/colors/constants/prettyprint/prettyprint.factor b/basis/colors/constants/prettyprint/prettyprint.factor
new file mode 100644 (file)
index 0000000..65e61af
--- /dev/null
+++ b/basis/colors/constants/prettyprint/prettyprint.factor
@@ -0,0 +1,7 @@
+USING: accessors colors.constants prettyprint.custom
+prettyprint.backend prettyprint.sections ;
+
+IN: colors.constants.prettyprint
+
+M: named-color pprint* \ COLOR: [ name>> text ] pprint-prefix ;
+

diff --git a/basis/ui/tools/listener/completion/completion.factor b/basis/ui/tools/listener/completion/completion.factor
index d2ee015b7de5e33b859e95dd583676c1ef9dad7e..f3a423e6d955c8f9182d5557806a32df8d108005 100644 (file)
--- a/basis/ui/tools/listener/completion/completion.factor
+++ b/basis/ui/tools/listener/completion/completion.factor
@@ -96,7 +96,7 @@ M: vocab-completion row-color
     ] [ drop COLOR: dark-gray ] if ;
 
 M: color-completion row-color
-    drop second named-color ;
+    drop second lookup-color ;
 
 : up-to-caret ( caret document -- string )
     [ { 0 0 } ] 2dip doc-range ;

diff --git a/extra/color-table/color-table.factor b/extra/color-table/color-table.factor
index b096ff883576ba00a04f27e463df6c41e4eaced8..296c39264ee27fb72f738d3760b1199e4b2e9cc6 100644 (file)
--- a/extra/color-table/color-table.factor
+++ b/extra/color-table/color-table.factor
@@ -24,7 +24,7 @@ M: color-renderer column-titles
 M: color-renderer row-columns
     drop [
         full-block-string swap
-        dup named-color {
+        dup lookup-color {
             [ red>> "%.5f" sprintf ]
             [ green>> "%.5f" sprintf ]
             [ blue>> "%.5f" sprintf ]
@@ -33,10 +33,10 @@ M: color-renderer row-columns
     ] output>array ;
 
 M: color-renderer row-color
-    drop named-color ;
+    drop lookup-color ;
 
 M: color-renderer row-value
-    drop named-color ;
+    drop lookup-color ;
 
 : <color-table> ( -- table )
     named-colors { human<=> } sort-by <model>