!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: autocomplete.gs,v 1.5 2008-01-09 22:50:08 stever Exp $
!
! Superclass Hierarchy:
!   AutoComplete, Object.
!
!=========================================================================

expectvalue %String
run
Object _newKernelSubclass: 'AutoComplete'
    instVarNames: #(#realStrings #lookupStrings)
    classVars: #()
    classInstVars: #()
    poolDictionaries: #[]
    inDictionary: Globals
    constraints: #()
    instancesInvariant: false
    isModifiable: false
    reservedOop: 735
%

! remove existing behavior from AutoComplete
removeallmethods AutoComplete
removeallclassmethods AutoComplete

category: 'For Documentation Installation only'
classmethod: AutoComplete
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'The AutoComplete class is a name completer.  Given a collection of names it
 can find a prefix of one fairly quickly.'.
doc documentClassWith: txt.

txt := (GsDocText new) details:
'A SortedCollection of the StringPairs holding the original strings and a
 mapping to lookupStrings.'.
doc documentInstVar: #realStrings with: txt.

txt := (GsDocText new) details:
'The upper case versions of all the strings in the search domain.'.
doc documentInstVar: #lookupStrings with: txt.

self description: doc.
%

! ------------------- Instance methods for AutoComplete
category: 'Initializing'
method: AutoComplete
addString: str

"Adds the given string to the search domain of the receiver."

| alist idx newpair |

alist := realStrings.
newpair := StringPair new key: (str asUppercase) value: str.
alist add: newpair.
idx := alist indexOf: newpair.  "find the new item's location for insertion"
lookupStrings insertObject: newpair key at: idx.
%

category: 'Completing'
method: AutoComplete
commonChars: s1 with: s2

"Returns a count of the number of Characters common between two Strings."

| sz |
sz := s1 size min: s2 size.
1 to: sz do: [ :i |
  ((s1 at: i) isEquivalent: (s2 at: i)) ifFalse: [
    ^i - 1
  ].
].
^sz.
%

category: 'Completing'
method: AutoComplete
complete: string

"Attempts to complete the given string from our current set.  Returns either
 the original string, or a replacement for it that is either the same length or
 longer."

| ch sz i name curstr initlen matchlen len found |

lookupStrings == nil ifTrue: [
  ^string
].

curstr := String new add: string; yourself .
curstr size == 0 ifTrue: [
  ^string
].

"Do a fast search for the first Character"
ch := curstr at: 1.
sz := lookupStrings size.
i := 1.
[ (i > sz) _or: [ch isEquivalent: ((lookupStrings at: i) at: 1)] ] whileFalse: [
  i := i + 1
].

i > sz ifTrue: [
  ^string
].

initlen := curstr size.
matchlen := initlen.
found := 0.

i to: sz do: [ :j |
  name := lookupStrings at: j.
  len := self commonChars: curstr with: name.
  len < initlen ifTrue: [
    "A shorter match in a sorted list means we can quit now"
    found > 0 ifTrue: [
      ^(realStrings at: found) value copyFrom: 1 to: matchlen
    ].
  ]
  ifFalse: [
    "First match - copy the real string"
    found > 0 ifFalse: [
      curstr := String new add: name.
      matchlen := curstr size.
      found := j.
    ]
    ifTrue: [
      "Trim the current string back to the matched length"
      curstr size: len.
      matchlen := len.

      "The entered name is as complete as possible - quit now"
      len = initlen ifTrue: [
	^(realStrings at: found) value copyFrom: 1 to: matchlen
      ].
    ].
  ].
].

found > 0 ifTrue: [
  ^(realStrings at: found) value copyFrom: 1 to: matchlen
].

^string.
%

category: 'Initializing'
method: AutoComplete
stringPairSet: alist

"Sets up information needed to do string completion on the given set of
 strings.  The strings are already in our desired StringPairSet form."

| list assn |

list := alist sortAscending.

lookupStrings := Array new: list size.
1 to: list size do: [ :i |
  assn := list at: i.
  lookupStrings at: i put: assn key.
].

"keep the StringPairs around as a sorted collection instead of a know-
  nothing Array.  This will make incremental additions much faster"
realStrings := SortedCollection sortBlock: [:x:y | x key < y key]
                  fromSortResult: list.
%

category: 'Accessing'
method: AutoComplete
strings

"Returns the list of real strings."

^realStrings.
%

category: 'Initializing'
method: AutoComplete
strings: strings

"Sets up information needed to do string completion on the given set of
 strings."

| alist str assn |

alist := StringPairSet new.
1 to: strings size do: [ :i |
  str := strings _at: i.
  alist add: (StringPair new key: (str asUppercase) value: str).
].

alist := alist sortAscending.

lookupStrings := Array new: alist size.
1 to: alist size do: [ :i |
  assn := alist at: i.
  lookupStrings at: i put: assn key.
].

"Keep the StringPairs around as a sorted collection instead of a know-
  nothing Array.  This will make incremental additions much faster"
realStrings := SortedCollection sortBlock: [:x:y | x key < y key]
                  fromSortResult: alist.
%

category: 'Initializing'
method: AutoComplete
strings: strings cluster: cluster

"Sets up information needed to do string completion on the given set of
 strings."

self strings: strings.

cluster ifTrue: [
  realStrings cluster.
  lookupStrings cluster.
  1 to: lookupStrings size do: [ :i | (lookupStrings at: i) cluster ].
].
%

