cmdr
Check-in [ddd5e520dd]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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
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
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to color.tcl.

    22     22   
    23     23   package require Tcl 8.5
    24     24   package require debug
    25     25   package require debug::caller
    26     26   package require cmdr::tty
    27     27   
    28     28   # # ## ### ##### ######## ############# #####################
           29  +
           30  +namespace eval ::cmdr {
           31  +    namespace export color
           32  +    namespace ensemble create
           33  +}
    29     34   
    30     35   namespace eval ::cmdr::color {
    31         -    namespace export activate active define
           36  +    namespace export \
           37  +	activate active names get get-def define exists unset
    32     38       namespace ensemble create \
    33     39   	-unknown [namespace current]::Unknown
    34     40       # Note, the option ensures that all unknown methods are treated as
    35     41       # (list of) color codes to apply to some text, effectively
    36     42       # creating the virtual command
    37     43       #
    38     44       #    ::cmdr::color <codelist> <text>
................................................................................
    44     50   # # ## ### ##### ######## ############# #####################
    45     51   
    46     52   debug define cmdr/color
    47     53   debug level  cmdr/color
    48     54   debug prefix cmdr/color {[debug caller] | }
    49     55   
    50     56   # # ## ### ##### ######## ############# #####################
    51         -## TODO undef?
    52         -## TODO multi-def (load)
    53         -## TODO get (display)
    54         -## officer and private for std commands (show, define).
           57  +## TODO multi-def aka bulk-def aka load
           58  +## TODO officer and private for std commands (show, define).
    55     59   
    56     60   proc ::cmdr::color::activate {{flag 1}} {
    57     61       debug.cmdr/color {}
    58     62       variable active $flag
    59     63       return
    60     64   }
    61     65   
    62     66   proc ::cmdr::color::active {} {
    63     67       debug.cmdr/color {}
    64     68       variable active
    65     69       return  $active
    66     70   }
           71  +
           72  +proc ::cmdr::color::names {} {
           73  +    debug.cmdr/color {}
           74  +    variable def
           75  +    return [dict keys $def]
           76  +}
           77  +
           78  +proc ::cmdr::color::unset {name} {
           79  +    debug.cmdr/color {}
           80  +    variable def
           81  +    if {![dict exists $def $name]} {
           82  +	return -code error \
           83  +	    -errorcode [list CMDR COLOR BAD $name] \
           84  +	    "Expected a color name, got \"$name\""
           85  +    }
           86  +
           87  +    variable char
           88  +    dict unset def  $name
           89  +    dict unset char $name
           90  +    return
           91  +}
           92  +
           93  +proc ::cmdr::color::get {name} {
           94  +    debug.cmdr/color {}
           95  +    variable def
           96  +    if {![dict exists $def $name]} {
           97  +	return -code error \
           98  +	    -errorcode [list CMDR COLOR BAD $name] \
           99  +	    "Expected a color name, got \"$name\""
          100  +    }
          101  +    variable char
          102  +    return [dict get $char $name]
          103  +}
          104  +
          105  +proc ::cmdr::color::get-def {name} {
          106  +    debug.cmdr/color {}
          107  +    variable def
          108  +    if {![dict exists $def $name]} {
          109  +	return -code error \
          110  +	    -errorcode [list CMDR COLOR BAD $name] \
          111  +	    "Expected a color name, got \"$name\""
          112  +    }
          113  +    return [dict get $def $name]
          114  +}
          115  +
          116  +proc ::cmdr::color::exists {name} {
          117  +    debug.cmdr/color {}
          118  +    variable def
          119  +    return [dict exists $def $name]
          120  +}
    67    121   
    68    122   proc ::cmdr::color::define {name spec} {
    69    123       debug.cmdr/color {}
    70    124       variable def
    71    125       variable char
    72         -    # TODO: spec may be
    73         -    # => reference to other color name, or
    74         -    # => raw control sequence, or
    75         -    # => RGB spec.
          126  +
          127  +    # The spec may be
          128  +    # (1) A reference to other color name.
          129  +    # (2) An RGB spec.
          130  +    # (3) A raw control sequence.
    76    131   
    77    132       # Syntax:
    78         -    # ref = anything already found as key in the database.
    79         -    # rgb = 
    80         -    # raw = 
          133  +    # (1) ref := =<name>
          134  +    # (2) rgb := %<r>,<g>,<b>
          135  +    # (3) raw := anything else
    81    136   
    82         -    if {[dict exists $def $spec]} {
    83         -	if {$spec eq $name} {
          137  +    if {[regexp {^=(.*)$} $spec -> ref]} {
          138  +	if {$ref eq $name} {
    84    139   	    return -code error \
    85    140   		-errorcode [list CMDR COLOR CIRCLE $name] \
    86    141   		"Rejected self-referential definition of \"$name\""
          142  +	} elseif {![dict exists $def $ref]} {
          143  +	    return -code error \
          144  +		-errorcode [list CMDR COLOR BAD $ref] \
          145  +		"Expected a color name, got \"$ref\""
          146  +	} else {
          147  +	    set raw [dict get $char $ref]
          148  +	    debug.cmdr/color {reference, resolved => [Quote $raw]}
          149  +	    dict set def  $name $spec
          150  +	    dict set char $name $raw
          151  +	    return
    87    152   	}
    88         -	debug.cmdr/color {reference, resolved => [S [dict get $char $spec]]}
    89         -	dict set def  $name $spec
    90         -	dict set char $name [dict get $char $spec]
    91         -	return
    92    153       }
    93    154   
    94         -    if {[regexp {^%(\d+),(\d+),(\d+)$} $spec -> r g b]} {
    95         -	# R, G, B all in range 0..5
    96         -	set r [Clamp $r]
    97         -	set g [Clamp $g]
    98         -	set b [Clamp $b]
    99         -	# 256 mapping
   100         -	# code = 16 + 36R + 6G + B --> [16..236]
   101         -	set code [expr {16 + 36*$r + 6*$g + $b}]
   102         -	debug.cmdr/color {RGB encoded => [S [C $code]]}
   103         -	dict set def  $name $spec
   104         -	dict set char $name [C $code]
   105         -	return
   106         -
   107         -	# Legacy mapping
   108         -	# R,G,B mapping 0,1 --> 0, 2,3 --> 1, 4,5 --> 2
   109         -	# bold mapping: 0,1,2 --> 0,1,1 (set if any of R, G, B)
   110         -	# code = 8bold + R + 2G + 4B
   111         -	#      = 8, for R==G==B != 0, special case.
          155  +    if {[regexp {^%(.*)$} $spec -> rgb]} {
          156  +	if {![regexp {^(\d+),(\d+),(\d+)$} $rgb -> r g b]} {
          157  +	    return -code error \
          158  +		-errorcode [list CMDR COLOR BAD-RGB SYNTAX $rgb] \
          159  +		"Expected an RGB tuple, got \"$rgb\""
          160  +	} {
          161  +	    # R, G, B all in range 0..5
          162  +	    Clamp R $r
          163  +	    Clamp G $g
          164  +	    Clamp B $b
          165  +	    # 256-color mapping
          166  +	    # code = 16 + 36R + 6G + B --> [16..236]
          167  +	    set point [expr {16 + 36*$r + 6*$g + $b}]
          168  +	    set code [Code $point]
          169  +	    debug.cmdr/color {RGB encoded => [Quote $code]}
          170  +	    dict set def  $name $spec
          171  +	    dict set char $name $code
          172  +	    return
          173  +
          174  +	    # Legacy mapping
          175  +	    # R,G,B mapping 0,1 --> 0, 2,3 --> 1, 4,5 --> 2
          176  +	    # bold mapping: 0,1,2 --> 0,1,1 (set if any of R, G, B)
          177  +	    # code = 8bold + R + 2G + 4B
          178  +	    #      = 8, for R==G==B != 0, special case.
          179  +	}
   112    180       }
   113    181   
   114    182       # Raw control sequence, simply save
   115    183       dict set def  $name $spec
   116    184       dict set char $name $spec
   117    185       return
   118    186   }
................................................................................
   130    198       if {!$active} {
   131    199   	debug.cmdr/color {not active}
   132    200   	return $text
   133    201       }
   134    202   
   135    203       variable char
   136    204       foreach c $codes {
   137         -	if {[dict exists $char $c]} {
          205  +	if {![dict exists $char $c]} {
   138    206   	    return -code error \
   139    207   		-errorcode [list CMDR COLOR UNKNOWN $c] \
   140    208   		"Expected a color name, got \"$c\""
   141    209   	}
   142    210   	append r [dict get $char $c]
   143    211       }
   144    212       append r $text
   145    213       append r [dict get $char reset]
   146    214   
   147    215       debug.cmdr/color {/done}
   148    216       return $r
   149    217   }
   150    218   
   151         -proc ::cmdr::color::S {text} {
          219  +proc ::cmdr::color::Quote {text} {
   152    220       # quote all non-printable characters (< space, > ~)
   153    221       variable smap
   154    222       return [string map $smap $text]
   155    223   }
   156    224   
   157         -proc ::cmdr::color::C {args} {
          225  +proc ::cmdr::color::Code {args} {
   158    226       return \033\[[join $args \;]m
   159    227   }
   160    228   
   161         -proc ::cmdr::color::Clamp {x} {
   162         -    if {$x < 0} { return 0 }
   163         -    if {$x > 5} { return 5 }
   164         -    return $x
          229  +proc ::cmdr::color::Clamp {label x} {
          230  +    if {($x >= 0) && ($x <= 5)} { return $x }
          231  +    return -code error \
          232  +	-errorcode [list CMDR COLOR BAD-RGB RANGE $x] \
          233  +	"RGB channel $label out of range, got $x"
   165    234   }
   166    235   
   167    236   # # ## ### ##### ######## ############# #####################
   168    237   
   169    238   namespace eval ::cmdr::color {
   170    239       # Boolean flag controlling use of color sequences.
   171    240       # Default based on tty-ness of stdout. Active if yes.
................................................................................
   176    245       # dictionaries hold the user-level specification and the
   177    246       # full-resolved character sequence.
   178    247   
   179    248       variable def  {}
   180    249       variable char {}
   181    250   
   182    251       # Colors. Foreground/Text.
   183         -    define  black        [C 30]  ; # Black  
   184         -    define  red          [C 31]  ; # Red    
   185         -    define  green        [C 32]  ; # Green  
   186         -    define  yellow       [C 33]  ; # Yellow 
   187         -    define  blue         [C 34]  ; # Blue   
   188         -    define  magenta      [C 35]  ; # Magenta
   189         -    define  cyan         [C 36]  ; # Cyan   
   190         -    define  white        [C 37]  ; # White  
   191         -    define  default      [C 39]  ; # Default (Black)
          252  +    define  black        [Code 30]  ; # Black  
          253  +    define  red          [Code 31]  ; # Red    
          254  +    define  green        [Code 32]  ; # Green  
          255  +    define  yellow       [Code 33]  ; # Yellow 
          256  +    define  blue         [Code 34]  ; # Blue   
          257  +    define  magenta      [Code 35]  ; # Magenta
          258  +    define  cyan         [Code 36]  ; # Cyan   
          259  +    define  white        [Code 37]  ; # White  
          260  +    define  default      [Code 39]  ; # Default (Black)
   192    261   
   193    262       # Colors. Background.
   194         -    define  bg-black     [C 40]  ; # Black  
   195         -    define  bg-red       [C 41]  ; # Red    
   196         -    define  bg-green     [C 42]  ; # Green  
   197         -    define  bg-yellow    [C 43]  ; # Yellow 
   198         -    define  bg-blue      [C 44]  ; # Blue   
   199         -    define  bg-magenta   [C 45]  ; # Magenta
   200         -    define  bg-cyan      [C 46]  ; # Cyan   
   201         -    define  bg-white     [C 47]  ; # White  
   202         -    define  bg-default   [C 49]  ; # Default (Transparent)
          263  +    define  bg-black     [Code 40]  ; # Black  
          264  +    define  bg-red       [Code 41]  ; # Red    
          265  +    define  bg-green     [Code 42]  ; # Green  
          266  +    define  bg-yellow    [Code 43]  ; # Yellow 
          267  +    define  bg-blue      [Code 44]  ; # Blue   
          268  +    define  bg-magenta   [Code 45]  ; # Magenta
          269  +    define  bg-cyan      [Code 46]  ; # Cyan   
          270  +    define  bg-white     [Code 47]  ; # White  
          271  +    define  bg-default   [Code 49]  ; # Default (Transparent)
   203    272   
   204    273       # Non-color attributes. Activation.
   205         -    define  bold         [C  1]  ; # Bold  
   206         -    define  dim          [C  2]  ; # Dim
   207         -    define  italic       [C  3]  ; # Italics      
   208         -    define  underline    [C  4]  ; # Underscore   
   209         -    define  blink        [C  5]  ; # Blink
   210         -    define  revers       [C  7]  ; # Reverse      
   211         -    define  hidden       [C  8]  ; # Hidden
   212         -    define  strike       [C  9]  ; # StrikeThrough
          274  +    define  bold         [Code  1]  ; # Bold  
          275  +    define  dim          [Code  2]  ; # Dim
          276  +    define  italic       [Code  3]  ; # Italics      
          277  +    define  underline    [Code  4]  ; # Underscore   
          278  +    define  blink        [Code  5]  ; # Blink
          279  +    define  revers       [Code  7]  ; # Reverse      
          280  +    define  hidden       [Code  8]  ; # Hidden
          281  +    define  strike       [Code  9]  ; # StrikeThrough
   213    282   
   214    283       # Non-color attributes. Deactivation.
   215         -    define  no-bold      [C 22]  ; # Bold  
   216         -    define  no-dim       [C __]  ; # Dim
   217         -    define  no-italic    [C 23]  ; # Italics      
   218         -    define  no-underline [C 24]  ; # Underscore   
   219         -    define  no-blink     [C 25]  ; # Blink
   220         -    define  no-revers    [C 27]  ; # Reverse      
   221         -    define  no-hidden    [C 28]  ; # Hidden
   222         -    define  no-strike    [C 29]  ; # StrikeThrough
          284  +    define  no-bold      [Code 22]  ; # Bold  
          285  +    define  no-dim       [Code __]  ; # Dim
          286  +    define  no-italic    [Code 23]  ; # Italics      
          287  +    define  no-underline [Code 24]  ; # Underscore   
          288  +    define  no-blink     [Code 25]  ; # Blink
          289  +    define  no-revers    [Code 27]  ; # Reverse      
          290  +    define  no-hidden    [Code 28]  ; # Hidden
          291  +    define  no-strike    [Code 29]  ; # StrikeThrough
   223    292   
   224    293       # Remainder
   225         -    define  reset        [C  0]  ; # Reset
          294  +    define  reset        [Code  0]  ; # Reset
   226    295   
   227    296       # And now the standard symbolic names
   228         -
   229         -    define  confirm red
   230         -    define  error   red
   231         -    define  warning yellow
   232         -    define  note    blue
   233         -    define  good    green
   234         -    define  name    blue
   235         -
   236         -    # header command stopped advisory crashed failure success name prompt table warning
   237         -    # bl/whi bl/yel  bl/grey bl/yel   bl/red  bl/red  bl/gre  bl/cy bl/cy bl/cy bl/mag
   238         -    # stdout - white, stderr - red
   239         -    # app-header sys-header
   240         -    # bl/yel     bl/cy
   241         -
   242         -    # others ...
   243         -    # name	<>	blue,
   244         -    # neutral	<>	blue,
   245         -    # good	<>	green,
   246         -    # bad	<>	red,
   247         -    # error	<>	magenta,
   248         -    # unknown	<>	cyan,
   249         -    # warning	<>	yellow,
   250         -    # instance<>	yellow,
   251         -    # number	<>	green,
   252         -    # prompt	<>	blue,
   253         -    # yes	<>	green,
   254         -    # no	<>	red
          297  +    define  advisory =yellow
          298  +    define  bad      =red
          299  +    define  confirm  =red
          300  +    define  error    =magenta
          301  +    define  good     =green
          302  +    define  name     =blue
          303  +    define  neutral  =blue
          304  +    define  no       =red
          305  +    define  note     =blue
          306  +    define  number   =green
          307  +    define  prompt   =blue
          308  +    define  unknown  =cyan
          309  +    define  warning  =yellow
          310  +    define  yes      =green
   255    311   
   256    312       variable smap {}
   257    313   }
   258    314   
   259    315   apply {{} {
   260    316       variable smap
   261    317       for {set i 0} {$i < 32} {incr i} {
   262    318   	set c [format %c $i]
   263    319   	set o \\[format %03o $i] 
   264    320   	lappend smap $c $o
   265    321       }
   266    322       lappend smap \127 \\127
   267         -}} ::cmdr::color
          323  +} ::cmdr::color}
   268    324   
   269    325   # # ## ### ##### ######## ############# #####################
   270    326   ## Ready
   271    327   package provide cmdr::color 0

Added tests/color.test.

            1  +# -*- tcl -*- tcl.tk//DSL tcltest//EN//2.0
            2  +# # ## ### ##### ######## ############# #####################
            3  +## Testing the cmdr::color package.
            4  +
            5  +kt check Tcl     8.5
            6  +kt check tcltest 2
            7  +
            8  +kt require support Tclx
            9  +kt require support debug
           10  +kt require support debug::caller
           11  +
           12  +kt local   support cmdr::tty
           13  +kt local   testing cmdr::color
           14  +
           15  +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}
           16  +
           17  +set thechars {
           18  +    advisory	{\033[33m}
           19  +    bad		{\033[31m}
           20  +    bg-black	{\033[40m}
           21  +    bg-blue	{\033[44m}
           22  +    bg-cyan	{\033[46m}
           23  +    bg-default	{\033[49m}
           24  +    bg-green	{\033[42m}
           25  +    bg-magenta	{\033[45m}
           26  +    bg-red	{\033[41m}
           27  +    bg-white	{\033[47m}
           28  +    bg-yellow	{\033[43m}
           29  +    black	{\033[30m}
           30  +    blink	{\033[5m}
           31  +    blue	{\033[34m}
           32  +    bold	{\033[1m}
           33  +    confirm	{\033[31m}
           34  +    cyan	{\033[36m}
           35  +    default	{\033[39m}
           36  +    dim		{\033[2m}
           37  +    error	{\033[35m}
           38  +    good	{\033[32m}
           39  +    green	{\033[32m}
           40  +    hidden	{\033[8m}
           41  +    italic	{\033[3m}
           42  +    magenta	{\033[35m}
           43  +    name	{\033[34m}
           44  +    neutral	{\033[34m}
           45  +    no		{\033[31m}
           46  +    no-blink	{\033[25m}
           47  +    no-bold	{\033[22m}
           48  +    no-dim	{\033[__m}
           49  +    no-hidden	{\033[28m}
           50  +    no-italic	{\033[23m}
           51  +    no-revers	{\033[27m}
           52  +    no-strike	{\033[29m}
           53  +    no-underline {\033[24m}
           54  +    note	{\033[34m}
           55  +    number	{\033[32m}
           56  +    prompt	{\033[34m}
           57  +    red		{\033[31m}
           58  +    reset	{\033[0m}
           59  +    revers	{\033[7m}
           60  +    strike	{\033[9m}
           61  +    underline	{\033[4m}
           62  +    unknown	{\033[36m}
           63  +    warning	{\033[33m}
           64  +    white	{\033[37m}
           65  +    yellow	{\033[33m}
           66  +    yes		{\033[32m}
           67  +}
           68  +
           69  +set thedefs {
           70  +    advisory	=yellow
           71  +    bad		=red
           72  +    bg-black	{\033[40m}
           73  +    bg-blue	{\033[44m}
           74  +    bg-cyan	{\033[46m}
           75  +    bg-default	{\033[49m}
           76  +    bg-green	{\033[42m}
           77  +    bg-magenta	{\033[45m}
           78  +    bg-red	{\033[41m}
           79  +    bg-white	{\033[47m}
           80  +    bg-yellow	{\033[43m}
           81  +    black	{\033[30m}
           82  +    blink	{\033[5m}
           83  +    blue	{\033[34m}
           84  +    bold	{\033[1m}
           85  +    confirm	=red
           86  +    cyan	{\033[36m}
           87  +    default	{\033[39m}
           88  +    dim		{\033[2m}
           89  +    error	=magenta
           90  +    good	=green
           91  +    green	{\033[32m}
           92  +    hidden	{\033[8m}
           93  +    italic	{\033[3m}
           94  +    magenta	{\033[35m}
           95  +    name	=blue
           96  +    neutral	=blue
           97  +    no		=red
           98  +    no-blink	{\033[25m}
           99  +    no-bold	{\033[22m}
          100  +    no-dim	{\033[__m}
          101  +    no-hidden	{\033[28m}
          102  +    no-italic	{\033[23m}
          103  +    no-revers	{\033[27m}
          104  +    no-strike	{\033[29m}
          105  +    no-underline {\033[24m}
          106  +    note	=blue
          107  +    number	=green
          108  +    prompt	=blue
          109  +    red		{\033[31m}
          110  +    reset	{\033[0m}
          111  +    revers	{\033[7m}
          112  +    strike	{\033[9m}
          113  +    underline	{\033[4m}
          114  +    unknown	=cyan
          115  +    warning	=yellow
          116  +    white	{\033[37m}
          117  +    yellow	{\033[33m}
          118  +    yes		=green
          119  +}
          120  +
          121  +# # ## ### ##### ######## ############# #####################
          122  +## Basic wrong#args checks.
          123  +
          124  +test cmdr-color-1.0 {color, wrong num args, not enough} -body {
          125  +    cmdr color
          126  +} -returnCodes error \
          127  +    -result {wrong # args: should be "cmdr color subcommand ?argument ...?"}
          128  +
          129  +test cmdr-color-1.1 {color, bogus sub-command, not enough args} -body {
          130  +    cmdr color foo
          131  +} -returnCodes error \
          132  +    -result {wrong # args: should be "::cmdr::color::Unknown cmd codes text"}
          133  +
          134  +test cmdr-color-1.2 {color, bogus sub-command, bogus color name} -setup {
          135  +    set save [cmdr color active]
          136  +    cmdr color activate 1
          137  +} -body {
          138  +    cmdr color foo text
          139  +} -cleanup {
          140  +    cmdr color activate $save
          141  +    unset save
          142  +} -returnCodes error -result {Expected a color name, got "foo"}
          143  +
          144  +test cmdr-color-2.0 {color, formatting, single code} -setup {
          145  +    set save [cmdr color active]
          146  +    cmdr color activate 1
          147  +} -body {
          148  +    cmdr color red text
          149  +} -cleanup {
          150  +    cmdr color activate $save
          151  +    unset save
          152  +} -result "\033\[31mtext\033\[0m"
          153  +
          154  +test cmdr-color-2.1 {color, formatting, multi-code} -setup {
          155  +    set save [cmdr color active]
          156  +    cmdr color activate 1
          157  +} -body {
          158  +    cmdr color {bold red} text
          159  +} -cleanup {
          160  +    cmdr color activate $save
          161  +    unset save
          162  +} -result "\033\[1m\033\[31mtext\033\[0m"
          163  +
          164  +# # ## ### ##### ######## ############# #####################
          165  +## Go through the API commands.
          166  +## active, activate, names, get, get-def, define, exists
          167  +
          168  +# # ## ### ##### ######## ############# #####################
          169  +## active
          170  +
          171  +test cmdr-color-active-1.0 {color active, wrong num args, too many} -body {
          172  +    cmdr color active X
          173  +} -returnCodes error \
          174  +    -result {wrong # args: should be "cmdr color active"}
          175  +
          176  +test cmdr-color-active-1.1 {color active, default} -body {
          177  +    cmdr color active
          178  +} -result [cmdr tty stdout]
          179  +
          180  +# # ## ### ##### ######## ############# #####################
          181  +## activate
          182  +
          183  +test cmdr-color-activate-1.0 {color activate, wrong num args, too many} -body {
          184  +    cmdr color activate 0 X
          185  +} -returnCodes error \
          186  +    -result {wrong # args: should be "cmdr color activate ?flag?"}
          187  +
          188  +test cmdr-color-activate-1.1 {color activate, activate explicit} -body {
          189  +    cmdr color activate 1
          190  +    cmdr color active
          191  +} -result 1
          192  +
          193  +test cmdr-color-activate-1.2 {color activate, deactivate} -body {
          194  +    cmdr color activate 0
          195  +    cmdr color active
          196  +} -result 0
          197  +
          198  +test cmdr-color-activate-1.3 {color activate, activate, implicit} -body {
          199  +    cmdr color activate
          200  +    cmdr color active
          201  +} -result 1
          202  +
          203  +# # ## ### ##### ######## ############# #####################
          204  +## names
          205  +
          206  +test cmdr-color-names-1.0 {color names, wrong num args, too many} -body {
          207  +    cmdr color names X
          208  +} -returnCodes error \
          209  +    -result {wrong # args: should be "cmdr color names"}
          210  +
          211  +test cmdr-color-names-1.0 {color names, wrong num args, too many} -body {
          212  +    lsort -dict [cmdr color names]
          213  +} -result $thecolors
          214  +
          215  +# # ## ### ##### ######## ############# #####################
          216  +## unset
          217  +
          218  +test cmdr-color-unset-1.0 {color unset, wrong num args, not enough} -body {
          219  +    cmdr color unset
          220  +} -returnCodes error \
          221  +    -result {wrong # args: should be "cmdr color unset name"}
          222  +
          223  +test cmdr-color-unset-1.1 {color unset, wrong num args, too many} -body {
          224  +    cmdr color unset N X
          225  +} -returnCodes error \
          226  +    -result {wrong # args: should be "cmdr color unset name"}
          227  +
          228  +test cmdr-color-unset-1.2 {color unset, bogus color} -body {
          229  +    cmdr color unset foo
          230  +} -returnCodes error \
          231  +    -result {Expected a color name, got "foo"}
          232  +
          233  +test cmdr-color-unset-1.2 {color unset, known color} -setup {
          234  +    cmdr color define foo =red
          235  +} -body {
          236  +    cmdr color unset foo
          237  +} -result {}
          238  +
          239  +# # ## ### ##### ######## ############# #####################
          240  +## get
          241  +
          242  +test cmdr-color-get-1.0 {color get, wrong num args, not enough} -body {
          243  +    cmdr color get
          244  +} -returnCodes error \
          245  +    -result {wrong # args: should be "cmdr color get name"}
          246  +
          247  +test cmdr-color-get-1.1 {color get, wrong num args, too many} -body {
          248  +    cmdr color get N X
          249  +} -returnCodes error \
          250  +    -result {wrong # args: should be "cmdr color get name"}
          251  +
          252  +test cmdr-color-get-1.2 {color get, bogus color} -body {
          253  +    cmdr color get foo
          254  +} -returnCodes error \
          255  +    -result {Expected a color name, got "foo"}
          256  +
          257  +set n 0
          258  +foreach color $thecolors {
          259  +    incr n
          260  +    test cmdr-color-get-2.$n "color get, $color" -body {
          261  +	cmdr color get $color
          262  +    } -result [subst -nocommands -novariables \
          263  +		   [dict get $thechars $color]]
          264  +}
          265  +
          266  +# # ## ### ##### ######## ############# #####################
          267  +## get-def
          268  +
          269  +test cmdr-color-get-def-1.0 {color get-def, wrong num args, not enough} -body {
          270  +    cmdr color get-def
          271  +} -returnCodes error \
          272  +    -result {wrong # args: should be "cmdr color get-def name"}
          273  +
          274  +test cmdr-color-get-def-1.1 {color get-def, wrong num args, too many} -body {
          275  +    cmdr color get-def N X
          276  +} -returnCodes error \
          277  +    -result {wrong # args: should be "cmdr color get-def name"}
          278  +
          279  +test cmdr-color-get-def-1.2 {color get-def, bogus color} -body {
          280  +    cmdr color get-def foo
          281  +} -returnCodes error \
          282  +    -result {Expected a color name, got "foo"}
          283  +
          284  +set n 0
          285  +foreach color $thecolors {
          286  +    incr n
          287  +    test cmdr-color-get-def-2.$n "color get-def, $color" -body {
          288  +	cmdr color get-def $color
          289  +    } -result [subst -nocommands -novariables \
          290  +		   [dict get $thedefs $color]]
          291  +}
          292  +
          293  +# # ## ### ##### ######## ############# #####################
          294  +## exists
          295  +
          296  +test cmdr-color-exists-1.0 {color exists, wrong num args, not enough} -body {
          297  +    cmdr color exists
          298  +} -returnCodes error \
          299  +    -result {wrong # args: should be "cmdr color exists name"}
          300  +
          301  +test cmdr-color-exists-1.1 {color exists, wrong num args, too many} -body {
          302  +    cmdr color exists N X
          303  +} -returnCodes error \
          304  +    -result {wrong # args: should be "cmdr color exists name"}
          305  +
          306  +test cmdr-color-exists-2.0 {color exists, unknown} -body {
          307  +    cmdr color exists foo
          308  +} -result 0
          309  +
          310  +set n 0
          311  +foreach color $thecolors {
          312  +    incr n
          313  +    test cmdr-color-exists-2.$n "color exists, $color" -body {
          314  +	cmdr color exists $color
          315  +    } -result 1
          316  +}
          317  +
          318  +# # ## ### ##### ######## ############# #####################
          319  +## define
          320  +
          321  +test cmdr-color-define-1.0 {color define, wrong num args, not enough} -body {
          322  +    cmdr color define
          323  +} -returnCodes error \
          324  +    -result {wrong # args: should be "cmdr color define name spec"}
          325  +
          326  +test cmdr-color-define-1.1 {color define, wrong num args, not enough} -body {
          327  +    cmdr color define N
          328  +} -returnCodes error \
          329  +    -result {wrong # args: should be "cmdr color define name spec"}
          330  +
          331  +test cmdr-color-define-1.2 {color define, wrong num args, too many} -body {
          332  +    cmdr color define N S X
          333  +} -returnCodes error \
          334  +    -result {wrong # args: should be "cmdr color define name spec"}
          335  +
          336  +test cmdr-color-define-2.0 {color define, bad reference} -body {
          337  +    cmdr color define aname =bogus
          338  +} -returnCodes error \
          339  +    -result {Expected a color name, got "bogus"}
          340  +
          341  +test cmdr-color-define-2.1 {color define, bad reference, cyclic} -body {
          342  +    cmdr color define aname =aname
          343  +} -returnCodes error \
          344  +    -result {Rejected self-referential definition of "aname"}
          345  +
          346  +test cmdr-color-define-2.2 {color define, reference} -body {
          347  +    lappend r [cmdr color exists aname]
          348  +    lappend r [cmdr color define aname =red]
          349  +    lappend r [cmdr color exists aname]
          350  +    lappend r [cmdr color get aname]
          351  +    lappend r [cmdr color get-def aname]
          352  +} -cleanup {
          353  +    cmdr color unset aname
          354  +    unset r
          355  +} -result [list 0 {} 1 \033\[31m =red]
          356  +
          357  +test cmdr-color-define-3.0 {color define, bad rgb, syntax} -body {
          358  +    cmdr color define aname %foo
          359  +} -returnCodes error \
          360  +    -result {Expected an RGB tuple, got "foo"}
          361  +
          362  +test cmdr-color-define-3.1 {color define, bad rgb, range R} -body {
          363  +    cmdr color define aname %7,3,3
          364  +} -returnCodes error \
          365  +    -result {RGB channel R out of range, got 7}
          366  +
          367  +test cmdr-color-define-3.2 {color define, bad rgb, range G} -body {
          368  +    cmdr color define aname %3,7,3
          369  +} -returnCodes error \
          370  +    -result {RGB channel G out of range, got 7}
          371  +
          372  +test cmdr-color-define-3.3 {color define, bad rgb, range B} -body {
          373  +    cmdr color define aname %3,3,7
          374  +} -returnCodes error \
          375  +    -result {RGB channel B out of range, got 7}
          376  +
          377  +test cmdr-color-define-3.4 {color define, rgb} -body {
          378  +    lappend r [cmdr color exists aname]
          379  +    lappend r [cmdr color define aname %2,4,3]
          380  +    lappend r [cmdr color exists aname]
          381  +    lappend r [cmdr color get aname]
          382  +    lappend r [cmdr color get-def aname]
          383  +} -cleanup {
          384  +    cmdr color unset aname
          385  +    unset r
          386  +} -result [list 0 {} 1 \033\[115m %2,4,3]
          387  +
          388  +test cmdr-color-define-4.0 {color define, raw control} -body {
          389  +    lappend r [cmdr color exists aname]
          390  +    lappend r [cmdr color define aname blimfizzle]
          391  +    lappend r [cmdr color exists aname]
          392  +    lappend r [cmdr color get aname]
          393  +    lappend r [cmdr color get-def aname]
          394  +} -cleanup {
          395  +    cmdr color unset aname
          396  +    unset r
          397  +} -result [list 0 {} 1 blimfizzle blimfizzle]
          398  +
          399  +# # ## ### ##### ######## ############# #####################
          400  +cleanupTests
          401  +return