# jedit_paren.tcl - support for matching brackets in jedit
#
# These procedures are by David Svoboda <svoboda@ece.cmu.edu>, from the
# Beth editor (the predecessor of Elsbeth).  They were borrowed and
# modified by Christian Artigues <artigues@ensta.fr> and Maurice
# Diamantini <diam@ensta.fr> for the STEAD editor (based on jedit), and
# I'm incorporating them back into jedit (somewhat modified), with David's
# permission.
# 
# I don't have the original copyright information for Beth, but
# Elsbeth's copyright is:
#
#   Elsbeth & Teacher Hypertools: Copyright (c) 1994  David Svoboda
# 
# (and this code is very similar to the code in the current version of
# Elsbeth).  There's an Elsbeth home page at
#
# http://www.ece.cmu.edu/afs/ece/usr/svoboda/www/elsbeth/homepage.html

# TO DO:
# * make searching for matches much more efficient (what if you're at
#   the end of a 1Mb document?
# * maybe these procedures should be merged into the bindings libraries

######################################################################
# j:tkb:flash_paren W K A -
#   find corresponding left-parenthesis in $W and flash it
######################################################################

proc jedit:flash_paren { W K A } {
  global JEDIT_LEFT_MATCH JEDIT_MODEPREFS
  
  set mode [jedit:get_mode [jedit:text_to_top $W]]
  jedit:self_insert_punct $W $K $A
  if $JEDIT_MODEPREFS($mode,parenflash) {
    jedit:paren:flash_left_paren $W $JEDIT_LEFT_MATCH($K) $A
  }
}

######################################################################
# jedit:paren:find_left_paren t left right close_trace -
#   return index of matching left partner, or "" if unsuccessful.
#   (this procedure is from Beth)
######################################################################

proc jedit:paren:find_left_paren {t left right close_trace} {
  set left [string trimleft $left \\]
  set right [string trimleft $right \\]
  # set close_trace [$t index "$index -1 chars"]
  set open_trace $close_trace
  while (1) {
    update
    # go back 1 left, quit if none found.
    set backset [string last $left [$t get 1.0 $open_trace]]
    if {($backset < 0)} {return ""}
    set open_trace [$t index "1.0 +$backset chars"]
    # go back 1 right, if none after open, return current open
    set offset [string last $right [$t get \
      $open_trace $close_trace]]
    if {($offset < 0)} {return $open_trace}
    set close_trace [$t index "$open_trace +$offset chars"]
  }
}

######################################################################
# jedit:paren:char_count t c start end -
#   counts instances of $c between $start and $end in $t
#   (this procedure is from Beth)
######################################################################

proc jedit:paren:char_count {t c start end} {
  set offset 0
  set count 0
  set c [string trimleft $c \\]
  
  while {[set offset [string first $c [$t get $start $end]]] >= 0} {
    incr count
    set start [$t index "$start +$offset chars +1 chars"]
  }
  return $count
}

######################################################################
# jedit:paren:balance_count t left right start end -
#   checks if $left and $right occur same # of times in [$start $end] of $t
#   (this procedure is from Beth)
######################################################################

proc jedit:paren:balance_count {t left right start end} {
  set c1 [jedit:paren:char_count $t $left $start $end]
  set c2 [jedit:paren:char_count $t $right $start $end]
  
  if {($c1 > $c2)} {return "[string trimleft $left \\] [expr $c1-$c2]"}
  if {($c2 > $c1)} {return "[string trimleft $right \\] [expr $c2-$c1]"}
  return ""
}

######################################################################
# jedit:paren:flash_left_paren t left right
#   flash left partner of character $left in text $t, or beep if none
#   (this procedure is from STEAD)
######################################################################

proc jedit:paren:flash_left_paren {t left right} {
  set result [jedit:paren:find_left_paren \
    $t $left $right [$t index "insert -1 chars"]]
  if {($result == "")} {		;# not found
    ::aq::beep $t
  } else {
    jedit:flash $t $result "$result +1 chars"
  }
}

######################################################################
# jedit:flash t from to - flash a range briefly
######################################################################

proc jedit:flash {t from to} {
  global JEDIT_PREFS
  
  set bg $JEDIT_PREFS(textbg)
  set fg $JEDIT_PREFS(textfg)
  
  $t tag configure jedit_paren_match -background $fg -foreground $bg
  $t tag raise jedit_paren_match
  
  $t tag add jedit_paren_match $from $to
  update
  
  after 200 "$t tag delete jedit_paren_match"
}

