#
# String completion for Misc widgets
#

if {[lsearch [array names TH] "Completion,Prefix"] < 0} {
  set TH(Completion,Prefix) {uplevel #0}
}
if {[lsearch [array names TH] "Completion,Message"] < 0} {
  set TH(Completion,Message) {}
}


# Some string manipulation routines

# Returns 1 if c is a legit completion for s, 0 otherwise.
proc th_legit_completion {s c} {
  if {$s == [string range $c 0 [expr [string length $s] -1]]} {return 1
  } else {return 0}
}

# Removes everything before the newline, inclusive from the message.
proc th_remove_prefix {message} {
  set index [string first \n $message]
  incr index
  return [string range $message $index end]
}

# Breaks a string by the last occurrence of delimiter.
# Returns a list of {head delimiter tail}
# or {head "" ""} if no delimiter exists.
# If delimiter is empty, returns the last word.
proc th_string_divide {s {delimiter ""}} {
  if {$delimiter == ""} {
    set i [string wordstart $s [expr [string length $s] - 1]]
    return [list [string range $s 0 [expr $i-1]] "" [string range $s $i end]]
  } else {
    set i [string last $delimiter $s]
    if {$i == -1} {
      return [list $s "" ""]
    } else {return [list [string range $s 0 [expr $i - 1]] $delimiter \
	[string range $s [expr $i + [string length $delimiter]] end]]
}}}

# Returns each possibility that begins with prefix.
proc th_filter_completions {prefix possibilities} {
  set completions ""
  foreach completion $possibilities {
    if {[th_legit_completion $prefix $completion]} {
      lappend completions $completion}}
  return "Possible completions:\n$completions"
}


# These are the functions useful for completion routines.

# Function is some code that takes s and yields the possible completions.
# This proc attempts to complete a string between delimiter and end.
proc th_substring_complete {function delimiter s} {
  if {$delimiter == "none"} {set list [list "" "" $s]
  } else {set list [th_string_divide $s $delimiter]}
  if {([lindex $list 2] == "")} {return [list "" ""]}
  set completion [th_string_complete $function "" [lindex $list 2]]
  if {([lindex $completion 0] == "")} {return [list "" ""]
  } else {return [lreplace $completion 0 0 [join [lreplace $list 2 2 \
            [lindex $completion 0]] ""]]
}}

# Filter is some code that takes s and yields the possible replacements.
# Replaces the substring [delimiter-end].
proc th_substring_replace {filter delimiter s} {
  if {$delimiter == "none"} {set list [list "" "" $s]
  } else {set list [th_string_divide $s $delimiter]}
  if {([lindex $list 2] == "")} {return [list "" ""]}
  set replacement [eval $filter [list [lindex $list 2]]]
  if {([lindex $replacement 0] == "")} {return $replacement
  } else {return [lreplace $replacement 0 0 [join [lreplace $list 1 2 [lindex $replacement 0]] ""]]
}}


# Simple string completion (no beeps or widgets, just completion)

# Attempts completion of a prefix,
# First function is given prefix and possibilities, and should return a list
# of valid completions.
proc th_string_complete {function possibilities prefix} {
  set message [eval $function \{$prefix\} \{$possibilities\}]
  set completions [th_remove_prefix $message]
  if {$completions == ""} {return [list "" ""]}
  if {[llength $completions] == 1} {
    return [list [lindex $completions 0] ""]
  } else {set index 0
    set flag 1
    set string [lindex $completions 0]
    while 1 {
      set char [string index $string $index]
      if {$char == ""} break
      foreach completion $completions {
        if {[string index $completion $index] != $char} {
          set flag 0 ; break}}
      if $flag {incr index} else {break}}
    return [list [string range $string 0 [expr $index-1]] $message]
}}

# Tries each completion in the completion list until one works.
# Returns {result message index} where index is the index in s where
# completion started.
proc th_string_complete_multiple {s completion_list} {
  set message ""
  foreach completion_fn $completion_list {
    set output [eval $completion_fn [list $s]]
    if {[lindex $output 1] != ""} {
      set message [lindex $output 1]}
    if {[lindex $output 0] != ""} {
      set result [lindex $output 0]
      if {[lindex $completion_fn 2] == "none"} {set sublist [list "" "" $s]
      } else {set sublist [th_string_divide $s [lindex $completion_fn 2]]}
      set index [string length [lindex $sublist 0]]
      incr index [string length [lindex $sublist 1]]
      return [list $result $message $index]
    }}
  return [list "" $message [string length $s]]
}

# Like tk_dialog, but instead of a dialog of choices, brings up a listbox
proc th_dialog_listbox {w title text options {view 0}} {
  global tk_priv

  # 1. Create the top-level window and divide it into top
  # and bottom parts.

  catch {destroy $w}
  toplevel $w -class Dialog
  wm title $w $title
  wm iconname $w Dialog
  wm protocol $w WM_DELETE_WINDOW { }
  wm transient $w [winfo toplevel [winfo parent $w]]
  frame $w.top -relief raised -bd 1
  pack $w.top -side top -fill both
  frame $w.bot -relief raised -bd 1
  pack $w.bot -side bottom -fill both

  # 2. Fill the top part with message.

  label $w.msg -wraplength 3i -justify left -text $text \
	    -font -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
  pack $w.msg -in $w.top -side top -expand 1 -fill both -padx 3m -pady 3m

  # 3. Create a listbox in the middle.

  listbox $w.top.list -relief sunken -setgrid yes
  scrollbar $w.top.hscroll -orient {horizontal} -relief {raised}
  scrollbar $w.top.vscroll -relief {raised}
  $w.top.vscroll configure -command "$w.top.list yview"
  $w.top.hscroll configure -command "$w.top.list xview"
  $w.top.list configure -xscrollcommand "$w.top.hscroll set" \
    -yscrollcommand "$w.top.vscroll set"
  pack $w.top.hscroll -in $w.top -side bottom -fill x
  pack $w.top.list -in $w.top -side right -fill both -expand yes
  pack $w.top.vscroll -in $w.top -side right -fill y
  eval $w.top.list insert 0 [lsort $options]
  bind $w.top.list <Double-ButtonPress-1> {set tk_priv(button) [%W nearest %y]}
  if {[llength $options] > 9} {set lmax 9} else {set lmax [llength $options]}
  for {set j 0} {$j < $lmax} {incr j} {
    bind $w.top.list <Key-[expr $j+1]> "%W selection clear 0 end ; %W selection set $j"
  }
  incr view -5 ; if {$view < 0} {set view 0}
  $w.top.list xview $view
  $w.top.list activate 0

  button $w.button -text "OK" -command "set tk_priv(button) \[$w.top.list curselection\]"
  frame $w.default -relief sunken -bd 1
  raise $w.button $w.default
  pack $w.default -in $w.bot -side left -expand 1 -padx 3m -pady 2m
  pack $w.button -in $w.default -padx 2m -pady 2m -ipadx 2m -ipady 1m
  bind $w.top.list <Key-0> "%W selection clear 0 end"
  bind $w.top.list <Return> "$w.button flash; set tk_priv(button) \[$w.top.list curselection\]"

  # 4. Withdraw the window, then update all the geometry information
  # so we know how big it wants to be, then center the window in the
  # display and de-iconify it.

  wm withdraw $w
  update idletasks
  set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
    - [winfo vrootx [winfo parent $w]]]
  set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
    - [winfo vrooty [winfo parent $w]]]
  wm geom $w +$x+$y
  wm deiconify $w

  # 5. Set a grab and claim the focus too.

  set oldFocus [focus -displayof [winfo toplevel $w]]
  grab $w
  tkwait visibility $w
  focus $w.top.list

  # 6. Wait for the user to respond, then restore the focus and
  # return the index of the selected button.

  set selection ""
  tkwait variable tk_priv(button)
  if {$tk_priv(button) == ""} {set result ""
  } else {set result [$w.top.list get $tk_priv(button)]}
  focus $oldFocus
  destroy $w
  return $result
}


