Updated 2014-01-20 12:48:42 by RLE

Bryan Oakley writes:

This is something I've kept in my back pocket for a while. It hasn't gone through rigorous testing but seems to work well enough for my needs.

Usage:

forText pathName ?-elide? ?-regexp? ?-nocase? ?-exact? pattern start end script

The -elide, -regexp, -nocase and -exact options are passed directly to the text widget's search command.

This command will loop over all of the text in the widget specified by pathName. Each time a range of characters matches pattern the marks matchStart and matchEnd will be set and the specified script will be run.

Example:
   # this example adds the tag 'highlight' to all occurrences
   # of text inside <>
   pack [text .t] -side top -fill both -expand y 
   .t tag configure highlight -foreground red
   <insert text into widget>
   forText .t -regexp {***:<.*?>} 1.0 end {
      .t tag add highlight matchStart matchEnd
   }

   proc forText {w args} {

      # initialize search command; we may add to it, depending on the
      # arguments passed in...
      set searchCommand [list $w search -count count]

      # Poor man's switch detection
      set i 0
      while {[string match {-*} [set arg [lindex $args $i]]]} {

         if {[string match $arg* -regexp]} {
            lappend searchCommand -regexp
            incr i
         } elseif {[string match $arg* -elide]} {
            lappend searchCommand  -elide
            incr i
         } elseif {[string match $arg* -nocase]} {
            lappend searchCommand  -nocase
            incr i
         } elseif {[string match $arg* -exact]} {
            lappend searchCommand  -exact
            incr i
         } elseif {[string compare $arg --] == 0} {
            incr i
            break
         } else {
            return -code error "bad switch \"$arg\": must be\
              --, -elide, -exact, -nocase or -regexp"
         }
      }

      # parse remaining arguments, and finish building search command
      foreach {pattern start end script} [lrange $args $i end] {break}
      lappend searchCommand $pattern matchEnd searchLimit

      # make sure these are of the canonical form
      set start [$w index $start]
      set end [$w index $end]

      # place marks in the text to keep track of where we've been
      # and where we're going
      $w mark set matchStart $start
      $w mark set matchEnd $start
      $w mark set searchLimit $end

      # default gravity is right, but we're setting it here just to
      # be pedantic. It's critical that matchStart and matchEnd have
      # left and right gravity, respectively, so that any text inserted
      # by the caller duing the search won't normally (*) cause an infinite
      # loop. 
      # (*) If the script inserts text after the matchEnd mark, and the
      # text that was added matches the pattern, madness will ensue.
      $w mark gravity searchLimit right
      $w mark gravity matchStart left
      $w mark gravity matchEnd right

      # finally, the part that does useful work. Keep running the search
      # command until we don't find anything else. Each time we find 
      # something, adjust the marks and execute the script
      while {1} {
         set cmd $searchCommand
         set index [eval $searchCommand]
         if {[string length $index] == 0} break

         $w mark set matchStart $index
         $w mark set matchEnd  [$w index "$index + $count c"]

         uplevel $script
      }
   }