#
# These routines complete a word, from some particular source.
#
# They are unique in several ways. First the source (a Text widget, for example)
# can (and usually will) contain duplicate words. Second the source may be 'big'
# so that only one completion is found. A new completion can be generated by
# successive completion calls, but the entire list of completions is not
# generated, unless the completion dialog is invoked.

# This is set to the index of the last completion found. (The index depends on
# the source).
set TH(Completion,Match) ""

# This is set to the prefix used for last completion, which determines whether
# we're running a new completion set or not.
set TH(Completion,Old) ""

# This tallies all the completions found for the current word.
set TH(Completion,Words) ""


# Like th_substring_replace, but works on the last word of text.
proc th_word_replace {source dummy s} {
  return [th_substring_replace [list th_complete_word $source] {} $s]
}

# Returns {completion msgdunno}, completion may be empty if none available.
# Can be used in th_substring_replace. Source indicates where to get
# possible completions, see th_complete_word_Misc for valid values.
proc th_complete_word {source s} {
  global TH
  if {($TH(Completion,Old) == "") || ![th_legit_completion $TH(Completion,Old) $s]} {
    set TH(Completion,Old) $s
    set TH(Completion,Match) ""
  } else {
    set s $TH(Completion,Old)
  }
  if {[set word [th_complete_word_Misc $source $s]] == ""} {
    return [list "" "No possible completions for:\n$s"]
  } else {
    return [list $word "@th_complete_all_words \{$source\} $s"]
}}

# Generates all completions of s.
proc th_complete_all_words {source s} {
  while {[th_complete_word_Misc $source $s] != ""} {}
  global TH
  if {$TH(Completion,Words) == ""} {bell ; return}
  return "Possible completed words:\n$TH(Completion,Words)"
}


# Various sources for completion routines
# They all return a unique completion of s, or "" if unsuccessful.

# Determines the type of source, and calls the appropriate completion routine
proc th_complete_word_Misc {source s} {
  if {$source == ""} {
    return [th_complete_word_abbrevs $s]
  }
  if {[winfo exists $source]} {
    return [th_complete_word_[winfo class $source] $source $s]
  }
  if {[file exists $source]} {
    return [th_complete_word_file $source $s]
  }
  return [th_complete_word_string $source $s]
}

# Uses text widget w as the source for completions.
# Searches backwards from insert to beginning, then end to insert. (This
# is nice when the completion is occurring in w, the most recent completion
# comes up first, not the first completion in w.)
proc th_complete_word_Text {w s} {
  global TH
  set old_wordstart [$w index "insert -1c wordstart"]
  set flag 0
  while {1} {
    if {$TH(Completion,Match) == ""} {
      set TH(Completion,Words) ""
      set TH(Completion,Match) $old_wordstart}
    set TH(Completion,Match) [$w search -backward -- $s $TH(Completion,Match) 1.0]
    if {$TH(Completion,Match) == ""} {
      if $flag {return ""}
      set TH(Completion,Match) end-1c 
      set flag 1
      continue}
    if {[$w compare $TH(Completion,Match) == $old_wordstart]} {
      set TH(Completion,Match) "" ; return ""}
    if {[$w compare "$TH(Completion,Match) -1c wordstart" != "$TH(Completion,Match) -1c"]} {continue}
    set new_word [$w get $TH(Completion,Match) "$TH(Completion,Match) wordend"]
    if {[lsearch -exact $TH(Completion,Words) $new_word] >= 0} {continue}
    lappend TH(Completion,Words) $new_word
    return $new_word
}}

# Uses the words in l (a list as the source for completions.
# Searches backwards from insert to beginning, then end to insert. (This
# is nice when the completion is occurring in w, the most recent completion
# comes up first, not the first completion in w.)
#
# The entry and message widget will use this routine on their text.
# The file routine will use this routine on its file's contents.
proc th_complete_word_string {string s} {
  global TH
  while {1} {
    if {$TH(Completion,Match) == ""} {
      set TH(Completion,Words) ""
      set TH(Completion,Match) -1}
    incr TH(Completion,Match)
    set range [string range $string $TH(Completion,Match) end]
    set match [string first $s $range]
    if {$match == -1} {set TH(Completion,Match) "" ; return ""}
    incr TH(Completion,Match) $match
    set wordstart [string wordstart $range $match]
    if {$wordstart != $match} {continue}
    set wordend [string wordend $range $match] ; incr wordend -1
    set new_word [string range $range $wordstart $wordend]
    if {[lsearch -exact $TH(Completion,Words) $new_word] >= 0} {continue}
    lappend TH(Completion,Words) $new_word
    return $new_word
}}

proc th_complete_word_Entry {w s} {
  return [th_complete_word_string [$w get] $s]
}

proc th_complete_word_Message {w s} {
  return [th_complete_word_string [$w cget -text] $s]
}

# f is a file, that contains the possible words.
proc th_complete_word_file {f s} {
  global TH
  set file [open $f r]
  set string [read $file]
  close $file
  return [th_complete_word_string $string $s]
}

# Tries to expand s using an abbreviation list.
proc th_complete_word_abbrevs {s} {
  global TH
  if {[lsearch [array names TH] "Completion,Abbrevs"] < 0} {return ""}

  set i [th_search_list $TH(Completion,Abbrevs) $s]
  set new_word [lindex $TH(Completion,Wordlist) $i]

  if {($new_word != $s) && ([lsearch $TH(Completion,Words) $new_word] < 0)} {
    lappend TH(Completion,Words) $new_word
    set TH(Completion,Match) $i
    return $new_word
  } else {
    set TH(Completion,Words) ""
    set TH(Completion,Match) -1
    return ""}
}

# Does a binary search on a sorted list. Index returned is either index of
# item, or index of element immediately before item.
proc th_search_list {list item} {
  set min -1
  set l [llength $list]
  set max $l
  while {($min < [expr $max - 1])} {
    set i [expr ($min + $max) / 2]
    set r [lindex $list $i]
    set x [string compare $item $r]
    if {$x < 0} {set max $i ; continue
    } elseif {$x > 0} {set min $i ; continue
    } else {return $i}
  }
  return $min
}


# These are dummy procedures that keep completh from complaining when a word
# is performed on these widgets
# This makes widgets able to complete on Listboxes
proc th_complete_word_Listbox {w s} {return ""}
proc th_complete_word_Canvas {w s} {return ""}

