cmdr
Check-in [ddd5e520dd]
Not logged in
Myself Home DocumentationDownloads Tickets | Timeline Branches Tags Wiki Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:cmdr::color - Fixed issues, expanded functionality, better checking. Plus testsuite.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ddd5e520dd23fb7b97ac4f7e2f4f5578a14f62dc
User & Date: aku 2014-05-23 07:13:21.002
References
2014-05-23
22:17 • Ticket [8502a858bd] Add facility for colorization status still Closed with 3 other changes artifact: 2239702142 user: aku
22:17 • Closed ticket [8502a858bd]. artifact: 26dcf622de user: aku
Context
2014-05-23
20:42
cmdr::ask - Reactivated color support. No tests yet. check-in: 0c33d13e6e user: andreask tags: trunk
07:13
cmdr::color - Fixed issues, expanded functionality, better checking. Plus testsuite. check-in: ddd5e520dd user: aku tags: trunk
06:19
cmdr::tty - Fixed package provision typo, plus testsuite for same. check-in: e8bf343c87 user: aku tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to color.tcl.
︙︙
22
23
24
25
26
27
28
29





30
31

32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67


















































68
69
70
71

72
73

74
75
76
77
78
79
80
81
82
83
84
85
86




87

88
89
90
91
92
93


94




95
96
97
98
99
100
101

102
103
104
105
106
107
108
109
110
111

112
113
114
115
116
117
118


package require Tcl 8.5
package require debug
package require debug::caller
package require cmdr::tty

# # ## ### ##### ######## ############# #####################






namespace eval ::cmdr::color {
    namespace export activate active define

    namespace ensemble create \
	-unknown [namespace current]::Unknown
    # Note, the option ensures that all unknown methods are treated as
    # (list of) color codes to apply to some text, effectively
    # creating the virtual command
    #
    #    ::cmdr::color <codelist> <text>
    ##

    namespace import ::cmdr::tty
}

# # ## ### ##### ######## ############# #####################

debug define cmdr/color
debug level  cmdr/color
debug prefix cmdr/color {[debug caller] | }

# # ## ### ##### ######## ############# #####################
## TODO undef?
## TODO multi-def (load)
## TODO get (display)
## officer and private for std commands (show, define).

proc ::cmdr::color::activate {{flag 1}} {
    debug.cmdr/color {}
    variable active $flag
    return
}

proc ::cmdr::color::active {} {
    debug.cmdr/color {}
    variable active
    return  $active
}



















































proc ::cmdr::color::define {name spec} {
    debug.cmdr/color {}
    variable def
    variable char

    # TODO: spec may be
    # => reference to other color name, or

    # => raw control sequence, or
    # => RGB spec.

    # Syntax:
    # ref = anything already found as key in the database.
    # rgb = 
    # raw = 

    if {[dict exists $def $spec]} {
	if {$spec eq $name} {
	    return -code error \
		-errorcode [list CMDR COLOR CIRCLE $name] \
		"Rejected self-referential definition of \"$name\""




	}

	debug.cmdr/color {reference, resolved => [S [dict get $char $spec]]}
	dict set def  $name $spec
	dict set char $name [dict get $char $spec]
	return
    }



    if {[regexp {^%(\d+),(\d+),(\d+)$} $spec -> r g b]} {




	# R, G, B all in range 0..5
	set r [Clamp $r]
	set g [Clamp $g]
	set b [Clamp $b]
	# 256 mapping
	# code = 16 + 36R + 6G + B --> [16..236]
	set code [expr {16 + 36*$r + 6*$g + $b}]

	debug.cmdr/color {RGB encoded => [S [C $code]]}
	dict set def  $name $spec
	dict set char $name [C $code]
	return

	# Legacy mapping
	# R,G,B mapping 0,1 --> 0, 2,3 --> 1, 4,5 --> 2
	# bold mapping: 0,1,2 --> 0,1,1 (set if any of R, G, B)
	# code = 8bold + R + 2G + 4B
	#      = 8, for R==G==B != 0, special case.

    }

    # Raw control sequence, simply save
    dict set def  $name $spec
    dict set char $name $spec
    return
}









