When using text widget for some serious text editing – such as ''HTML patterns'' – then it's helpful to have a simple package dealing the job of Search, Replace with all bells and whistles.

Usage: see documentation.

License: [OLL] as always. Have fun! [wdb]

======
#!/usr/bin/wish

#
# file: textSearchWindow-0.1.tm
#
# usage: textSearchWindow $textwidget
# opens search dialog
# 
# Button "Search" selects search text.
# Button "Mark all" hilights all occurrences of search text.
# Button "Replace" replaces currently found search text.
# Button "Replace all" replaces all search text as follows:
#  - if some text selected: inside selection bounds,
#  - else if radiobutton "Up": upwards from insert to start of text,
#  - else if radiobutton "Down": downwards from insert to end of text.
# Button "Replace, Search" invokes buttons "Replace", then "Search".
# Serves as shorcut for case-wise manual replacements.
# Radiobuttons "Up", "Down" decide search direction.
# Checkbutton "Case-sensitive" decides on exact search.
# Checkbutton "Regexp" switches to pattern matching.
# Pattern matching uses substitution of \0, \1, \2 ...
# 
# Key <Return> invokes button "Search".
# Key <Escape> invokes button "Cancel".
# 

package provide textSearchWindow 0.1

namespace eval textSearchWindowDialog {
  # try to install translation tools
  if {[catch {
        package require msgcat
        namespace import ::msgcat::mc
      }]} then {
    proc mc x {set x}
  }
  namespace export textSearchWindow
  array set search {
    text ""
    replace ""
    direction -forwards
    case -nocase
    count ""
    all ""
    regexp ""
    found 0
  }
}

proc textSearchWindowDialog::textSearchWindow win {
  # create search dialog for text widget
  set search $win.search
  if false then {
    destroy $search
  } elseif {[winfo exists $search]} then {
    focus -force $search.oldtext
    return
  }
  set search [toplevel $search]
  bind $search <Return> "$search.find invoke"
  bind $search <Escape> "$search.cancel invoke"
  wm transient $search [winfo toplevel $win]
  wm resizable $search yes no
  grid columnconfigure $search 0 -weight 1
  grid\
    [entry $search.oldtext\
       -textvariable ::textSearchWindowDialog::search(text)]\
    [button $search.find -text [mc Search] -command [subst {
        textSearchWindowDialog::findSelect $win
      }]]\
    [button $search.mark -text [mc "Mark all"] -command [subst {
        textSearchWindowDialog::markAll $win
      }]]\
    -sticky news
  grid\
    [entry $search.newtext\
       -textvariable ::textSearchWindowDialog::search(replace)]\
    [button $search.replace -text [mc Replace] -command [subst {
        textSearchWindowDialog::replace $win
      }]]\
    [button $search.replacefind -text [mc "Replace all"] -command [subst {
        textSearchWindowDialog::replaceAll $win
      }]]\
    -sticky news
  raise $search.oldtext
  raise $search.newtext
  set options $search.options
  grid\
    [frame $options -bg ""]\
    [button $search.replaceall -text [mc "Replace, Search"]\
       -command [subst {
        $search.replace invoke
        $search.find invoke
      }]]\
    [button $search.cancel -text [mc Cancel] -command [subst {
        destroy $search
      }] -fg red]\
    -sticky news
  grid ^ -in $search
  grid\
    [radiobutton $options.up -text [mc Up]\
       -variable textSearchWindowDialog::search(direction)\
       -value -backwards]\
    [checkbutton $options.case -text [mc Case-sensitive]\
       -variable ::textSearchWindowDialog::search(case)\
       -onvalue ""\
       -offvalue -nocase]\
    -sticky w
  grid\
    [radiobutton $options.down -text [mc Down]\
       -variable textSearchWindowDialog::search(direction)\
       -value -forwards]\
    [checkbutton $options.regexp -text [mc Regexp]\
       -variable  ::textSearchWindowDialog::search(regexp)\
       -onvalue -regexp\
       -offvalue ""]\
    -sticky w
}

namespace import textSearchWindowDialog::textSearchWindow

proc textSearchWindowDialog::unBackslash text {
  string map [list \\\\ \\ \\n \n \\t \t] $text
}

