
# This collection of routines implements a command completion for tcl
# It is usually kicked off with a call to Complete which is (usually)
# generated by typing a Tab in the input command line.  The caller
# should supply the following:
#
#  w      the window with the command to be completed.  An entry window
#         is assumed.
#  wd     a text window to display options (if double tab is typed)
#  alias  a list of local alias commands the first entry in each list
#         entry is taken as the string being aliased.  Other parts of
#         the list are not looked at and may be used to specify the target, etc.
#  local  a list of commands that are trapped locally.  
#  type   is the name of a command which if at the begining of the string
#         will cause all completions to assume they are commands.  
#         For linux this would be the 'type' command which is used to
#         poke around in the PATH and find where a command comes from.
#
#  alias local and type may be empty...
#  The code uses 'smart_dialog' to put up messages (over wd) on status 
#  such as the uniqueness of an entry and how many candidates there are.
#  Candidates come from, if the first entry on the line and '/' is not
#  in the entry or if 'type' is the first entry, alias, local and all 
#  enviorment Path locations, provided they are executable.
#  If the completion is not for a command (first entry or 'type')
#  then the file possibilities are explored up to the next '/'.

#  The code takes care of binding <DoubleTab> on 'w' to its own code.
#  If some other binding is desired, it should be to 'CompleteDoubleTab w'
#  where 'w' is the entry window.


proc Complete { w wd {alias {}} {local {}} {type {}}} {
  global comp
  if {[bind $w <Double-Tab>] != "CompleteDoubleTab  $w ;break"} {
    set comp($w,display) $wd
#    puts "doing tab $w"
    bind $w <Double-Tab> "CompleteDoubleTab  $w ;break"
    bind $w <KeyPress> "CompleteKeyPress $wd %k"
    bind $w <Return> "CompleteKeyPress $wd;[bind $w <Return>]"
    bind $w <KP_Enter> "CompleteKeyPress $wd;[bind $w <KP_Enter>]"
    catch "unset comp($wd,complete,insidx)"
  }
  set insidx [expr [$w index insert] - 1]
  # If he has not pressed a key and the insert has not
  # moved (possibly by mouse) then treat the tab as a 
  # double tab...
  if {[info exists comp($wd,complete,insidx)] && \
	   $insidx == $comp($wd,complete,insidx) } {
    CompleteDoubleTab $w
    return
  }
  CompleteKeyPress $wd
  set cmd [$w get]
  set wstart [string wordstart [FixCompleteString $cmd] $insidx]
  set wend [string wordend [FixCompleteString $cmd] $insidx]
  set word [string trim [string range $cmd $wstart $insidx]]
  set front [string length [string trim [string range $cmd 0 $wstart-1]]]
#  puts "word:$word front:$front wstart $wstart [string range $cmd 0 $wstart]<"
#  if {$word == ""} return
#  puts "head >[string range $cmd 0 $wstart-1]< word >$word<"
  if {$front != 0 && $word == {}} {incr wstart}
  lassign [split [string trim [string range $cmd 0 $wstart]]] camd
  set is_verb [expr {$front == 0 || $camd == $type ? 1 : 0 }]
  set comp($w,complete,list) [FilenameComplete $word $is_verb $alias $local]
  # Have all possible.  Now find the longest string that is common
  set len [FindLongestSub  $comp($w,complete,list)]
#  puts "After find >$word< $comp($w,complete,list) $len"
  set comp($w,complete,verb) $is_verb
  set comp($w,complete,cmd) $cmd
  set comp($w,complete,word) $word
  set comp($w,complete,wstart) $wstart
  set comp($w,complete,wend) $wend
  set comp($wd,complete,insidx) $insidx
  set comp($w,complete,newidx) [$w index insert]
  switch $len {
    -1 {smart_short $wd [list {} no " common but "\
			    [llength $comp($w,complete,list)] " found"]}
    -2 {smart_short $wd [list {} unique]}
    -3 {smart_short $wd [list {} no " completions found"] }
    -4 {smart_short $wd \
	    [list {} complete \
		 " and  [expr [llength $comp($w,complete,list)] -1]\
                     others found."]}
  }
  set repl {}
  switch $len {
    -1 -
    -3 -
    -4 {}
    -2  {
      CompleteWithThis $w 0 end
      return
    }
    default {
      CompleteWithThis $w 0 "$len-1"
      return
    }
  }
  if {$repl != {} } {
    set head [string range $cmd 0 [expr $wstart-1]]
    set tail [string range $cmd $wend end]
    set newcmd "$head$word$repl$tail"
    $w delete 0 end
    $w insert end $newcmd
    #    $w icursor [expr $insidx + 1]
    $w icursor [string wordend [FixCompleteString $newcmd] $insidx]
    set comp($w,complete,word) $word$repl
  }
  focus $w
}