>
>
>
>
>

|
>



















<
|
<
|













>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




>
|
|
>
|
<


|
|
|

|
|



>
>
>
>
|
>
|
|
|
|
|
|
>
>
|
>
>
>
>
|
|
|
|
|
|
|
>
|
|
|
|

|
|
|
|
|
>








22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56

57

58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130

131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186


package require Tcl 8.5
package require debug
package require debug::caller
package require cmdr::tty

# # ## ### ##### ######## ############# #####################

namespace eval ::cmdr {
    namespace export color
    namespace ensemble create
}

namespace eval ::cmdr::color {
    namespace export \
	activate active names get get-def define exists unset
    namespace ensemble create \
	-unknown [namespace current]::Unknown
    # Note, the option ensures that all unknown methods are treated as
    # (list of) color codes to apply to some text, effectively
    # creating the virtual command
    #
    #    ::cmdr::color <codelist> <text>
    ##

    namespace import ::cmdr::tty
}

# # ## ### ##### ######## ############# #####################

debug define cmdr/color
debug level  cmdr/color
debug prefix cmdr/color {[debug caller] | }

# # ## ### ##### ######## ############# #####################

## TODO multi-def aka bulk-def aka load

## TODO officer and private for std commands (show, define).

proc ::cmdr::color::activate {{flag 1}} {
    debug.cmdr/color {}
    variable active $flag
    return
}

proc ::cmdr::color::active {} {
    debug.cmdr/color {}
    variable active
    return  $active
}

proc ::cmdr::color::names {} {
    debug.cmdr/color {}
    variable def
    return [dict keys $def]
}

proc ::cmdr::color::unset {name} {
    debug.cmdr/color {}
    variable def
    if {![dict exists $def $name]} {
	return -code error \
	    -errorcode [list CMDR COLOR BAD $name] \
	    "Expected a color name, got \"$name\""
    }

    variable char
    dict unset def  $name
    dict unset char $name
    return
}

proc ::cmdr::color::get {name} {
    debug.cmdr/color {}
    variable def
    if {![dict exists $def $name]} {
	return -code error \
	    -errorcode [list CMDR COLOR BAD $name] \
	    "Expected a color name, got \"$name\""
    }
    variable char
    return [dict get $char $name]
}

proc ::cmdr::color::get-def {name} {
    debug.cmdr/color {}
    variable def
    if {![dict exists $def $name]} {
	return -code error \
	    -errorcode [list CMDR COLOR BAD $name] \
	    "Expected a color name, got \"$name\""
    }
    return [dict get $def $name]
}

proc ::cmdr::color::exists {name} {
    debug.cmdr/color {}
    variable def
    return [dict exists $def $name]
}

