#
# Module for balancing parens in Misc widgets
#


# Init & clear list of expressions to check for a widget
proc th_Misc_paren_initialize {w} {
  global TH
  set TH(Paren,Left,$w) "" ; set TH(Paren,Right,$w) ""
  set TH(Paren,Nest,$w) "" ; set TH(Paren,Right,Char,$w) ""
  return ""
}

# Add a set of expressions to check for a widget
proc th_Misc_paren_add {w left right {nest 1}} {
  global TH
  th_Misc_paren_instantiate $w
  set TH(Paren,Left,$w) [concat [th_char_protect $left] $TH(Paren,Left,$w)]
  set TH(Paren,Right,$w) [concat [th_char_protect $right] $TH(Paren,Right,$w)]
  set TH(Paren,Nest,$w) [concat $nest $TH(Paren,Nest,$w)]
  set TH(Paren,Right,Char,$w) [concat [th_char_protect [string index $right \
	[expr [string length $right] - 1]]] $TH(Paren,Right,Char,$w)]
  return ""
} 

proc th_Misc_paren_instantiate {w} {
  global TH
  if {![catch "set TH(Paren,Nest,$w)"]} {return}
  foreach var {Left Right Nest Right,Char Show} {
    set TH(Paren,$var,$w) $TH(Paren,$var,[winfo class $w])
}}

# Check for matching left expression, after user types a (valid?) character,
# which should finish off a right expression.
# (For example, if user just typed '/' as in '*/', searches for '/*')
proc th_Misc_exp_check_self {w c} {
  if {(![regexp . $c])} {return}
  th_[winfo class $w]_self_insert $w $c
  global TH
  th_Misc_paren_instantiate $w
  if {[set i [lsearch $TH(Paren,Right,Char,$w) $c]] < 0} {return}
  return [th_Misc_exp_check $w $i]
}

# Check for matching left expression, don't know which pair to use.
proc th_Misc_exp_check {w {i -1}} {
  th_Misc_paren_instantiate $w
  if {$i == -1} {set i 0 ; set int_flag 1} else {set int_flag 0}
  if {[set exp [th_[winfo class $w]_prev_exp $w $i]] < 0} {
    if $int_flag {bell}
    return
  }
  global TH
  return [th_Misc_check_exp $w [lindex $TH(Paren,Left,$w) $exp] \
	[lindex $TH(Paren,Right,$w) $exp] [lindex $TH(Paren,Nest,$w) $exp]]
}

# Check for matching left expression, given which pair to use.
proc th_Misc_check_exp {w left right nest} {
  global TH
  set result [th_[winfo class $w]_left_exp $w insert $left $right $nest]
  set msg [th_[winfo class $w]_report_exp $w $result insert $left $right $nest]
  if {($result == "")} {
    set msg "No $left found!!!" ; bell
  } else {
    set msg_bal [th_Misc_check_balance $w $result insert $left $right $nest]
    if {$msg_bal != ""} {set msg $msg_bal ; bell}
  }
  if {([string length $msg] < $TH(Paren,Length))} {
    set width [string length $msg]} else {set width $TH(Paren,Length)}
  if $TH(Paren,Show,$w) {
    th_flash_label $w -text $msg -relief raised -width $width -anchor e
  }
  return $result
}

# Makes sure everything is balanced between start and end. Returns an error
# message, or "" if OK.
proc th_Misc_check_balance {w start end left right nest} {
  global TH
  set msg ""
  set l [llength $TH(Paren,Left,$w)]
  for {set i 0} {$i < $l} {incr i} {
    set count_left [lindex $TH(Paren,Left,$w) $i]
    if {($count_left != $left) || !([lindex $TH(Paren,Nest,$w) $i])} {
      set char [th_Misc_balance_count $w $count_left \
		 [lindex $TH(Paren,Right,$w) $i] $start $end]
    if {($char != "")} {set msg "Excess $char" ; break
  }}}
  return $msg
}

# Checks if $left and $right occur the same # of times in [$start $end] of $w
proc th_Misc_balance_count {w left right start end} {
  set class [winfo class $w]
  set c1 [th_[set class]_char_count $w $left $start $end]
  set c2 [th_[set class]_char_count $w $right $start $end]
  if {($c1 > $c2)} {return "$left [expr $c1-$c2]"}
  if {($c2 > $c1)} {return "$right [expr $c2-$c1]"}
  return ""
}


# Returns the expression left of the cursor, or "".
proc th_Misc_left_exp {w} {
  th_Misc_paren_instantiate $w
  if {[set exp [th_[winfo class $w]_prev_exp $w]] < 0} {return ""}
  global TH
  return [th_[winfo class $w]_left_exp $w insert [lindex $TH(Paren,Left,$w) $exp] [lindex $TH(Paren,Right,$w) $exp] [lindex $TH(Paren,Nest,$w) $exp]]
}

# Returns the expression right of the cursor, or "".
proc th_Misc_right_exp {w} {
  th_Misc_paren_instantiate $w
  if {[set exp [th_[winfo class $w]_next_exp $w]] < 0} {return}
  global TH
  return [th_[winfo class $w]_right_exp $w insert [lindex $TH(Paren,Left,$w) $exp] [lindex $TH(Paren,Right,$w) $exp] [lindex $TH(Paren,Nest,$w) $exp]]
}

# Selects the expression at the left or right of the cursor, if one exists.
proc th_Misc_select_exp {w} {
  th_Misc_paren_instantiate $w
  if {[set i [th_Misc_left_exp $w]] != ""} {
    th_[winfo class $w]_select_range $w $i insert
  } elseif {[set i [th_Misc_right_exp $w]] != ""} {
    th_[winfo class $w]_select_range $w insert $i
  } else {bell}
}