proc CompleteDoubleTab { w } {
  global comp
  set wd $comp($w,display)
  # page size tells how to arrange the candidates.  They are arranged in
  # columns some what like a dictionary (the real one with pages). 
  # At each page size we start a new group or columns.  ALL pages will
  # have the same size columns.  If page is zero, we use the window size
  # to set the page size.  We put two blank lines between pages so the
  # user know when it changes.  A page size > 0 will use that size.  If
  # page size is 1, we will not use the blank lines.  This gives a 
  # left to right then down arrangement where as a larger value will
  # give top to bottom then right arrangement within each page.
  set pageSize 0
  CompleteKillFlash $wd
  # If we are here we should have a list of completions all ready to be
  # displayed.  We display them in the command window 'wd'

  CompleteKeyPress $wd
  set font [$wd cget -font]
  set linesPer [expr {[$wd cget -height] - 3}]
  set linesPer [expr {$pageSize == 0 ? $linesPer : $pageSize}]
  set lenList {}
  set total 0
  set pre $comp($w,complete,word)
  set pre [expr { [string range $pre end end] == "/" ? {} : [file tail $pre]}]
  set lpre [font measure $font "   $pre   "]
  if {[lindex $comp($w,complete,list) 0] == {}} {
    set comp($w,complete,list) \
	[lrange $comp($w,complete,list) 1 end]
  }
  foreach can $comp($w,complete,list) {
    set this [expr {[font measure $font $can] + $lpre}]
    lappend lenList $this
    incr total $this
  }
  set winWidth [winfo width $wd]
  # calculate the best possible fit.  This will, likely change....
  set lines [expr {($total / ($winWidth + 6)) + 1}]
  set Cols [expr {([llength $lenList] + $lines -1) / $lines}]
  if {$Cols <= 0} {return}
#  puts "$lenList"
  while (1) {
    set lines [expr {([llength $lenList] + $Cols -1) / $Cols}]
#    puts "try $Cols columns width $winWidth lines $lines \
#          total $total [llength $lenList]"
    for {set i 0} {$i < $Cols} {incr i} {set Tabs($i) 0}
    
    for {set l 0} {$l < $lines} {incr l $linesPer} {
      set line $l
      set idxs [expr {$line * $Cols}]
      while { $line < ($l +$linesPer)} {
#	puts "in while $line"
	for {set i 0;set idx $idxs} {$i < $Cols} \
	    {incr i;incr idx $linesPer} {
	      if {[set thislen [lindex $lenList $idx]] != {}} {
		set Tabs($i) [expr {max($Tabs($i),$thislen)}]
#		puts "$i $line Tabs($i) [lindex $lenList $idx]"
	      }
	    }
	incr line
	incr idxs
      }
    }
    set cwidth 0
    foreach {add ent} [array get Tabs] {incr cwidth $ent}
    if {$cwidth > $winWidth && $Cols > 1} {
      unset Tabs
      incr Cols -1
    } else {
      break
    }
  }
  set stops 1
  set stop 0
  for {set i 0} {$i < $Cols} {incr i} {
    incr stop $Tabs($i)
    lappend stops $stop 
  }
#  puts "$stops"
  set sel_bg [$wd cget -selectbackground]
  set bg     [$wd cget -background] 
  set fg     [$wd cget -foreground]
  set sel_fg [$wd cget -selectforeground]
  set comp($wd,end) [$wd index "end - 1 chars"]
  $wd insert end "\n\n"
  $wd insert end [_ "Mouse 1 selects...\n\n"]
  $wd config -tabs $stops
  for {set line [set l 0]} {$l < $lines} {set line [incr l $linesPer]} {
    set idxs [expr {$line * $Cols}]
    while { $line < ($l + $linesPer)} {
      for {set i 0;set idx $idxs} {$i < $Cols} \
	  {incr i;incr idx $linesPer} {
	if {[set this [lindex $comp($w,complete,list) $idx]] != {}} {
	  $wd insert end "\t"
	  $wd insert end "${pre}$this" tag$idx
	  $wd tag bind tag$idx <1> "CompleteWithThis $w $idx end"
	  $wd tag bind tag$idx <Enter> "$wd tag config tag$idx \
                                 -background $sel_bg -foreground $sel_fg"
	  $wd tag bind tag$idx <Leave> "$wd tag config tag$idx \
                                 -background $bg -foreground $fg"
	}
      }
      incr line
      incr idxs
      $wd insert end "\n"
    }
    $wd insert end "\n\n"
  }
  $wd see end
  $wd see $comp($wd,end)
#  puts "$wd"
}

