Updated 2014-08-20 04:38:45 by slebetman

Grep is a wonderful piece of software that allows you to search for patterns in text. But sometimes you only want the pattern highlighted instead of hiding everything that is not the pattern because sometimes the text surrounding the pattern you're looking for is important.

So I wrote the short script below to colorize text based on regexp.

Usage: cgrep regexp option option ...

Where regexp is a regular expression to match and option describes how to color the matched text. The options are one or more of:
  -fg color      foreground color.
  -bg color      background color.
  -style effect  text style.

where "color" is one of: black, red, green, yellow, blue, magenta, cyan or white

and "effect" is one of: none, bright, dim, underline, blink or reverse

More than one match may be specified.

Example, color the line containing "foo" red and underline the word "bar":

cgrep '^.*foo.*$' -fg red 'bar' -style underline

See Also: ANSI color control

Code:
#! /usr/bin/env tclsh

proc ESC {} {return \033}

proc ANSI {args} {
  # Support list and args conventions:
  if {[llength $args] == 1 && [llength [lindex $args 0]] > 1} {
    set args [lindex $args 0]
  }
  set ret "\033\["
  foreach {op val} $args {
    switch -- $op {
      -style {}
      -bg {append ret 4}
      -fg {append ret 3}
    }
    switch -- $val {
      black     {append ret "0;"}
      red       {append ret "1;"}
      green     {append ret "2;"}
      yellow    {append ret "3;"}
      blue      {append ret "4;"}
      magenta   {append ret "5;"}
      cyan      {append ret "6;"}
      white     {append ret "7;"}
      none      {append ret "0;"}
      bright    {append ret "1;"}
      dim       {append ret "2;"}
      underline {append ret "4;"}
      blink     {append ret "5;"}
      reverse   {append ret "7;"}
    }
  }
  set ret [string trim $ret ";"]
  return ${ret}m
}

fconfigure stdin  -buffering none
fconfigure stdout -buffering none -translation binary

if {$argv == ""} {
set title "cgrep:"
append title "[ANSI -fg green -bg black] C"
append title "[ANSI -fg red]o"
append title "[ANSI -fg yellow]l"
append title "[ANSI -fg cyan]o"
append title "[ANSI -fg white]r "
append title "[ANSI -style none]your text!"
puts $title
puts {usage: cgrep regexp option option ...

Where regexp is a regular expression to match and option describes
how to color the matched text. The options are one or more of:
  -fg color    foreground color.
  -bg color    background color.
  -style effect  text style.
  
where "color" is one of:
black, red, green, yellow, blue, magenta, cyan or white

and "effect" is one of:
none, bright, dim, underline, blink or reverse

More than one match may be specified.

Example, color the line containing "foo" red and underline the
word "bar":

  cgrep '^.*foo.*$' -fg red 'bar' -style underline
}
exit
}

# Support named patterns:
if {([llength $argv] == 1) && [file exists ~/.cgrep]} {
  set f [open ~/.cgrep]
  set data [read $f]
  close $f
  
  foreach {name patterns} $data {
    if {$name == [lindex $argv 0]} {
      set argv $patterns
      break
    }
  }
}

proc shift {ls} {
  upvar 1 $ls LIST
  if {[llength $LIST]} {
    set ret [lindex $LIST 0]
    set LIST [lreplace $LIST 0 0]
    return $ret
  } else {
    error "Ran out of list elements."
  }
}

proc unshift {ls val} {
  upvar 1 $ls LIST
  set LIST [concat [list $val] $LIST]
}

proc process_args {argv} {
  set ret [list]
  while {[llength $argv]} {
    set re [shift argv]
    set format [list]
    while {[llength $argv]} {
      set op [shift argv]
      switch -exact -- $op {
        -fg - -bg - -style {
          set x [shift argv]
          if {[string match -* $x]} {
            unshift argv $x
            unshift argv $op
            break
          }
          lappend format $op $x
        }
        default {
          unshift argv $op
          break
        }
      }
    }
    lappend ret $re $format
  }
  return $ret
}

proc merge_color {current new} {
  array set c {-bg {} -fg {} -style {}}
  array set n {-bg {} -fg {} -style {}}
  foreach {style arr} {current c new n} {
    array set $arr [set $style]
  }
  foreach x {-bg -fg -style} {
    if {$n($x) == ""} {
      if {$c($x) != ""} {
        set n($x) $c($x)
      } else {
        unset n($x)
      }
    }
  }
  return [array get n]
}

proc get_matches {line formatting} {
  set ret [list]
  foreach {re color} $formatting {
    set matches [regexp -inline -all -indices -- $re $line]
    foreach m $matches {
      foreach {start end} $m {incr end; break}
      lappend ret [list $start start $color]
      lappend ret [list $end end $color]
    }
  }
  return $ret
}

proc resequence {formatting} {
  set ret [list]
  set cstack [list]
  foreach x [lsort -dictionary $formatting] {
    foreach {mark type color} $x break
    switch -- $type {
      start {
        unshift cstack $color
        set color [merge_color [lindex $cstack 0] $color]
        # unshift cstack $color
        set clist [list $color]
      }
      end {
        shift cstack
        set clist {{-style none}}
        lappend clist [lindex $cstack 0]
      }
    }
    lappend ret $mark $clist
  }
  return $ret
}

proc render_line {line formatting} {
  set n 0
  set ret ""
  foreach {mark colors} $formatting {
    append ret [string range $line $n [expr {$mark-1}]]
    foreach color $colors {
      append ret [ANSI $color]
      #append ret "{$color}"
    }
    set n $mark
  }
  append ret [string range $line $n end]
  append ret [ANSI {-style none}]
  #append ret "{-none}"
  return $ret
}

proc main {argv} {
  set args [process_args $argv]
  
  while {[gets stdin line] >= 0} {
    puts [render_line $line [resequence [get_matches $line $args]]]
  }
}

main $argv

Jorge - 2013-05-11 03:32:47

I think the very last line should read:
 main $argv

(I may be wrong)

I tried the following and it works great:
 tclsh cgrep.tcl '^proc.*{$' -fg red '^proc' -style underline < cgrep.tcl

thanks for sharing!

slebetman - 2014-08-20

@Jorge: Thanks for that bug report. Sorry it took me a long time to notice :)