#!/usr/bin/wish

#
# file: textSearchWindow-0.2.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,
#  - radiobutton "Up": upwards from insert to start of text,
#  - 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.2

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.replaceall -text [mc "Replace all"] -command [subst {
        textSearchWindowDialog::replaceAll $win
      }]]\
    -sticky news
  set options $search.options
  grid\
    [frame $options -bg ""]\
    [button $search.replacefind -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
  apply {{search args} {
      foreach button $args {raise $search.$button}
    }} $search oldtext newtext find mark replace replacefind replaceall
  apply {{options args} {
      foreach button $args {raise $options.$button}
    }} $options case regexp up down
}

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) {*}$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) ne ""} then {
    $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] fromRange toRange
  } elseif {$search(direction) eq "-backwards"} then {
    # range: start to insert
    lassign "1.0 insert" fromRange toRange
  } else {
    # range: insert to end
    lassign "insert end" fromRange toRange
  }
  $win configure -autoseparators no
  $win edit separator
  foreach {to from} [lreverse [findAll $win $fromRange $toRange]] {
    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
}

if {1} {

        package require Tk
        package require textSearchWindow
        
        set t [toplevel .textsearch]
        wm withdraw .
        
        set txt [text $t.txt]
        pack $txt -fill both -expand true
        
        # generate some arbitrary data...
        foreach p [lsort -dictionary [info procs]] {
                set body [string map {"\n" " "} [info body $p]]
                $txt insert end $body
        }
        
        textSearchWindowDialog::textSearchWindow $txt
}