#!/afs/ece/usr/tcl/bin/wish -f

set Bind_Keyword [file tail [info script]]
source "[file dirname [info script]]/../aux/frame.tcl"

# Help text.
set Help "" ; append Help {Searcheth -- Add keybindings to search for strings in textual widgets.

This program teaches widgets that contain text how to search for a particular
string, or glob expression, or regular expression. You can also replace any or
all matches found.

} $TH_Bindings_Help {

Widgets of Searcheth

The Select Button

When a match is found, the widget is scrolled to view the found string, but
some means must be employed to highlight the text. If this button is turned
on, then the matching text will be selected, either by the sel tag in the text
widget, or the sel in the entry or listbox (note the listbox selects the line
with the matching text). If turned off, the text will not be highlighted with
the selection, but will be clearly indicated. Listboxes will bring the line
to the top of the listbox's view, entries will bring the start of the matching
text to the left of the entry's view, and texts will mark the highlighted text
with the 'search' tag. The search tag has some color specifications wired into
it to make it clearly visible; you can change them using configureth.
If you give searcheth an argument of 0, the button is turned off upon startup,
otherwise it is left on.


The Replacement Button

If this button is on, then the functions for replacing any or all matches of a
search string are added.


Old Found Text Entry

Whenever searches are performed on a text widget, all text that has ever been
the object of a search gets a tag. This entry specifies configurations for that
tag, so that text can be displayed differently. The tag disappears whenever a
search is exited.


Current Found Text Entry

The text found under a search on a text widget also gets a tag. If the 'Select'
button is on, it gets the Select tag. Otherwise, it gets a search tag, with
configurations specified on this line to highlight the text. The tag is removed
whenever a search is exited or another search is performed.


Replaced Text Entry

The text substituted during a replace operation gets a tag. This line specifies
the configurations for that tag. This replacement tag can coincide with the
old-found-text tag, but it is higher in priority, so its configurations will
dominate the other tag's configurations if they collide.

} $TH_Frame_Help {
Listboxes behave slightly differently than text and entry widgets. Whenever a
match is found in a listbox, the entire line is highlighted, but only matching
text is highlighted in a text or entry widget. The glob must apply to the
entire line in a listbox, to match any substring of a listbox line, encase
your glob expression in *'s. When glob expressions are used on text or entry
widgets, any special character that leads the expression gets applied to all
word beginnings, and any special character that ends the expression gets applied
to all word endings. Canvases act like listboxes, in that the entire text of
a canvas's text item that contains a match is selected.

The $ and ^ characters, which specify the beginning and end of a string during
regular-expression searching only work on listboxes; where they specify the
beginning and end of a line, respectively.

Leaving the selection off for canvas searching is rather quirky, since the
only way the program knows what is the current search item, if it is not
selected is the item at the upper-left corner, and it is often not possible to
view the canvas such that an item is on the upper-left corner. So use the select
option for canvases.
}


# Gives app all the code necessary to do our functions.
proc teach_code {} {
  if {[widget_bindings] == ""} {return ""}

  global TH_Dir Class
  include_files {search.Misc.tcl th_Misc_search}
  if {[file exists "$TH_Dir/lib/search.[set Class].tcl"]} {
    include_files [list search.$Class.tcl "th_[set Class]_find"]
  }
  if {($Class != "Listbox") && ($Class != "Text") && [file exists "$TH_Dir/lib/browse.[set Class].tcl"]} {
    include_files [list browse.$Class.tcl "th_[set Class]_goto"]
  }
  if {$Class == "Entry"} {
    include_files {browse.Misc.tcl th_string_wordstart}
  }

  teach_frame_code
  foreach binding {Search_Forward Search_Backward
		 Toggle_Case_Sensitivity Toggle_Incremental_Search} {
    teach_binding_code $binding}

  global Search_Select Replace
  if $Search_Select {set tag "sel"} else {set tag "search"}
  do_cmd "set TH(Search,Select,$Class) $tag\n" 0

  if {$Replace && [file exists "$TH_Dir/lib/replace.$Class.tcl"]} {
    include_files {replace.Misc.tcl th_Misc_replace_setup} \
	[list replace.$Class.tcl th_[set Class]_replace_one]
    foreach binding {Replace_One Replace_All} {
       teach_binding_code $binding
  }}

  if {$Class == "Text"} {
    global Old_Search_Tag Search_Tag Replace_Tag
    do_cmd "set TH(Search,Text,Oldtag) \{$Old_Search_Tag\}\n" 0
    if {!$Search_Select} {
      do_cmd "set TH(Search,Text,Tag) \{$Search_Tag\}\n" 0
    }
    teach_binding_code Highlight_Searches
    if $Replace {
      do_cmd "set TH(Replace,Tag) \{$Replace_Tag\}\n" 0
}}}

# For a widget, returns the appropriate bindings. (They will depend on the
# widget)
proc widget_bindings {} {
  global TH_Dir Bindings Class
  set bindings ""
  if {[file exists "$TH_Dir/lib/search.[set Class].tcl"]} {
    set bindings $Bindings(Search)}
  return [widget_frame_bindings $bindings]
}


create_form_entry .st "Configuration of Current Found Text:" Search_Tag \
          "-background yellow -foreground black"
create_form_entry .ost "Configuration of Old Found Text:" Old_Search_Tag \
          "-background yellow4 -foreground white" 
create_form_entry .rt "Configuration of Replacement Text:" Replace_Tag \
          "-background orange4 -foreground white"
frame .searchframe ; pack .searchframe -fill x
create_form_checkbutton .searchframe.select "Select Found Item" Search_Select \
          1 left
create_form_checkbutton .searchframe.replace "Add Replacement" Replace 1 left


