# jprefixmatch.tcl - utility procedures for prefix matching/expansion
#
######################################################################
# Copyright 1992-1999 by Jay Sekora.  This file may be freely        #
# distributed, modified or unmodified, for any purpose, provided     #
# that this copyright notice is retained verbatim in all copies and  #
# no attempt is made to obscure the authorship of this file.  If you #
# distribute any modified versions, I ask, but do not require, that  #
# you clearly mark any changes you make as such and that you provide #
# your users with instructions for getting the original sources.     #
######################################################################

package provide aq 0.1

# following has side-effect of making sure ::aq namespace is defined
namespace eval ::aq {
  namespace export {[a-z]*}
}

######################################################################
# ::aq::longest_match l - longest common initial string in list l
#   used by tab-expansion in filename dialogue box
######################################################################
# this needs commenting desperately

proc ::aq::longest_match { l } {
  case [llength $l] in {
    {0} { return {} }
    {1} { return [lindex $l 0] }
  }
  set first [lindex $l 0]
  set matchto [expr {[string length $first] - 1}]
  for {set i 1} {$i < [llength $l]} {incr i} {
    set current [lindex $l $i]
    # if they don't match up to matchto, find new matchto
    if { [string compare \
           [string range $first 0 $matchto] \
           [string range $current 0 $matchto]] } {
      # loop, decreasing matchto until the strings match that far
      for {} \
          {[string compare \
              [string range $first 0 $matchto] \
              [string range $current 0 $matchto]] } \
          {incr matchto -1 } \
          {}			;# don't need to do anything in body
    } ;# end if they didn't already match up to matchto
  } ;# end for each element in list
  if {$matchto < 0} then {
    return {}
  } else {
    return [string range $first 0 $matchto]
  }
}

######################################################################
# ::aq::expand_filename f - expand filename prefix as much as possible
#       (for use in file dialogue boxes)
######################################################################
# note: if the filename has *, ?, or [...] in it, they will be used
#       as part of the globbing pattern.  i declare this a feature.

proc ::aq::expand_filename { f } {
  set glob_list [glob -nocomplain "${f}*"]
  set expansion [::aq::longest_match $glob_list]
  if {$expansion == ""} {return $f}
  # make sure it doesn't already end in "/":
  set expansion [string trimright $expansion "/"]
  # append / if the expansion is (1) unique, ie, not a prefix of another
  #   file, and (2) a directory:
  if {[file isdirectory $expansion] && [llength $glob_list] == 1} {
    append expansion "/"
  }
  return $expansion
}
