## -*- tcl -*- # # ## ### ##### ######## ############# ##################### ## CMDR - Convenience commands for colored text in terminals. # @@ Meta Begin # Package cmdr::color 0 # Meta author {Andreas Kupries} # Meta location https://core.tcl.tk/akupries/cmdr # Meta platform tcl # Meta summary Text colorization for terminal output # Meta description Commands to manage colored text in terminal # Meta description output # Meta subject {command line} terminal color {text colors} # Meta require {Tcl 8.5-} # Meta require debug # Meta require debug::caller # Meta require cmdr::tty # @@ Meta End # # ## ### ##### ######## ############# ##################### ## Requisites 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 \ -prefixes 0 # Note, the -unknown 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 # # The -prefix 0 option ensures that we canuse the 'name' # color-code, without it will go to 'names' and then fail with # wrong#args due to the different expected syntax. ## 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 := = # (2) rgb := %,, # (3) esc := [Ee](,...)? # (4) 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 {^[eE](.*)$} $spec -> codes]} { if {![regexp {^(\d+)(,\d+)*$} $codes]} { return -code error \ -errorcode [list CMDR COLOR BAD-ESCAPE SYNTAX $spec] \ "Expected a comma-separated list of codes, got \"$spec\"" } set codes [Code {*}[split $codes ,]] debug.cmdr/color {ESC encoded => [Quote $codes]} dict set def $name $spec dict set char $name $codes 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 } # # ## ### ##### ######## ############# ##################### proc ::cmdr::color::Unknown {cmd codes {text {}}} { list [namespace current]::Apply $codes } proc ::cmdr::color::Apply {codes {text {}}} { debug.cmdr/color {} variable active 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] } if {$text ne {}} { 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 e30 ; # Black define red e31 ; # Red define green e32 ; # Green define yellow e33 ; # Yellow define blue e34 ; # Blue define magenta e35 ; # Magenta define cyan e36 ; # Cyan define white e37 ; # White define default e39 ; # Default (Black) # Colors. Background. define bg-black e40 ; # Black define bg-red e41 ; # Red define bg-green e42 ; # Green define bg-yellow e43 ; # Yellow define bg-blue e44 ; # Blue define bg-magenta e45 ; # Magenta define bg-cyan e46 ; # Cyan define bg-white e47 ; # White define bg-default e49 ; # Default (Transparent) # Non-color attributes. Activation. define bold e1 ; # Bold define dim e2 ; # Dim define italic e3 ; # Italics define underline e4 ; # Underscore define blink e5 ; # Blink define revers e7 ; # Reverse define hidden e8 ; # Hidden define strike e9 ; # StrikeThrough # Non-color attributes. Deactivation. define no-bold e21 ; # Bold define no-dim e22 ; # Dim define no-italic e23 ; # Italics define no-underline e24 ; # Underscore define no-blink e25 ; # Blink define no-revers e27 ; # Reverse define no-hidden e28 ; # Hidden define no-strike e29 ; # StrikeThrough # Remainder define reset e0 ; # 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 1