proc ::cmdr::color::define {name spec} {
    debug.cmdr/color {}
    variable def
    variable char

    # The spec may be
    # (1) A reference to other color name.
    # (2) An RGB spec.
    # (3) A raw control sequence.


    # Syntax:
    # (1) ref := =<name>
    # (2) rgb := %<r>,<g>,<b>
    # (3) raw := anything else

    if {[regexp {^=(.*)$} $spec -> ref]} {
	if {$ref eq $name} {
	    return -code error \
		-errorcode [list CMDR COLOR CIRCLE $name] \
		"Rejected self-referential definition of \"$name\""
	} elseif {![dict exists $def $ref]} {
	    return -code error \
		-errorcode [list CMDR COLOR BAD $ref] \
		"Expected a color name, got \"$ref\""
	} else {
	    set raw [dict get $char $ref]
	    debug.cmdr/color {reference, resolved => [Quote $raw]}
	    dict set def  $name $spec
	    dict set char $name $raw
	    return
	}
    }

    if {[regexp {^%(.*)$} $spec -> rgb]} {
	if {![regexp {^(\d+),(\d+),(\d+)$} $rgb -> r g b]} {
	    return -code error \
		-errorcode [list CMDR COLOR BAD-RGB SYNTAX $rgb] \
		"Expected an RGB tuple, got \"$rgb\""
	} {
	    # R, G, B all in range 0..5
	    Clamp R $r
	    Clamp G $g
	    Clamp B $b
	    # 256-color mapping
	    # code = 16 + 36R + 6G + B --> [16..236]
	    set point [expr {16 + 36*$r + 6*$g + $b}]
	    set code [Code $point]
	    debug.cmdr/color {RGB encoded => [Quote $code]}
	    dict set def  $name $spec
	    dict set char $name $code
	    return

	    # Legacy mapping
	    # R,G,B mapping 0,1 --> 0, 2,3 --> 1, 4,5 --> 2
	    # bold mapping: 0,1,2 --> 0,1,1 (set if any of R, G, B)
	    # code = 8bold + R + 2G + 4B
	    #      = 8, for R==G==B != 0, special case.
	}
    }

    # Raw control sequence, simply save
    dict set def  $name $spec
    dict set char $name $spec
    return
}
︙︙
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164


165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228

229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271

    if {!$active} {
	debug.cmdr/color {not active}
	return $text
    }

    variable char
    foreach c $codes {
	if {[dict exists $char $c]} {
	    return -code error \
		-errorcode [list CMDR COLOR UNKNOWN $c] \
		"Expected a color name, got \"$c\""
	}
	append r [dict get $char $c]
    }
    append r $text
    append r [dict get $char reset]

    debug.cmdr/color {/done}
    return $r
}

proc ::cmdr::color::S {text} {
    # quote all non-printable characters (< space, > ~)
    variable smap
    return [string map $smap $text]
}