proc CompleteWithBrowse {w} {
  # Come here when the user wants to browse to complete the name
  # In this case we try to start the file browse in a directory
  # s/he has already typed... if possible.
  # to get started we must have a current Tab execution so, just
  # do that and clear any info window
  global comp
  set insidx [expr [$w index insert] - 1]
  if {![info exists comp($w,display)] ||\
      ![info exists comp($comp($w,display),complete,insidx)] || \
	   $insidx != $comp($comp($w,display),complete,insidx) } {
    # The tab was not done.  We assume tab is the right key...
    event generate $w <Tab>
    puts "generate tab $w"
  }
  set wd $comp($w,display)
  # We are good to go.  Clear any info window
  CompleteKeyPress $wd
  set word [expr {[info exists comp($w,complete,word)] ? \
		      $comp($w,complete,word) : {}}]
  set fc [string range $word 0 0]
  set start {/}
  if {$fc == "." || $fc == "/"} {
    set start [expr {[file isdirectory $word] ? $word : [file dirname $word]}]
  }
  set fnam [tk_getOpenFile -initialdir $start -parent $comp($w,display)]
  if {$fnam == {}} { return }
  set comp($w,complete,word) $fnam
  CompleteWithThis $w [llength $comp($w,complete,list)] 0
}

proc CompleteWithThis { w idx len} {
  global comp
  set repl [string range [lindex $comp($w,complete,list) $idx] 0 $len]
  set repl [regsub -all { } $repl {\ }]
  set cmd $comp($w,complete,cmd) 
  set word $comp($w,complete,word)
  set wstart $comp($w,complete,wstart)
  set wend $comp($w,complete,wend)
  set insidx $comp($comp($w,display),complete,insidx)
  set head [string range $cmd 0 [expr $wstart-1]]
  set tail [string range $cmd $wend end]
  set newcmd "$head$word$repl$tail"
#  puts "cmd $cmd word >$word< wstart $wstart end $wend insidx $insidx head >$head< tail >$tail<"
  $w delete 0 end
  $w insert end $newcmd
  #    $w.bot.entry icursor [expr $insidx + 1]
#  puts "insidx $insidx used [string wordend [FixCompleteString $newcmd] $insidx] my guess [expr {[string length $head$word$repl] + 1}]"
  $w icursor [string length $head$word$repl]
  $w xview end
  focus $w
 }

