--- a/DoWhatIMeanSupport.st	Thu Feb 26 17:17:23 2004 +0100
+++ b/DoWhatIMeanSupport.st	Thu Feb 26 19:49:25 2004 +0100
@@ -52,6 +52,402 @@
 "
 ! !
 
+!DoWhatIMeanSupport class methodsFor:'input completion support'!
+
+classCategoryCompletion:aPartialCategory in:anEnvironment
+    "given a partial class category name, return an array consisting of
+     2 entries: 1st: the best (longest) match
+                2nd: collection consisting of matching categories"
+
+    |matches best lcName|
+
+    matches := IdentitySet new.
+
+    "/ search for exact match
+    anEnvironment allClassesDo:[:aClass |
+        |category|
+
+        category := aClass category.
+        (category notNil and:[category startsWith:aPartialCategory]) ifTrue:[
+            matches add:category
+        ]
+    ].
+    matches isEmpty ifTrue:[
+        "/ search for case-ignoring match
+        lcName := aPartialCategory asLowercase.
+        anEnvironment allClassesDo:[:aClass |
+            |category|
+
+            category := aClass category.
+            (category notNil and:[category asLowercase startsWith:lcName]) ifTrue:[
+                matches add:category
+            ].
+        ].
+    ].
+
+    matches isEmpty ifTrue:[
+        ^ Array with:aPartialCategory with:(Array with:aPartialCategory)
+    ].
+    matches size == 1 ifTrue:[
+        ^ Array with:matches first with:(matches asArray)
+    ].
+    matches := matches asSortedCollection.
+    best := matches longestCommonPrefix.
+    ^ Array with:best with:matches asArray
+
+    "
+     Smalltalk classCategoryCompletion:'Sys'    
+     Smalltalk classCategoryCompletion:'System'              
+     Smalltalk classCategoryCompletion:'System-BinaryStorage' 
+    "
+!
+
+classnameCompletion:aPartialClassName inEnvironment:anEnvironment
+    "given a partial classname, return an array consisting of
+     2 entries: 1st: the best (longest) match
+                2nd: collection consisting of matching names"
+
+    |searchName matches matchedNamesWithoutPrefix ignCaseMatches best isMatchString cls nsPrefix 
+     others lcSearchName tryToMatch idx words w1 w2 rslt bestMatch|
+
+    aPartialClassName isEmpty ifTrue:[
+        ^ Array with:aPartialClassName with:#()
+    ].
+
+    (words := aPartialClassName asCollectionOfWords) size > 1 ifTrue:[
+        w1 := words first.
+        w2 := words second.
+        rslt := self classnameCompletion:w1 inEnvironment:anEnvironment.
+        bestMatch := rslt first.
+        matches := rslt second.
+        ('class' copyTo:w2 size) = w2 ifTrue:[
+            matches := matches collect:[:m | m , ' class'].
+            bestMatch := bestMatch , ' class'.
+        ].
+        ^ Array with:bestMatch with:matches
+    ].
+
+
+    (aPartialClassName startsWith:'Smalltalk::') ifTrue:[
+        nsPrefix := 'Smalltalk::'.
+        searchName := aPartialClassName copyFrom:'Smalltalk::' size + 1
+    ] ifFalse:[
+        nsPrefix := ''.
+        searchName := aPartialClassName.
+    ].
+
+    (searchName at:1) isLowercase ifTrue:[
+        searchName := searchName copy asUppercaseFirst
+    ].
+    lcSearchName := searchName asLowercase.
+
+    isMatchString := searchName includesMatchCharacters.
+    matches := OrderedCollection new.
+    matchedNamesWithoutPrefix := Set new.
+    ignCaseMatches := OrderedCollection new.
+    others := OrderedCollection new.
+
+    tryToMatch := [:className :fullClassName|
+        |addIt lcClassName|
+
+        isMatchString ifTrue:[
+            addIt := searchName match:className
+        ] ifFalse:[
+            addIt := className startsWith:searchName.
+        ].
+        addIt ifTrue:[
+            matches add:(nsPrefix , fullClassName).
+            matchedNamesWithoutPrefix add:className.
+        ] ifFalse:[
+            "/ try ignoring case
+
+            isMatchString ifTrue:[
+                addIt := searchName match:className ignoreCase:true
+            ] ifFalse:[
+                lcClassName := className asLowercase.
+                addIt := lcClassName startsWith:lcSearchName.
+                addIt ifFalse:[
+                    others add:className 
+                ]
+            ].
+            addIt ifTrue:[
+                ignCaseMatches add:(nsPrefix , fullClassName).
+                matchedNamesWithoutPrefix add:className.
+            ].
+        ].
+        addIt
+    ].
+
+    anEnvironment allClassesDo:[:aClass |
+        |addIt fullClassName classNameWithoutPrefix|
+
+        aClass isMeta ifFalse:[
+            fullClassName := aClass name.
+            classNameWithoutPrefix := aClass nameWithoutPrefix.
+
+            addIt := tryToMatch value:fullClassName value:fullClassName.
+            addIt ifFalse:[
+                classNameWithoutPrefix ~~ fullClassName ifTrue:[
+                    tryToMatch value:classNameWithoutPrefix value:fullClassName.
+                ].
+            ].
+        ]
+    ].
+
+    matches isEmpty ifTrue:[
+        matches := ignCaseMatches
+    ].
+"/    matches isEmpty ifTrue:[
+"/        | nearBy |
+"/        nearBy := SortedCollection new sortBlock:[:a :b | a key < b key].
+"/        others do:[:className |
+"/            |lcClassName dist cmpName|
+"/
+"/            lcClassName := className asLowercase.
+"/            dist := lcClassName levenshteinTo:lcSearchName s:9 k:1 c:0 i:9 d:2.
+"/
+"/            cmpName := lcClassName copyTo:(lcSearchName size min:lcClassName size).
+"/            dist := dist min:(cmpName levenshteinTo:lcSearchName s:9 k:1 c:0 i:9 d:2).
+"/            cmpName := lcClassName copyTo:(lcSearchName size + 1 min:lcClassName size).
+"/            dist := dist min:(cmpName levenshteinTo:lcSearchName s:9 k:1 c:0 i:9 d:2).
+"/            dist < 4 ifTrue:[
+"/                nearBy add:( dist -> (nsPrefix , className) ).
+"/            ]
+"/        ].
+"/        matches := nearBy collect:[:eachPair | eachPair value].
+"/    ].
+    matches isEmpty ifTrue:[
+        ^ Array with:searchName with:(Array with:searchName)
+    ].
+
+    matches size == 1 ifTrue:[
+        best := matches first.
+        ^ Array with:best with:(matches asArray)
+    ].
+
+    matches 
+        sort:[:name1 :name2 |
+            "name1 comes before:name2 iff"
+            ((name2 includes:$:) and:[(name1 includes:$:) not])
+            or:[ ((name1 includes:$:) == (name2 includes:$:))
+                  and:[ (name1 size < name2 size) 
+                        or: [ name1 < name2 ]]
+               ]
+        ].
+
+    isMatchString ifTrue:[
+        best := searchName.
+    ] ifFalse:[
+
+        best := matches longestCommonPrefix.
+        best size == 0 ifTrue:[
+            best := matchedNamesWithoutPrefix longestCommonPrefix.
+        ].
+        best size == 0 ifTrue:[
+            "if tried again, return next match"
+            idx := ((matches indexOf:aPartialClassName) + 1) \\ matches size.
+            idx ~~ 1 ifTrue:[
+                ^ Array with:(matches at:idx) with:(matches asArray)
+            ].
+        ].
+        best size < aPartialClassName size ifTrue:[
+            best := aPartialClassName.
+        ].
+    ].
+
+    cls := anEnvironment classNamed:best.
+    (cls isBehavior and:[cls isNameSpace]) ifTrue:[
+        (matches conform:[:each | each = best
+                                 or:[each startsWith:(best , '::')]])
+        ifTrue:[
+            best := best , '::'
+        ].
+    ].
+    ^ Array with:best with:matches asArray
+
+    "
+     Smalltalk classnameCompletion:'Arr' 
+     Smalltalk classnameCompletion:'Arra' 
+     Smalltalk classnameCompletion:'arra' 
+     Smalltalk classnameCompletion:'*rray' 
+    "
+
+    "Created: 24.11.1995 / 17:24:45 / cg"
+    "Modified: 3.4.1997 / 18:25:01 / cg"
+!
+
+globalNameCompletion:aPartialGlobalName in:anEnvironment
+    "given a partial globalName, return an array consisting of
+     2 entries: 1st: the best (longest) match
+                2nd: collection consisting of matching names"
+
+    |searchName matches ignCaseMatches best isMatchString|
+
+    searchName := aPartialGlobalName.
+    searchName isEmpty ifTrue:[
+        ^ Array with:searchName with:#()
+    ].
+
+    (searchName at:1) isLowercase ifTrue:[
+        searchName := searchName copy asUppercaseFirst
+    ].
+
+    isMatchString := searchName includesMatchCharacters.
+    matches := OrderedCollection new.
+    ignCaseMatches := OrderedCollection new.
+    anEnvironment keysDo:[:aGlobalName |
+        | addIt|
+
+        isMatchString ifTrue:[
+            addIt := searchName match:aGlobalName
+        ] ifFalse:[
+            addIt := aGlobalName startsWith:searchName
+        ].
+        addIt ifTrue:[
+            matches add:aGlobalName
+        ] ifFalse:[
+            "/ try ignoring case
+            isMatchString ifTrue:[
+                addIt := searchName match:aGlobalName ignoreCase:true
+            ] ifFalse:[
+                addIt := aGlobalName asLowercase startsWith:searchName asLowercase
+            ].
+            addIt ifTrue:[
+                ignCaseMatches add:aGlobalName
+            ]
+        ]
+    ].
+
+    matches isEmpty ifTrue:[
+        matches := ignCaseMatches
+    ].
+
+    matches isEmpty ifTrue:[
+        ^ Array with:searchName with:(Array with:searchName)
+    ].
+    matches size == 1 ifTrue:[
+        ^ Array with:matches first with:(matches asArray)
+    ].
+    matches := matches asSortedCollection.
+    isMatchString ifTrue:[
+        best := searchName.
+    ] ifFalse:[
+        best := matches longestCommonPrefix.
+    ].
+    ^ Array with:best with:matches asArray
+
+    "
+     Smalltalk globalnameCompletion:'Arr' 
+     Smalltalk globalnameCompletion:'Arra' 
+     Smalltalk globalnameCompletion:'arra' 
+     Smalltalk globalnameCompletion:'*rray' 
+    "
+
+    "Created: 24.11.1995 / 17:24:45 / cg"
+    "Modified: 3.4.1997 / 18:25:01 / cg"
+!
+
+methodProtocolCompletion:aPartialProtocolName in:anEnvironment
+    "given a partial method protocol name, return an array consisting of
+     2 entries: 1st: the best (longest) match 
+                2nd: collection consisting of matching protocols"
+
+    |matches best lcName|
+
+    matches := IdentitySet new.
+
+    "/ search for exact match
+    anEnvironment allClassesDo:[:aClass |
+        aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |
+            |protocol|
+
+            protocol := aMethod category.
+            (protocol notNil and:[protocol startsWith:aPartialProtocolName]) ifTrue:[
+                matches add:protocol
+            ]
+        ].
+    ].
+    matches isEmpty ifTrue:[
+        "/ search for case-ignoring match
+        lcName := aPartialProtocolName asLowercase.
+        anEnvironment allClassesDo:[:aClass |
+            aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |
+                |protocol|
+
+                protocol := aMethod category.
+                (protocol asLowercase startsWith:lcName) ifTrue:[
+                    matches add:protocol
+                ]
+            ].
+        ].
+    ].
+
+    matches isEmpty ifTrue:[
+        ^ Array with:aPartialProtocolName with:(Array with:aPartialProtocolName)
+    ].
+    matches size == 1 ifTrue:[
+        ^ Array with:matches first with:(matches asArray)
+    ].
+    matches := matches asSortedCollection.
+    best := matches longestCommonPrefix.
+    ^ Array with:best with:matches asArray
+
+    "
+     Smalltalk methodProtocolCompletion:'doc'
+     Smalltalk methodProtocolCompletion:'docu' 
+     Smalltalk methodProtocolCompletion:'documenta' 
+    "
+!
+
+selectorCompletion:aPartialSymbolName inEnvironment:anEnvironment
+    "given a partial selector, return an array consisting of
+     2 entries: 1st: the longest match
+                2nd: collection consisting of matching implemented selectors"
+
+    |matches best lcSym|
+
+    matches := IdentitySet new.
+
+    "/ search for exact match
+    anEnvironment allClassesDo:[:aClass |
+        aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |
+            (aSelector startsWith:aPartialSymbolName) ifTrue:[
+                matches add:aSelector
+            ]
+        ].
+    ].
+    matches isEmpty ifTrue:[
+        "/ search for case-ignoring match
+        lcSym := aPartialSymbolName asLowercase.
+        anEnvironment allClassesDo:[:aClass |
+            aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |
+                (aSelector asLowercase startsWith:lcSym) ifTrue:[
+                    matches add:aSelector
+                ]
+            ].
+        ].
+    ].
+
+    matches isEmpty ifTrue:[
+        ^ Array with:aPartialSymbolName with:(Array with:aPartialSymbolName)
+    ].
+    matches size == 1 ifTrue:[
+        ^ Array with:matches first with:(matches asArray)
+    ].
+    matches := matches asSortedCollection.
+    best := matches longestCommonPrefix.
+    ^ Array with:best with:matches asArray
+
+    "
+     Smalltalk selectorCompletion:'at:p'  
+     Smalltalk selectorCompletion:'nextP' 
+     Smalltalk selectorCompletion:'nextp' 
+    "
+
+    "Modified: / 7.6.1996 / 08:44:33 / stefan"
+    "Modified: / 14.6.1998 / 15:54:03 / cg"
+! !
+
 !DoWhatIMeanSupport class methodsFor:'rename support'!
 
 goodRenameDefaultFor:oldName lastOld:lastOldName lastNew:lastNewName
@@ -319,5 +715,5 @@
 !DoWhatIMeanSupport class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libwidg2/DoWhatIMeanSupport.st,v 1.14 2003-08-28 15:40:52 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libwidg2/DoWhatIMeanSupport.st,v 1.15 2004-02-26 18:49:25 cg Exp $'
 ! !