#!/afs/ece/usr/tcl/bin/wish -f
# The next line is executed by most shells, but not Tcl \
wish $0 $*


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

# Help text.
set Help "" ; append Help {Parenth -- Add bindings to help keep parentheses balanced.

This program teaches text and entry widgets to indicate when parentheses,
brackets, etc. are unbalanced, and to maniplate parenthetical expressions.

} $TH_Bindings_Help {

Widgets of Parenth

The Select Checkbutton

When a matching open paren is found, that open paren can be highlighted. If this
button is on, it gets the selection. If this button is off, it does not get
selected, but for a Text widget, it receives a 'paren' tag, which may have other
highlighting features. If this button is off, open parens are not highlighted
for Entry widgets. Paren highlighting disappears after a few seconds.


Show Local Text Checkbutton

When a matching open paren is found, if it is not on the screen, highlighting
won't help (unless you happen to scroll over it before it disappears), so the
text on the same line as the open paren up to the paren can be flashed in a
label below the widget. If this button is on, the local text is flashed; if this
button is off, the local text is not shown.


Maximum Message String Length Scale

If the text local to a matching open paren is printed during a paren check, that
string can be very long, depending on how long the line is before the matching
open paren. If the string is longer than n, which is the value in this scale,
only the last n characters before the open paren are shown.


Matching Paren Tag Configuration Entry

If the Select checkbutton is off, then open parens in a text widget get tagged
for a few seconds when their matching close paren is entered. This entry
specifies the configurations of this tag.


'New Pair' Entry, 'Nest-able' Checkbutton, and 'Add to Menu' Button

These widgets provide a simple means of adding new pairs of expressions for
parenth to teach. The entry should get two expressions, separated by a space.
The first one is the leftmost delimiter, such as '/*', and the second one is the
rightmost delimiter, such as '*/'. Some paren expressions are nestable. For
example, nested parenthetical expressions like "(foo (bar))" are almost always
OK, so parentheses are nestable, but nested C comment delimiters, like '/*/*
*/*/' are not good C, so C comment delimiters are not nestable. If your new pair
is nestable, turn the nestable checkbutton on, otherwise leave it off. The 'Add
to Menu' button adds the current pair in the entry (along with its
'nestability') to the Expressions menu.


The Expressions Menu

This menu consists of a list of types of expressions. When a widget is taught
parenth's code, it keeps balanced every type of expression pairs in the menu
whose checkbuttons are highlighted. For example, when parenth starts up,
parentheses, brackets, and braces are highlighted, but quotes and angle brackets
are not. So any applications that learn parenth code will learn to balance
parentheses, brackets, and braces, but not quotes or angle brackets. You can
toggle the status of any expression set in the menu by selecting its menuentry.

} $TH_Frame_Help


# Gives app all the code necessary to do our functions.
proc teach_code {} {
  global Class Paren_Select Paren_Tag Msg_Length Paren_Show TH_Dir App
  if {![file exists "$TH_Dir/lib/paren.[set Class].tcl"]} {return ""}

  include_files [list browse.$Class.tcl "th_[set Class]_goto"] \
	[list edit.$Class.tcl "th_[set Class]_self_insert"] \
	[list paren.$Class.tcl "th_[set Class]_left_exp"] \
	{paren.Misc.tcl th_Misc_left_exp}

  if $Paren_Select {set tag "sel"} else {set tag "paren"}
  do_cmd_set TH(Paren,Select,$Class) $tag

  if {($Class == "Text") && !$Paren_Select} {
    do_cmd_set TH(Paren,Text,Tag) $Paren_Tag
  }

  do_cmd_set TH(Paren,Length) $Msg_Length
  do_cmd_set TH(Paren,Show,$Class) $Paren_Show
  if {$Paren_Show || ((!$Paren_Select != "sel") && ($Class == "Text"))} {teach_frame_code}

  do_cmd "th_Misc_paren_initialize $Class\n" 0
  foreach expression [form_menu_selected Expressions] {
    do_cmd "th_Misc_paren_add $Class $expression\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/paren.[set Class].tcl"]} {
    set bindings $Bindings(Paren)} else {return ""}
  return [widget_frame_bindings $bindings]
}


create_form_menu Expressions \
	{Parentheses {\( \)}} \
	{Brackets {\{ \}}} \
	{Braces {\[ \]}} \
	{Quotes {\" \" 0}} \
	{"Angle Brackets" "< > 0"}
for {set i 4} {$i <= 5} {incr i} {set Menu(expressions,$i) 0}
pack [frame .padd] -side bottom -fill x
create_form_entry .padd.ne "New Pair" Paren_Pair "/* */"
th_add_history .padd.ne.thistory .padd.ne.e "#if #endif" "#if #endif"
create_form_checkbutton .padd.nest "Nest-able?" Paren_Nest 1 right
pack [button .padd.add -text "Add to Menu" -command {
  add_to_form_menu Expressions [list [.padd.ne.e get] \
	[concat [.padd.ne.e get] $Paren_Nest]]}] -side right
create_form_entry .pt "Matching Paren Tag Configuration" Paren_Tag \
             "-background red"
create_form_scale .parenlen "Maximum Message String Length" Msg_Length 30 \
             -from 5 -to 50
create_form_checkbutton .parenframe "Select Found Paren" Paren_Select 1 left
create_form_checkbutton .parenshow "Show Local Text" Paren_Show 0 left
