5313 ! |
5313 ! |
5314 |
5314 |
5315 classesWithNameSimilarTo:className |
5315 classesWithNameSimilarTo:className |
5316 "helper for class-name entry; finds a class by name tolerant w.r.t. case" |
5316 "helper for class-name entry; finds a class by name tolerant w.r.t. case" |
5317 |
5317 |
5318 |nm lcName class allClasses triedDetectors triedMatchers allMatchingClasses| |
5318 ^ self classesWithNameSimilarTo:className from:nil |
|
5319 |
|
5320 "Modified: / 22-08-2006 / 13:22:41 / cg" |
|
5321 ! |
|
5322 |
|
5323 classesWithNameSimilarTo:className from:aNameSpaceOrNil |
|
5324 "helper for class-name entry; finds classes with a name similar to the argument, className" |
|
5325 |
|
5326 |nm lcName class allClasses triedDetectors triedMatchers allMatchingClasses |
|
5327 prefNameSpaceOrNil prefLcNameSpace| |
|
5328 |
|
5329 prefNameSpaceOrNil := (aNameSpaceOrNil == Smalltalk) ifTrue:[ nil ] ifFalse:[aNameSpaceOrNil]. |
5319 |
5330 |
5320 (className startsWith:'Smalltalk::') ifTrue:[ |
5331 (className startsWith:'Smalltalk::') ifTrue:[ |
5321 nm := className copyFrom:('Smalltalk::' size + 1). |
5332 nm := className copyFrom:('Smalltalk::' size + 1). |
5322 ] ifFalse:[ |
5333 ] ifFalse:[ |
5323 nm := className. |
5334 nm := className. |
5324 ]. |
5335 ]. |
5325 |
5336 |
|
5337 prefNameSpaceOrNil notNil ifTrue:[ |
|
5338 class := prefNameSpaceOrNil at:nm asSymbol. |
|
5339 class isBehavior ifTrue:[^ Array with:class]. "/ a direct hit |
|
5340 prefLcNameSpace := prefNameSpaceOrNil name asLowercase. |
|
5341 ]. |
5326 class := Smalltalk at:nm asSymbol. |
5342 class := Smalltalk at:nm asSymbol. |
5327 class isBehavior ifTrue:[^ Array with:class]. "/ a direct hit |
5343 class isBehavior ifTrue:[^ Array with:class]. "/ a direct hit |
5328 |
5344 |
5329 lcName := className asLowercase. |
5345 lcName := className asLowercase. |
5330 |
5346 |
5353 allMatchingClasses := IdentitySet new. |
5369 allMatchingClasses := IdentitySet new. |
5354 triedMatchers do:[:eachTry | |
5370 triedMatchers do:[:eachTry | |
5355 |matchingClasses| |
5371 |matchingClasses| |
5356 |
5372 |
5357 matchingClasses := allClasses select:eachTry. |
5373 matchingClasses := allClasses select:eachTry. |
5358 matchingClasses size == 1 ifTrue:[^ matchingClasses]. |
5374 "/ matchingClasses size == 1 ifTrue:[^ matchingClasses]. |
5359 allMatchingClasses addAll:matchingClasses. |
5375 allMatchingClasses addAll:matchingClasses. |
5360 ]. |
5376 ]. |
5361 allMatchingClasses isEmpty ifTrue:[^ #()]. |
5377 allMatchingClasses isEmpty ifTrue:[^ #()]. |
5362 |
5378 |
5363 allMatchingClasses := allMatchingClasses asOrderedCollection. |
5379 allMatchingClasses := allMatchingClasses asOrderedCollection. |
5364 allMatchingClasses sort:[:a :b | (lcName levenshteinTo:a name asLowercase) |
5380 allMatchingClasses |
5365 < |
5381 sort:[:a :b | |
5366 (lcName levenshteinTo:b name asLowercase)]. |
5382 |lcNameA lcNameB da db distA distB | |
|
5383 |
|
5384 lcNameA := a name asLowercase. |
|
5385 lcNameB := b name asLowercase. |
|
5386 prefNameSpaceOrNil notNil ifTrue:[ |
|
5387 a nameSpace == prefNameSpaceOrNil ifTrue:[ |
|
5388 lcNameA := a nameWithoutNameSpacePrefix asLowercase. |
|
5389 ]. |
|
5390 b nameSpace == prefNameSpaceOrNil ifTrue:[ |
|
5391 lcNameB := b nameWithoutNameSpacePrefix asLowercase. |
|
5392 ]. |
|
5393 ]. |
|
5394 |
|
5395 distA := da := lcName levenshteinTo:lcNameA. |
|
5396 distB := db := lcName levenshteinTo:lcNameB. |
|
5397 "prefer prefixes (i.e. classes whose name starts with what we search for)" |
|
5398 |
|
5399 (lcNameA startsWith:lcName) ifTrue:[ |
|
5400 distB := distB * 2 |
|
5401 ]. |
|
5402 (lcNameB startsWith:lcName) ifTrue:[ |
|
5403 distA := distA * 2 |
|
5404 ]. |
|
5405 distA < distB |
|
5406 ]. |
5367 ^ allMatchingClasses. |
5407 ^ allMatchingClasses. |
5368 |
5408 |
5369 " |
5409 " |
5370 self classesWithNameSimilarTo:'NewSystemBrowser' |
5410 self classesWithNameSimilarTo:'NewSystemBrowser' |
5371 self classesWithNameSimilarTo:'Moose::MSEAbstractOperator' |
5411 self classesWithNameSimilarTo:'Moose::MSEAbstractOperator' |
5372 " |
5412 " |
|
5413 |
|
5414 "Created: / 22-08-2006 / 13:22:48 / cg" |
|
5415 "Modified: / 22-08-2006 / 14:53:38 / cg" |
5373 ! |
5416 ! |
5374 |
5417 |
5375 extractClassAndSelectorFrom:aString into:aBlock |
5418 extractClassAndSelectorFrom:aString into:aBlock |
5376 "given a string which can be either 'class>>sel' or |
5419 "given a string which can be either 'class>>sel' or |
5377 'class sel', extract className and selector, and call aBlock with |
5420 'class sel', extract className and selector, and call aBlock with |