proc ::cmdr::color::C {args} {
    return \033\[[join $args \;]m
}

proc ::cmdr::color::Clamp {x} {
    if {$x < 0} { return 0 }
    if {$x > 5} { return 5 }
    return $x


}

# # ## ### ##### ######## ############# #####################

namespace eval ::cmdr::color {
    # Boolean flag controlling use of color sequences.
    # Default based on tty-ness of stdout. Active if yes.
    variable active [tty stdout]

    # Database (dictionary) of standard colors and associated codes.
    # Based on the standard ANSI colors (16-color terminal). The two
    # dictionaries hold the user-level specification and the
    # full-resolved character sequence.

    variable def  {}
    variable char {}

    # Colors. Foreground/Text.
    define  black        [C 30]  ; # Black  
    define  red          [C 31]  ; # Red    
    define  green        [C 32]  ; # Green  
    define  yellow       [C 33]  ; # Yellow 
    define  blue         [C 34]  ; # Blue   
    define  magenta      [C 35]  ; # Magenta
    define  cyan         [C 36]  ; # Cyan   
    define  white        [C 37]  ; # White  
    define  default      [C 39]  ; # Default (Black)

    # Colors. Background.
    define  bg-black     [C 40]  ; # Black  
    define  bg-red       [C 41]  ; # Red    
    define  bg-green     [C 42]  ; # Green  
    define  bg-yellow    [C 43]  ; # Yellow 
    define  bg-blue      [C 44]  ; # Blue   
    define  bg-magenta   [C 45]  ; # Magenta
    define  bg-cyan      [C 46]  ; # Cyan   
    define  bg-white     [C 47]  ; # White  
    define  bg-default   [C 49]  ; # Default (Transparent)

    # Non-color attributes. Activation.
    define  bold         [C  1]  ; # Bold  
    define  dim          [C  2]  ; # Dim
    define  italic       [C  3]  ; # Italics      
    define  underline    [C  4]  ; # Underscore   
    define  blink        [C  5]  ; # Blink
    define  revers       [C  7]  ; # Reverse      
    define  hidden       [C  8]  ; # Hidden
    define  strike       [C  9]  ; # StrikeThrough

    # Non-color attributes. Deactivation.
    define  no-bold      [C 22]  ; # Bold  
    define  no-dim       [C __]  ; # Dim
    define  no-italic    [C 23]  ; # Italics      
    define  no-underline [C 24]  ; # Underscore   
    define  no-blink     [C 25]  ; # Blink
    define  no-revers    [C 27]  ; # Reverse      
    define  no-hidden    [C 28]  ; # Hidden
    define  no-strike    [C 29]  ; # StrikeThrough

    # Remainder
    define  reset        [C  0]  ; # Reset

    # And now the standard symbolic names


    define  confirm red
    define  error   red
    define  warning yellow
    define  note    blue
    define  good    green
    define  name    blue

    # header command stopped advisory crashed failure success name prompt table warning
    # bl/whi bl/yel  bl/grey bl/yel   bl/red  bl/red  bl/gre  bl/cy bl/cy bl/cy bl/mag
    # stdout - white, stderr - red
    # app-header sys-header
    # bl/yel     bl/cy

    # others ...
    # name	<>	blue,
    # neutral	<>	blue,
    # good	<>	green,
    # bad	<>	red,
    # error	<>	magenta,
    # unknown	<>	cyan,
    # warning	<>	yellow,
    # instance<>	yellow,
    # number	<>	green,
    # prompt	<>	blue,
    # yes	<>	green,
    # no	<>	red

    variable smap {}
}

apply {{} {
    variable smap
    for {set i 0} {$i < 32} {incr i} {
	set c [format %c $i]
	set o \\[format %03o $i] 
	lappend smap $c $o
    }
    lappend smap \127 \\127
}} ::cmdr::color

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::color 0








|













|





|



|
|
<
|
>
>


















|
|
|
|
|
|
|
|
|


|
|
|
|
|
|
|
|
|


|
|
|
|
|
|
|
|


|
|
|
|
|
|
|
|


|


|
>
|
|
<
<
|
|
|
<
<
<
<
<
|
<
|
<
|
<
|
|
|
<
|
<
<
<












|





198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230

231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300


301
302
303





304

305

306

307
308
309

310



311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327

    if {!$active} {
	debug.cmdr/color {not active}
	return $text
    }

    variable char
    foreach c $codes {
	if {![dict exists $char $c]} {
	    return -code error \
		-errorcode [list CMDR COLOR UNKNOWN $c] \
		"Expected a color name, got \"$c\""
	}
	append r [dict get $char $c]
    }
    append r $text
    append r [dict get $char reset]

    debug.cmdr/color {/done}
    return $r
}

proc ::cmdr::color::Quote {text} {
    # quote all non-printable characters (< space, > ~)
    variable smap
    return [string map $smap $text]
}

