classNameCompletion: levenstein disabled - too slow
authorClaus Gittinger <cg@exept.de>
Wed, 10 Sep 2003 17:34:24 +0200
changeset 7607 c8e28e245030
parent 7606 5479f4699324
child 7608 1e6f4fe8c39b
classNameCompletion: levenstein disabled - too slow
Smalltalk.st
--- a/Smalltalk.st	Tue Sep 09 11:41:45 2003 +0200
+++ b/Smalltalk.st	Wed Sep 10 17:34:24 2003 +0200
@@ -2092,7 +2092,7 @@
                 2nd: the best (longest) match"
 
     |searchName matches ignCaseMatches best isMatchString cls nsPrefix 
-     others nearBy lcSearchName|
+     others nearBy lcSearchName tryToMatch|
 
     aPartialClassName isEmpty ifTrue:[
         ^ Array with:aPartialClassName with:#()
@@ -2116,58 +2116,72 @@
     ignCaseMatches := OrderedCollection new.
     others := OrderedCollection new.
 
-    anEnvironment allClassesDo:[:aClass |
-        |className addIt lcClassName|
-
-        aClass isMeta ifFalse:[
-            className := aClass name.
+    tryToMatch := [:className :fullClassName|
+        |addIt lcClassName|
+
+        isMatchString ifTrue:[
+            addIt := searchName match:className
+        ] ifFalse:[
+            addIt := className startsWith:searchName.
+        ].
+        addIt ifTrue:[
+            matches add:(nsPrefix , fullClassName)
+        ] ifFalse:[
+            "/ try ignoring case
 
             isMatchString ifTrue:[
-                addIt := searchName match:className
+                addIt := searchName match:className ignoreCase:true
             ] ifFalse:[
-                addIt := className startsWith:searchName.
+                lcClassName := className asLowercase.
+                addIt := lcClassName startsWith:lcSearchName.
+                addIt ifFalse:[
+                    others add:className 
+                ]
             ].
             addIt ifTrue:[
-                matches add:(nsPrefix , 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
-                    ]
+                ignCaseMatches add:(nsPrefix , fullClassName)
+            ].
+        ].
+        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.
                 ].
-                addIt ifTrue:[
-                    ignCaseMatches add:(nsPrefix , className)
-                ].
-            ]
+            ].
         ]
     ].
 
     matches isEmpty ifTrue:[
         matches := ignCaseMatches
     ].
-    matches isEmpty ifTrue:[
-        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:[
+"/        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)
     ].
@@ -6560,5 +6574,5 @@
 !Smalltalk class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.597 2003-08-29 16:40:06 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.598 2003-09-10 15:34:24 cg Exp $'
 ! !