--- 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 $'
! !