proc textSearchWindowDialog::basicSearchString win {
  # create command out of array search(...)
  variable search
  lappend result $win search\
    -count ::textSearchWindowDialog::search(count)\
    $search(direction)
  append result " $search(case) $search(regexp) "
}

proc textSearchWindowDialog::find win {
  # return index of $search(text)
  variable search
  if {$search(direction) eq "-backwards"} then {
    if {[$win tag ranges sel] eq ""} then {
      set from insert
    } else {
      set from sel.first
    }
    set to 1.0
  } else {
    if {[$win tag ranges sel] eq ""} then {
      set from insert
    } else {
      set from sel.last
    }
    set to end
  }
  set text $search(text)
  if {$search(regexp) eq ""} then {
    set text [unBackslash $text]
  }
  set search(count) ""
  set idx [{*}[basicSearchString $win] $text $from $to]
  set search(found) [llength $search(count)]
  if {$idx ne ""} then {
    list $idx [$win index $idx+$search(count)chars]
  }
}

proc textSearchWindowDialog::findSelect win {
  # find and select 
  set indices [find $win]
  $win tag remove sel 1.0 end
  if {$indices ne ""} then {
    $win tag add sel {*}$indices
    $win mark set insert sel.first
    $win see insert
    focus -force $win
  }
}

proc textSearchWindowDialog::replace win {
  # replace found text
  if {[$win tag ranges sel] ne ""} then {
    variable search
    set replaceText $search(replace)
    lassign [$win tag ranges sel] from to
    set selection [$win get $from $to]
    set selText [$win get $from $to]
    if {$search(regexp) eq ""} then {
      if {$selText eq [unBackslash $search(text)]} then {
        $win configure -autoseparators no
        $win edit separator
        $win delete $from $to
        $win insert $from [unBackslash $replaceText]
        $win edit separator
        $win configure -autoseparators yes
        focus -force $win
      }
    } else {
      if {[regexp $search(text) $selText match] && 
          $match eq $selText} then {
        regsub {*}$search(case)\
          $search(text) $selText $search(replace) replace
        $win configure -autoseparators no
        $win edit separator
        $win delete $from $to
        $win insert $from [unBackslash $replace]
        $win edit separator
        $win configure -autoseparators yes
        focus -force $win
      }
    }
  }
}

proc textSearchWindowDialog::findAll {win {from 1.0} {to end}} {
  # return bounds of all occurrences
  variable search
  set dir $search(direction)
  set search(direction) -forwards
  lappend result
  set text [unBackslash $search(text)]
  set search(count) ""
  set indices [{*}[basicSearchString $win] -all $text $from $to]
  set search(found) [llength $search(count)]
  set search(direction) $dir
  if {$indices ne ""} then {
    foreach idx $indices len $search(count) {
      lappend result $idx [$win index $idx+${len}chars]
    }
    set result
  }
}

proc textSearchWindowDialog::markAll win {
  # hilight all occurrences
  variable search
  $win tag remove yellow 1.0 end
  if {$search(text) eq ""} then return
  $win tag configure yellow -background yellow
  $win tag lower yellow sel
  foreach {from to} [findAll $win] {
    $win tag add yellow $from $to
  }
}

proc textSearchWindowDialog::replaceAll win {
  # replace all occurrences in certain range
  variable search
  set replaceText $search(replace)
  if {$search(regexp) eq ""} then {
    set replaceText [unBackslash $replaceText]
  }
  if {[$win tag ranges sel] ne ""} then {
    # range: sel
    lassign [$win tag ranges sel] from to
  } elseif {$search(direction) eq "-backwards"} then {
    # range: start to insert
    lassign "1.0 insert" from to
  } else {
    # range: insert to end
    lassign "insert end" from to
  }
  $win configure -autoseparators no
  $win edit separator
  foreach {to from} [lreverse [findAll $win $from $to]] {
    # Dangerous naming: $from, $to used twice ...
    # detected after posting this article.
    # Accidentally works.
    # won't correct it, leave as an exercise for you to correct.
    if {$search(regexp) eq ""} then {
      $win delete $from $to
      $win insert $from $replaceText
    } else {
      regsub {*}$search(case)\
        $search(text) [$win get $from $to] $search(replace)\
        replace
      $win delete $from $to
      $win insert $from [unBackslash $replace]
    }
  }
  $win see insert
  $win edit separator
  $win configure -autoseparators yes
}
======

<<categories>>Enter Category Here