Using colors when printing text to a console can be quite helpful for a program's users and, under Unix-like operating systems, it is natively supported by almost any shell. The following code shows the '''ccolor''' namespace containing several variables with common color codes and a procedure for parsing text containing tags. On the bottom of the page you can find examples on how to use it. According to the valuable insights by [RLE] (thanks!), I've made improvements to the code and replaced it below: ---- ======tcl # ########################################################################### # # Description: # This namespace contains console color codes defined in variables which # can be used for adding color in text strings. # Additionally, it contains a procedure which replaces certain tags in a # text with their corresponding color codes, making the resulting string # suitable for dumping to a console supporting colors. # As a reference, the following table lists the escape codes used and their # corresponding effect on the text (note: the '\e' sequence represents # the '0x1b' hexadecimal number: # |-------------------|--------------------|------------------| # |Effects |Foreground Colors |Background Colors | # |-------------------|--------------------|------------------| # |bold : \e[1m |black : \e[30m |black : \e[40m | # |-------------------|--------------------|------------------| # |dim : \e[2m |red : \e[31m |red : \e[41m | # |-------------------|--------------------|------------------| # |underlined : \e[4m |green : \e[32m |green : \e[42m | # |-------------------|--------------------|------------------| # |blink : \e[5m |yellow : \e[33m |yellow : \e[43m | # |-------------------|--------------------|------------------| # |reverse : \e[7m |blue : \e[34m |blue : \e[44m | # |-------------------|--------------------|------------------| # |invisible : \e[8m |magenta : \e[35m |magenta : \e[45m | # |-------------------|--------------------|------------------| # | |cyan : \e[36m |cyan : \e[46m | # |-------------------|--------------------|------------------| # | |white : \e[37m |white : \e[47m | # |-------------------|--------------------|------------------| # | |default : \e[39m |default : \e[49m | # |-------------------|--------------------|------------------| # # To reset the color codes: # - reset : \e[0 # # Examples: # puts [ccolor::replace "Blue on a yellow background."] # puts [ccolor::replace "Underline and reverse."] # ########################################################################### # namespace eval ccolor { variable reset [binary format a4 \x1b\x5b\x30\x6d] # Helpful control characters # variable backspace [binary format a1 \x08] variable home [binary format a1 \x0d] # Foreground # variable bold [binary format a4 \x1b\x5b\x31\x6d] variable dim [binary format a4 \x1b\x5b\x32\x6d] variable underlined [binary format a4 \x1b\x5b\x34\x6d] variable blink [binary format a4 \x1b\x5b\x35\x6d] variable reverse [binary format a4 \x1b\x5b\x37\x6d] variable invisible [binary format a4 \x1b\x5b\x39\x6d] # Foreground colors # variable black [binary format a5 \x1b\x5b\x33\x30\x6d] variable red [binary format a5 \x1b\x5b\x33\x31\x6d] variable green [binary format a5 \x1b\x5b\x33\x32\x6d] variable yellow [binary format a5 \x1b\x5b\x33\x33\x6d] variable blue [binary format a5 \x1b\x5b\x33\x34\x6d] variable magenta [binary format a5 \x1b\x5b\x33\x35\x6d] variable cyan [binary format a5 \x1b\x5b\x33\x36\x6d] variable white [binary format a5 \x1b\x5b\x33\x37\x6d] variable def [binary format a5 \x1b\x5b\x33\x39\x6d] # Background colors # variable bblack [binary format a5 \x1b\x5b\x34\x30\x6d] variable bred [binary format a5 \x1b\x5b\x34\x31\x6d] variable bgreen [binary format a5 \x1b\x5b\x34\x32\x6d] variable byellow [binary format a5 \x1b\x5b\x34\x33\x6d] variable bblue [binary format a5 \x1b\x5b\x34\x34\x6d] variable bmagenta [binary format a5 \x1b\x5b\x34\x35\x6d] variable bcyan [binary format a5 \x1b\x5b\x34\x36\x6d] variable bwhite [binary format a5 \x1b\x5b\x34\x37\x6d] variable bdef [binary format a5 \x1b\x5b\x34\x39\x6d] # Variables for tags replacement and escaping # variable replacements variable escapes # ########################################################################### # # Description: # This procedure checks if the console seems to have color support by # checking the 'tput' program. # Additionally, it will set the 'escapes' and 'replacements' namespace # variables for later use by the 'ccolor::replace' procedure. # Parameters: # None. # Returns: # Raises an error if the console does not seem to have color support. # ########################################################################### # proc initialize {} { variable replacements variable escapes # Go through each pair of values # foreach {tagLetters colorVar} {"e" bold "s" dim "u" underlined "f" blink \ "v" reverse "i" invisible "k" black "r" red \ "g" green "y" yellow "b" blue "m" magenta \ "c" cyan "w" white "d" def "kb" bblack \ "rb" bred "gb" bgreen "yb" byellow "bb" bblue \ "mb" bmagenta "cb" bcyan "wb" bwhite "db" bdef \ "/" reset "bs" backspace "cr" home} { # Create a local variable linked to the namespace one # variable $colorVar # Append the escape pair to the list to be used when replacing escaped tags # lappend escapes "<<$tagLetters>" "<$tagLetters>" # Append the tag pair to the list to be used replacing tags by their codes # lappend replacements "<$tagLetters>" [set $colorVar] } # If the 'tput' program does not exist or the shell does not seem to support colors # if {![file exists "/usr/bin/tput"] || [catch {exec /usr/bin/tput setaf 1}]} { # Raise an error # error "The console does not seem to support colors" } } # ########################################################################### # # Description: # This procedure will parse the given input text and will replace all tags # with the corresponding color code. The tags are: # |---------------------|------------------|--------------------------| # |Effects |Foreground Colors |Background Colors | # |---------------------|------------------|--------------------------| # | : bold (Emphasis)| : black | : black background | # |---------------------|------------------|--------------------------| # | : underlined | : red | : red background | # |---------------------|------------------|--------------------------| # | : dim (Shadow) | : green | : green background | # |---------------------|------------------|--------------------------| # | : blink (Flash) | : yellow | : yellow background | # |---------------------|------------------|--------------------------| # | : reVerse | : blue | : blue background | # |---------------------|------------------|--------------------------| # | : invisible | : magenta | : magenta background | # |---------------------|------------------|--------------------------| # | | : cyan | : cyan background | # |---------------------|------------------|--------------------------| # | | : white | : white background | # |---------------------|------------------|--------------------------| # | | : default | : default background | # |---------------------|------------------|--------------------------| # # To reset text printing to its normal behavior, use: # : reset # If you want to keep one of these tags unchanged in your text, please # escape them by pre-pending an additional '<' character. For example: # "The < tag sets the text color to red" # "The < tag resets printed text to its normal behavior." # Additional helpful control tags: # : backspace # : carriage return # Examples of legal tagged text: # "This text is red and this one is bold green." # "Blue on a yellow background." # ########################################################################### # proc replace {taggedText} { variable replacements variable escapes # Make sure the escaped tags do not get replaced # regsub -all -- "<<" $taggedText "<< " taggedText # Replace the tags by their color codes # set taggedText [string map $replacements $taggedText] # Re-establish the escaped tags # regsub -all -- "<< " $taggedText "<<" taggedText # Un-escape them and return the resulting text # return [string map $escapes $taggedText] } # Call the initialization procedure # initialize } ====== ---- Here's a short example on how to use it (assuming the code has been saved in a file named ''ccolor.tcl''): ======tcl tclsh8.5 [~]source ccolor.tcl tclsh8.5 [~]append tagged_text "The following is a list of categories (not automatically updated, so there could be some missing) with short descriptions:\n" tclsh8.5 [~]append tagged_text " * Category Category - the meta category - covers the list of all categories.\n" tclsh8.5 [~]append tagged_text " * Category Uncategorized - the \"anti-category\" - put on a page as a reminder that it hasn't really been categorized yet.\n" tclsh8.5 [~]append tagged_text " * Category 3D Graphics - pages relating to 3D graphical display of information\n" tclsh8.5 [~]append tagged_text " * Category Broken Links - used in connection with the Broken Link Report\n" tclsh8.5 [~]puts [ccolor::replace $tagged_text] ====== Or, if you want to use the namespace variables directly in a text string: ======tcl tclsh8.5 [~]puts " * ${ccolor::blue}Category AI${ccolor::reset} - pages relating to Artificial Intelligence" tclsh8.5 [~]puts " * ${ccolor::blue}Category Critcl${ccolor::reset} - discussion of the Tcl runtime compile extension ${ccolor::bgreen}critcl${ccolor::reset}" ====== ---- [RLE] (2012-11-09): Is there a reason you chose to use a slew of sequential regsub calls in your replace proc instead of building up a [string map] list and using [string map] to perform the replacements of the tags with the appropriate color escape values? [rui] (2012-11-13): I've made it that way only to make it simple to see the operations the code was making. However, I find your solution more elegant and made the changes accordingly in the code above. I.e. (this is only for four colors, I didn't want to copy and edit everything here): ====== set replacements [ list < < < < $ccolor::bold $ccolor::dim $ccolor::underlined $ccolor::blink ] set replaced_text [ string map $replacements $taggedText ] ====== Note that the first replacements in the list (< ...) must remain ahead of the color replacements, because they handle your escaping mechanism. One call to [string map], with one pass over the string will be significantly faster than 54 individual [regsub%|%regsubs] which each have to traverse the string in full each time to make each single replacement. The replacements list could be built up with a [foreach] loop to save typing as well (this assumes at least Tcl 8.5): ====== foreach {echar colorvar} {e bold d dim u underlined f blink} { lappend replacements <<$echar> <$echar> lappend list2 <$echar> [ set ccolor::$colorvar ] } lappend replacements {*}$list2 ====== If you run the [foreach] in the [namespace] initialization code, and store the results in a [namespace] variable, then the [foreach] only needs to execute once, when the [namespace] is loaded. Also, the way you are accessing the [namespace] "ccolor" variables has a dependency upon the implicit manner in which Tcl resolves [namespace] paths. As long as your [namespace] is only ever loaded into the root [namespace] (::) everything will work. But if your [namespace] is ever loaded inside another [namespace] (so the path becomes anotherNamespace::ccolor::bold) the variable look-up will fail. [rui] (2012-11-13): Thanks for the hint - I've corrected the code so it now uses the ''variable'' command. <>Unix