proc FilenameComplete { word is_verb {alias {}} {local {}}} {
  global  env tcl_platform
  #set up the seperators we need to figure out if we are
  # dealing with a full file name and to parse the PATH
  if {$tcl_platform(platform) == "unix"} {
    set ispath "/"
    set pathsep ":"
  } else {
    set ispath ":"
    set pathsep ";"
  }
  set type [expr {$is_verb ? {x} : {}}]
  set candidates {}
  if {$is_verb && [string first $ispath $word] == -1} {
    foreach k [concat $alias $local] {
      set kk [lindex $k 0]
      if {[string match ${word}* $kk]} {
	lappend candidates $kk
      }
    }
    foreach k [split $env(PATH) $pathsep] {
      if {$::tcl_platform(platform) == "unix"} {
	set c [glob -nocomplain -path $k/ -types {x}  -tails ${word}*]
	set cf [glob -nocomplain -path $k/ -types {x} -tails ${word}*/]
      } else {
	# Windows tcl does a poor job of detecting executables..
	set c [glob -nocomplain -path $k/  -tails ${word}*]
	set cf [glob -nocomplain -path $k/ -tails ${word}*/]
      }
      # don't allow directories from path entries
      foreach can $c {
	if {[lsearch -exact $cf $can/] == -1} {
	  lappend candidates  $can
	}
      }
     }
#    set candidates [concat $al $candidates] 
    set candidates [lsort -unique $candidates]
  } else {
    if {$ispath == ":" && [string range $word end end] == ":"} {
      return "/"
    } 
    set r [catch {glob -nocomplain -types $type  ${word}*} c]
    set rr [catch {glob -nocomplain -types $type ${word}*/} cf]
    if {!$rr && $cf != {}} {
      set candidates [lsort -unique $cf]
    } else {
      set candidates {}
    }
#      puts "$r $c"
    if {!$r} {
      set c [lsort -unique $c]
      foreach can $c {
	if {[lsearch -exact $cf $can/] == -1} {
	  lappend candidates $can
	}
      }
    }
  }
  set rtn {}
  set len [string length $word]
  foreach can $candidates {
    lappend rtn [string range $can $len end]
  }
  return $rtn
}

# FindLongestSub finds the longest substring in the list of strings 's'.
#                It returns the end index of that string.
#
#                -1   indicates there is NO common substring. 
#                -2   indicates that there is only one string, i.e. unique.
#                -3   indicates that NO strings were passed in.
#                -4   indicates that there was an exact match (i.e. a zero
#                     length string was found)
#           
proc FindLongestSub { s} {
  switch [llength $s] {
    0 {return -3}
    1 {return -2}
  }
  set s1 [lindex $s 0]
  set ans [string length $s1]
  if {$ans == 0} {return -4}
  foreach str [lrange $s 1 end] {
    set ans [expr {min($ans, [string length $str])}]
    while { $ans > 0 && [string compare -length $ans $s1 $str ] != 0 } {
      incr ans -1
    }
    if {$ans <= 0} {return -1}
  }
  return $ans  
}

proc smart_short {wd mes} {
#  puts "$w"
  smart_dialog $wd.mess[incr ::uni] $wd {} $mes -1 0 {} [buildViewConfig]
}
#
# What does this do???
proc FixCompleteString { cmd } {
  set l ""
  set len [string length $cmd]
  for {set i 0} {$i < $len} {incr i} {
    set c [string index $cmd $i]
    if {0} {
    if {$c != " "} {
      set l "${l}x"
    } else {
      set l "${l}$c"
    }
    }
    if {1} {
    switch -exact $c {
      "\\" {
	#puts "here with >$c<"
	set l "${l}x"
      	if {[string length $l] < $len} {
	  incr i
	  set l "${l}x"
	}
      }
      " " {set l "${l} "}
      default {set l "${l}x"}
    }
    }
  }
  return $l
}

proc CompleteKillFlash {w} {
  foreach wi [winfo children $w] {
    if {[string match *.mess* $wi]} {
      destroy $wi
      return
    }
  }
}


proc CompleteKeyPress {wd {key {ww}}} {
  global comp
  CompleteKillFlash $wd
  if {[info exists comp($wd,end)]} {
    $wd delete $comp($wd,end) end
    unset comp($wd,end)
  }
  if {$key != "ww" } {
    catch "unset comp($wd,complete,insidx)"
  }
}