proc ::cmdr::color::Code {args} {
    return \033\[[join $args \;]m
}

proc ::cmdr::color::Clamp {label x} {
    if {($x >= 0) && ($x <= 5)} { return $x }

    return -code error \
	-errorcode [list CMDR COLOR BAD-RGB RANGE $x] \
	"RGB channel $label out of range, got $x"
}

# # ## ### ##### ######## ############# #####################

namespace eval ::cmdr::color {
    # Boolean flag controlling use of color sequences.
    # Default based on tty-ness of stdout. Active if yes.
    variable active [tty stdout]

    # Database (dictionary) of standard colors and associated codes.
    # Based on the standard ANSI colors (16-color terminal). The two
    # dictionaries hold the user-level specification and the
    # full-resolved character sequence.

    variable def  {}
    variable char {}

    # Colors. Foreground/Text.
    define  black        [Code 30]  ; # Black  
    define  red          [Code 31]  ; # Red    
    define  green        [Code 32]  ; # Green  
    define  yellow       [Code 33]  ; # Yellow 
    define  blue         [Code 34]  ; # Blue   
    define  magenta      [Code 35]  ; # Magenta
    define  cyan         [Code 36]  ; # Cyan   
    define  white        [Code 37]  ; # White  
    define  default      [Code 39]  ; # Default (Black)

    # Colors. Background.
    define  bg-black     [Code 40]  ; # Black  
    define  bg-red       [Code 41]  ; # Red    
    define  bg-green     [Code 42]  ; # Green  
    define  bg-yellow    [Code 43]  ; # Yellow 
    define  bg-blue      [Code 44]  ; # Blue   
    define  bg-magenta   [Code 45]  ; # Magenta
    define  bg-cyan      [Code 46]  ; # Cyan   
    define  bg-white     [Code 47]  ; # White  
    define  bg-default   [Code 49]  ; # Default (Transparent)

    # Non-color attributes. Activation.
    define  bold         [Code  1]  ; # Bold  
    define  dim          [Code  2]  ; # Dim
    define  italic       [Code  3]  ; # Italics      
    define  underline    [Code  4]  ; # Underscore   
    define  blink        [Code  5]  ; # Blink
    define  revers       [Code  7]  ; # Reverse      
    define  hidden       [Code  8]  ; # Hidden
    define  strike       [Code  9]  ; # StrikeThrough

    # Non-color attributes. Deactivation.
    define  no-bold      [Code 22]  ; # Bold  
    define  no-dim       [Code __]  ; # Dim
    define  no-italic    [Code 23]  ; # Italics      
    define  no-underline [Code 24]  ; # Underscore   
    define  no-blink     [Code 25]  ; # Blink
    define  no-revers    [Code 27]  ; # Reverse      
    define  no-hidden    [Code 28]  ; # Hidden
    define  no-strike    [Code 29]  ; # StrikeThrough

    # Remainder
    define  reset        [Code  0]  ; # Reset

    # And now the standard symbolic names
    define  advisory =yellow
    define  bad      =red
    define  confirm  =red
    define  error    =magenta


    define  good     =green
    define  name     =blue
    define  neutral  =blue





    define  no       =red

    define  note     =blue

    define  number   =green

    define  prompt   =blue
    define  unknown  =cyan
    define  warning  =yellow

    define  yes      =green




    variable smap {}
}

apply {{} {
    variable smap
    for {set i 0} {$i < 32} {incr i} {
	set c [format %c $i]
	set o \\[format %03o $i] 
	lappend smap $c $o
    }
    lappend smap \127 \\127
} ::cmdr::color}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::color 0
Added tests/color.test. 




































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401

# -*- tcl -*- tcl.tk//DSL tcltest//EN//2.0
# # ## ### ##### ######## ############# #####################
## Testing the cmdr::color package.

kt check Tcl     8.5
kt check tcltest 2

kt require support Tclx
kt require support debug
kt require support debug::caller

kt local   support cmdr::tty
kt local   testing cmdr::color

set thecolors {advisory bad bg-black bg-blue bg-cyan bg-default bg-green bg-magenta bg-red bg-white bg-yellow black blink blue bold confirm cyan default dim error good green hidden italic magenta name neutral no no-blink no-bold no-dim no-hidden no-italic no-revers no-strike no-underline note number prompt red reset revers strike underline unknown warning white yellow yes}

set thechars {
    advisory	{\033[33m}
    bad		{\033[31m}
    bg-black	{\033[40m}
    bg-blue	{\033[44m}
    bg-cyan	{\033[46m}
    bg-default	{\033[49m}
    bg-green	{\033[42m}
    bg-magenta	{\033[45m}
    bg-red	{\033[41m}
    bg-white	{\033[47m}
    bg-yellow	{\033[43m}
    black	{\033[30m}
    blink	{\033[5m}
    blue	{\033[34m}
    bold	{\033[1m}
    confirm	{\033[31m}
    cyan	{\033[36m}
    default	{\033[39m}
    dim		{\033[2m}
    error	{\033[35m}
    good	{\033[32m}
    green	{\033[32m}
    hidden	{\033[8m}
    italic	{\033[3m}
    magenta	{\033[35m}
    name	{\033[34m}
    neutral	{\033[34m}
    no		{\033[31m}
    no-blink	{\033[25m}
    no-bold	{\033[22m}
    no-dim	{\033[__m}
    no-hidden	{\033[28m}
    no-italic	{\033[23m}
    no-revers	{\033[27m}
    no-strike	{\033[29m}
    no-underline {\033[24m}
    note	{\033[34m}
    number	{\033[32m}
    prompt	{\033[34m}
    red		{\033[31m}
    reset	{\033[0m}
    revers	{\033[7m}
    strike	{\033[9m}
    underline	{\033[4m}
    unknown	{\033[36m}
    warning	{\033[33m}
    white	{\033[37m}
    yellow	{\033[33m}
    yes		{\033[32m}
}

set thedefs {
    advisory	=yellow
    bad		=red
    bg-black	{\033[40m}
    bg-blue	{\033[44m}
    bg-cyan	{\033[46m}
    bg-default	{\033[49m}
    bg-green	{\033[42m}
    bg-magenta	{\033[45m}
    bg-red	{\033[41m}
    bg-white	{\033[47m}
    bg-yellow	{\033[43m}
    black	{\033[30m}
    blink	{\033[5m}
    blue	{\033[34m}
    bold	{\033[1m}
    confirm	=red
    cyan	{\033[36m}
    default	{\033[39m}
    dim		{\033[2m}
    error	=magenta
    good	=green
    green	{\033[32m}
    hidden	{\033[8m}
    italic	{\033[3m}
    magenta	{\033[35m}
    name	=blue
    neutral	=blue
    no		=red
    no-blink	{\033[25m}
    no-bold	{\033[22m}
    no-dim	{\033[__m}
    no-hidden	{\033[28m}
    no-italic	{\033[23m}
    no-revers	{\033[27m}
    no-strike	{\033[29m}
    no-underline {\033[24m}
    note	=blue
    number	=green
    prompt	=blue
    red		{\033[31m}
    reset	{\033[0m}
    revers	{\033[7m}
    strike	{\033[9m}
    underline	{\033[4m}
    unknown	=cyan
    warning	=yellow
    white	{\033[37m}
    yellow	{\033[33m}
    yes		=green
}

# # ## ### ##### ######## ############# #####################
## Basic wrong#args checks.

test cmdr-color-1.0 {color, wrong num args, not enough} -body {
    cmdr color
} -returnCodes error \
    -result {wrong # args: should be "cmdr color subcommand ?argument ...?"}

test cmdr-color-1.1 {color, bogus sub-command, not enough args} -body {
    cmdr color foo
} -returnCodes error \
    -result {wrong # args: should be "::cmdr::color::Unknown cmd codes text"}

test cmdr-color-1.2 {color, bogus sub-command, bogus color name} -setup {
    set save [cmdr color active]
    cmdr color activate 1
} -body {
    cmdr color foo text
} -cleanup {
    cmdr color activate $save
    unset save
} -returnCodes error -result {Expected a color name, got "foo"}

test cmdr-color-2.0 {color, formatting, single code} -setup {
    set save [cmdr color active]
    cmdr color activate 1
} -body {
    cmdr color red text
} -cleanup {
    cmdr color activate $save
    unset save
} -result "\033\[31mtext\033\[0m"

test cmdr-color-2.1 {color, formatting, multi-code} -setup {
    set save [cmdr color active]
    cmdr color activate 1
} -body {
    cmdr color {bold red} text
} -cleanup {
    cmdr color activate $save
    unset save
} -result "\033\[1m\033\[31mtext\033\[0m"

# # ## ### ##### ######## ############# #####################
## Go through the API commands.
## active, activate, names, get, get-def, define, exists

# # ## ### ##### ######## ############# #####################
## active

test cmdr-color-active-1.0 {color active, wrong num args, too many} -body {
    cmdr color active X
} -returnCodes error \
    -result {wrong # args: should be "cmdr color active"}

test cmdr-color-active-1.1 {color active, default} -body {
    cmdr color active
} -result [cmdr tty stdout]

# # ## ### ##### ######## ############# #####################
## activate

test cmdr-color-activate-1.0 {color activate, wrong num args, too many} -body {
    cmdr color activate 0 X
} -returnCodes error \
    -result {wrong # args: should be "cmdr color activate ?flag?"}

test cmdr-color-activate-1.1 {color activate, activate explicit} -body {
    cmdr color activate 1
    cmdr color active
} -result 1

test cmdr-color-activate-1.2 {color activate, deactivate} -body {
    cmdr color activate 0
    cmdr color active
} -result 0

test cmdr-color-activate-1.3 {color activate, activate, implicit} -body {
    cmdr color activate
    cmdr color active
} -result 1

# # ## ### ##### ######## ############# #####################
## names

test cmdr-color-names-1.0 {color names, wrong num args, too many} -body {
    cmdr color names X
} -returnCodes error \
    -result {wrong # args: should be "cmdr color names"}

test cmdr-color-names-1.0 {color names, wrong num args, too many} -body {
    lsort -dict [cmdr color names]
} -result $thecolors

# # ## ### ##### ######## ############# #####################
## unset

test cmdr-color-unset-1.0 {color unset, wrong num args, not enough} -body {
    cmdr color unset
} -returnCodes error \
    -result {wrong # args: should be "cmdr color unset name"}

test cmdr-color-unset-1.1 {color unset, wrong num args, too many} -body {
    cmdr color unset N X
} -returnCodes error \
    -result {wrong # args: should be "cmdr color unset name"}

test cmdr-color-unset-1.2 {color unset, bogus color} -body {
    cmdr color unset foo
} -returnCodes error \
    -result {Expected a color name, got "foo"}

test cmdr-color-unset-1.2 {color unset, known color} -setup {
    cmdr color define foo =red
} -body {
    cmdr color unset foo
} -result {}

# # ## ### ##### ######## ############# #####################
## get

test cmdr-color-get-1.0 {color get, wrong num args, not enough} -body {
    cmdr color get
} -returnCodes error \
    -result {wrong # args: should be "cmdr color get name"}

test cmdr-color-get-1.1 {color get, wrong num args, too many} -body {
    cmdr color get N X
} -returnCodes error \
    -result {wrong # args: should be "cmdr color get name"}

test cmdr-color-get-1.2 {color get, bogus color} -body {
    cmdr color get foo
} -returnCodes error \
    -result {Expected a color name, got "foo"}

set n 0
foreach color $thecolors {
    incr n
    test cmdr-color-get-2.$n "color get, $color" -body {
	cmdr color get $color
    } -result [subst -nocommands -novariables \
		   [dict get $thechars $color]]
}

# # ## ### ##### ######## ############# #####################
## get-def

test cmdr-color-get-def-1.0 {color get-def, wrong num args, not enough} -body {
    cmdr color get-def
} -returnCodes error \
    -result {wrong # args: should be "cmdr color get-def name"}

test cmdr-color-get-def-1.1 {color get-def, wrong num args, too many} -body {
    cmdr color get-def N X
} -returnCodes error \
    -result {wrong # args: should be "cmdr color get-def name"}

test cmdr-color-get-def-1.2 {color get-def, bogus color} -body {
    cmdr color get-def foo
} -returnCodes error \
    -result {Expected a color name, got "foo"}

set n 0
foreach color $thecolors {
    incr n
    test cmdr-color-get-def-2.$n "color get-def, $color" -body {
	cmdr color get-def $color
    } -result [subst -nocommands -novariables \
		   [dict get $thedefs $color]]
}

# # ## ### ##### ######## ############# #####################
## exists

test cmdr-color-exists-1.0 {color exists, wrong num args, not enough} -body {
    cmdr color exists
} -returnCodes error \
    -result {wrong # args: should be "cmdr color exists name"}

test cmdr-color-exists-1.1 {color exists, wrong num args, too many} -body {
    cmdr color exists N X
} -returnCodes error \
    -result {wrong # args: should be "cmdr color exists name"}

test cmdr-color-exists-2.0 {color exists, unknown} -body {
    cmdr color exists foo
} -result 0

set n 0
foreach color $thecolors {
    incr n
    test cmdr-color-exists-2.$n "color exists, $color" -body {
	cmdr color exists $color
    } -result 1
}

# # ## ### ##### ######## ############# #####################
## define

test cmdr-color-define-1.0 {color define, wrong num args, not enough} -body {
    cmdr color define
} -returnCodes error \
    -result {wrong # args: should be "cmdr color define name spec"}

test cmdr-color-define-1.1 {color define, wrong num args, not enough} -body {
    cmdr color define N
} -returnCodes error \
    -result {wrong # args: should be "cmdr color define name spec"}

test cmdr-color-define-1.2 {color define, wrong num args, too many} -body {
    cmdr color define N S X
} -returnCodes error \
    -result {wrong # args: should be "cmdr color define name spec"}

test cmdr-color-define-2.0 {color define, bad reference} -body {
    cmdr color define aname =bogus
} -returnCodes error \
    -result {Expected a color name, got "bogus"}

test cmdr-color-define-2.1 {color define, bad reference, cyclic} -body {
    cmdr color define aname =aname
} -returnCodes error \
    -result {Rejected self-referential definition of "aname"}

test cmdr-color-define-2.2 {color define, reference} -body {
    lappend r [cmdr color exists aname]
    lappend r [cmdr color define aname =red]
    lappend r [cmdr color exists aname]
    lappend r [cmdr color get aname]
    lappend r [cmdr color get-def aname]
} -cleanup {
    cmdr color unset aname
    unset r
} -result [list 0 {} 1 \033\[31m =red]

test cmdr-color-define-3.0 {color define, bad rgb, syntax} -body {
    cmdr color define aname %foo
} -returnCodes error \
    -result {Expected an RGB tuple, got "foo"}

test cmdr-color-define-3.1 {color define, bad rgb, range R} -body {
    cmdr color define aname %7,3,3
} -returnCodes error \
    -result {RGB channel R out of range, got 7}

test cmdr-color-define-3.2 {color define, bad rgb, range G} -body {
    cmdr color define aname %3,7,3
} -returnCodes error \
    -result {RGB channel G out of range, got 7}

test cmdr-color-define-3.3 {color define, bad rgb, range B} -body {
    cmdr color define aname %3,3,7
} -returnCodes error \
    -result {RGB channel B out of range, got 7}

test cmdr-color-define-3.4 {color define, rgb} -body {
    lappend r [cmdr color exists aname]
    lappend r [cmdr color define aname %2,4,3]
    lappend r [cmdr color exists aname]
    lappend r [cmdr color get aname]
    lappend r [cmdr color get-def aname]
} -cleanup {
    cmdr color unset aname
    unset r
} -result [list 0 {} 1 \033\[115m %2,4,3]

test cmdr-color-define-4.0 {color define, raw control} -body {
    lappend r [cmdr color exists aname]
    lappend r [cmdr color define aname blimfizzle]
    lappend r [cmdr color exists aname]
    lappend r [cmdr color get aname]
    lappend r [cmdr color get-def aname]
} -cleanup {
    cmdr color unset aname
    unset r
} -result [list 0 {} 1 blimfizzle blimfizzle]

# # ## ### ##### ######## ############# #####################
cleanupTests
return