ANSI color control

WikiDbImage ansitext.jpg

See Also

tcllib
term package

cgrep - Color your output with regular expressions!

Description

Richard Suchenwirth 2001-01-10: The ANSI standard (ISO) 6429 defines escape sequences for controlling foreground and background colors on CRT devices. For example,

"\033[01;32mFoo\033[0mbar"

will, where supported, display "Foo" in bright green and "bar" normally again. Support of colors I've seen so far is on CDE's Terminal, Linux terminal windows - and Cygwin on W95 (e.g. to see colors from a tclsh script, pipe it through cat). Others like xterm on Solaris show part of the markup like bold, reverse video. Still others like the DOS prompt just display the cryptic characters, if you don't have devicehigh=<path>ANSI.SYS in your config.sys.

A painless approach in Windows without any system changes can be established by using twapi (here using the '+' command from below):

package require twapi
proc + {color} {
    twapi::set_console_default_attr stdout -fg$color 1
}

Here's some procs to convert mnemonic calls (e.g. [+white Red] for white on red background) to and from ANSI sequences, a value-added text widget that honors ANSI color sequences, and some test code:

namespace eval ansicolor {
    namespace export +
    variable map {
        bold 1 light 2 blink 5 invert 7
        black 30 red 31 green 32 yellow 33 blue 34 purple 35 cyan 36 white 37
        Black 40 Red 41 Green 42 Yellow 43 Blue 44 Purple 45 Cyan 46 White 47
    }

    proc + {args} {
        variable map
        set t 0
        foreach i $args {
            set ix [lsearch -exact $map $i]
            if {$ix>-1} {lappend t [lindex $map [incr ix]]}
        }
        return "\033\[[join $t {;}]m"
    }

    proc get {code} {
        variable map
        set res [list]
        foreach i [split $code ";"] {
            set ix [lsearch -exact $map $i]
            if {$ix>-1} {lappend res [lindex $map [incr ix -1]]}
        }
        set res
    }

    proc text {w args} {
        variable $w.tags ""
        eval ::text $w $args
        rename ::$w ::_$w
        proc ::$w {cmd args} {
            regsub -all @ {([^@]*)(@\[([^m]+)m)} \x1b re
            set self [lindex [info level 0] 0]
            if {$cmd=="insert"} {
                foreach {pos text tags} $args break
                while {[regexp $re $text -> before esc code]} {
                    _$self insert $pos $before [set ansicolor::$self.tags]
                    set ansicolor::$self.tags [ansicolor::get $code]
                    set pos [_$self index insert]
                    regsub $re $text "" text
                }
                _$self insert $pos $text [concat $self.tags $tags]
            } else {
                uplevel 1 _$self $cmd $args
            }
        }
        foreach i {black red green yellow blue purple cyan white} {
            _$w tag configure $i -foreground $i
        }
        foreach i {Black Red Green Yellow Blue Purple Cyan White} {
            _$w tag configure $i -background [string tolower $i]
        }
        set w
    }
 
    #Test code:
 
    proc testtext {w args} {
        eval text $w -font {{Courier 9}} $args
        $w insert end "This line comes in blue directly, not via ANSI\n" \
            {blue Yellow}
        $w insert end "Hello [+ red Yellow]ANSI world[+] out there!\n\
            This line has no special markup.\n\
            [+ Black white]Inverted [+] right at the beginning..\
            ... and ending in [+ Blue yellow]Blue yellow [+]\n\
            [test]\n\
            [+ blue]End of test...[+]"
        set w
    }

    proc test {} {
        set res "Hello[+ bold Red white] world [+]again:\n"
        foreach i {black red green yellow blue purple cyan white} {
            append res "[+ bold $i][format %7s $i]: "
            foreach j {Black Red Green Yellow Blue Purple Cyan White} {
                append res "[+ $i $j][format %7s $j]"
            }
            append res \n
        }
        foreach i {bold light blink invert} {
            append res "testing [+ $i]$i mode[+]\n"
        }
        set res
    }

    proc cgrepf {what fp} {
        while {[gets $fp line]>-1} {
            if [regsub -all $what $line "[+ bold red]&[+]" line] {
                puts $line
            }
        }
    }

    proc cgrep {argc argv} {
        if $argc==0 {
            puts [test]
        } elseif $argc==1 {
            cgrepf [lindex $argv 0] stdin
        } else {
            foreach i [lrange $argv 1 end] {
                set fp [open $i]
                cgrepf [lindex $argv 0] $fp
                close $fp
            }
        }
    }
}

Example test program ansitext opens a colorful ansicolor::text widget:

#!/usr/bin/env tclsh
# testing ansicolor with an extended text widget in -*-Tcl-*-
package require Tk

source ansicolor.tcl
namespace import ansicolor::+
pack [ansicolor::testtext .t -wrap word] -fill both -expand 1
.t insert end [+ blue]Blue[+]

Example test program cgrep, can be used as a no-frills color grepper, or without arguments to show all color combinations on stdout:

#!/usr/bin/env tclsh
# testing ansicolor with a color grep in -*-Tcl-*-

source ansicolor.tcl
ansicolor::cgrep $argc $argv

screnshots:

 > ./cgrep.tcl

cgrepSS

 > ./cgrep.tcl proc ansicolor.tcl

cgrep2SS