# General things called by all binding procedures

# Returns longest unambiguous completion of s. given the possible completions
# ($possibilities) and a function to decide which of the possibilities are
# legit.
proc th_Misc_complete {s possibilities {function filter_completions}} {
  set completion [th_string_complete $function $possibilities $s]
  global TH
  set TH(Completion,Index) -1
  set TH(Completion,Message) [lindex $completion 1]
  if {([lindex $completion 0] == "") || ([lindex $completion 1] != "")} {bell}
  return [lindex $completion 0]
}

# Attempts multiple completions on string s until one succeeds.
proc th_Misc_complete_multiple {s completion_list} {
  set completion [th_string_complete_multiple $s $completion_list]
  global TH
  set TH(Completion,Message) [lindex $completion 1]
  set TH(Completion,Index) [lindex $completion 2]
  if {([lindex $completion 0] == "") || (([lindex $completion 1] != "") &&
	([string index [lindex $completion 1] 0] != "@"))} {bell}
  return [lindex $completion 0]
}

# Shows list of completions, letting user pick one.
proc th_Misc_completion_dialog {view} {
  global TH
  if {$TH(Completion,Message) == ""} {bell ; return}
  if {[string index $TH(Completion,Message) 0] == "@"} {
    set TH(Completion,Message) [eval [string range $TH(Completion,Message) 1 end]]}
  if {[string  match {Possible *} $TH(Completion,Message)]} {
    set index [string first \n $TH(Completion,Message)]
    set msg [string range $TH(Completion,Message) 0 $index]
    incr index
    set options [string range $TH(Completion,Message) $index end]
    return [th_dialog_listbox .conf {Completion Dialog} $msg $options $view]
  } else {tk_dialog .conf Error $TH(Completion,Message) info 0 OK ; return
}}

# Compiles a list of all completions of w, from its bindtags
proc th_completions {w} {
  set list ""
  global TH
  foreach bindtag [bindtags $w] {
    if {![catch "set TH(Completions,$bindtag)"]} {
      eval lappend list $TH(Completions,$bindtag)
  }}
  return $list
}