Skip to content
This repository
Browse code

ui.tools.listener: adding COLOR: completions.

  • Loading branch information...
commit a8e0ccfd5f4ca32b27fe42a5a7693a28f0bb49ab 1 parent f2a1ec7
John Benediktsson authored September 24, 2012
14  basis/ui/tools/listener/completion/completion.factor
@@ -26,9 +26,10 @@ SLOT: history
26 26
 TUPLE: word-completion manifest ;
27 27
 C: <word-completion> word-completion
28 28
 
29  
-SINGLETONS: vocab-completion char-completion history-completion ;
  29
+SINGLETONS: vocab-completion color-completion char-completion history-completion ;
30 30
 UNION: definition-completion word-completion vocab-completion ;
31  
-UNION: listener-completion definition-completion char-completion history-completion ;
  31
+UNION: listener-completion definition-completion
  32
+color-completion char-completion history-completion ;
32 33
 
33 34
 GENERIC: completion-quot ( interactor completion-mode -- quot )
34 35
 
@@ -37,6 +38,7 @@ GENERIC: completion-quot ( interactor completion-mode -- quot )
37 38
 
38 39
 M: word-completion completion-quot [ words-matching ] (completion-quot) ;
39 40
 M: vocab-completion completion-quot [ vocabs-matching ] (completion-quot) ;
  41
+M: color-completion completion-quot [ colors-matching ] (completion-quot) ;
40 42
 M: char-completion completion-quot [ chars-matching ] (completion-quot) ;
41 43
 M: history-completion completion-quot drop '[ _ history-completions ] ;
42 44
 
@@ -49,6 +51,7 @@ GENERIC: completion-banner ( completion-mode -- string )
49 51
 
50 52
 M: word-completion completion-banner drop "Words" ;
51 53
 M: vocab-completion completion-banner drop "Vocabularies" ;
  54
+M: color-completion completion-banner drop "Colors" ;
52 55
 M: char-completion completion-banner drop "Unicode code point names" ;
53 56
 M: history-completion completion-banner drop "Input history" ;
54 57
 
@@ -75,6 +78,9 @@ M: word-completion row-color
75 78
 M: vocab-completion row-color
76 79
     drop vocab? COLOR: black COLOR: dark-gray ? ;
77 80
 
  81
+M: color-completion row-color
  82
+    drop named-color ;
  83
+
78 84
 : (complete-vocab?) ( str -- ? )
79 85
     { "IN:" "USE:" "UNUSE:" "QUALIFIED:" "QUALIFIED-WITH:" }
80 86
     member? ; inline
@@ -96,6 +102,9 @@ M: vocab-completion row-color
96 102
 : complete-CHAR:? ( tokens -- ? )
97 103
     2 short tail* "CHAR:" swap member? ;
98 104
 
  105
+: complete-COLOR:? ( tokens -- ? )
  106
+    2 short tail* "COLOR:" swap member? ;
  107
+
99 108
 : up-to-caret ( caret document -- string )
100 109
     [ { 0 0 } ] 2dip doc-range ;
101 110
 
@@ -104,6 +113,7 @@ M: vocab-completion row-color
104 113
     {
105 114
         { [ dup { [ complete-vocab? ] [ complete-vocab-list? ] } 1|| ] [ 2drop vocab-completion ] }
106 115
         { [ dup complete-CHAR:? ] [ 2drop char-completion ] }
  116
+        { [ dup complete-COLOR:? ] [ 2drop color-completion ] }
107 117
         [ drop <word-completion> ]
108 118
     } cond ;
109 119
 
5  basis/ui/tools/listener/listener.factor
@@ -62,8 +62,9 @@ M: word-completion (word-at-caret)
62 62
         '[ _ _ search-manifest ] [ drop f ] recover
63 63
     ] [ 2drop f ] if ;
64 64
 
65  
-M: char-completion (word-at-caret)
66  
-    2drop f ;
  65
+M: char-completion (word-at-caret) 2drop f ;
  66
+
  67
+M: color-completion (word-at-caret) 2drop f ;
67 68
 
68 69
 : word-at-caret ( token interactor -- obj )
69 70
     completion-mode (word-at-caret) ;

0 notes on commit a8e0ccf

Please sign in to comment.
Something went wrong with that request. Please try again.