4813 !SystemBrowser class methodsFor:'utilities'! |
4813 !SystemBrowser class methodsFor:'utilities'! |
4814 |
4814 |
4815 classWithNameSimilarTo:className |
4815 classWithNameSimilarTo:className |
4816 "helper for class-name entry; finds a class by name tolerant w.r.t. case" |
4816 "helper for class-name entry; finds a class by name tolerant w.r.t. case" |
4817 |
4817 |
4818 |nm lcName class allClasses triedMatchers| |
4818 |allMatchingClasses| |
|
4819 |
|
4820 allMatchingClasses := self classesWithNameSimilarTo:className. |
|
4821 ^ allMatchingClasses firstIfEmpty:nil |
|
4822 ! |
|
4823 |
|
4824 classesWithNameSimilarTo:className |
|
4825 "helper for class-name entry; finds a class by name tolerant w.r.t. case" |
|
4826 |
|
4827 |nm lcName class allClasses triedDetectors triedMatchers allMatchingClasses| |
4819 |
4828 |
4820 (className startsWith:'Smalltalk::') ifTrue:[ |
4829 (className startsWith:'Smalltalk::') ifTrue:[ |
4821 nm := className copyFrom:('Smalltalk::' size + 1). |
4830 nm := className copyFrom:('Smalltalk::' size + 1). |
4822 ] ifFalse:[ |
4831 ] ifFalse:[ |
4823 nm := className. |
4832 nm := className. |
4824 ]. |
4833 ]. |
4825 |
4834 |
4826 class := Smalltalk at:nm asSymbol. |
4835 class := Smalltalk at:nm asSymbol. |
4827 class isBehavior ifTrue:[^ class]. "/ a direct hit |
4836 class isBehavior ifTrue:[^ Array with:class]. "/ a direct hit |
4828 |
4837 |
4829 lcName := className asLowercase. |
4838 lcName := className asLowercase. |
|
4839 class := Smalltalk at:lcName asSymbol. |
|
4840 class isBehavior ifTrue:[^ Array with:class]. "/ an almost direct hit |
|
4841 |
4830 allClasses := Smalltalk allClasses. |
4842 allClasses := Smalltalk allClasses. |
4831 |
4843 |
4832 triedMatchers := OrderedCollection new. |
4844 triedMatchers := OrderedCollection new. |
4833 triedMatchers add:[:cls | cls name asLowercase = lcName]. |
4845 triedDetectors := OrderedCollection new. |
|
4846 triedDetectors add:[:cls | cls name asLowercase = lcName]. |
|
4847 triedDetectors add:[:cls | cls nameWithoutPrefix asLowercase = lcName]. |
|
4848 triedDetectors add:[:cls | cls nameWithoutNameSpacePrefix asLowercase = lcName]. |
|
4849 |
4834 triedMatchers add:[:cls | cls name asLowercase startsWith:lcName]. |
4850 triedMatchers add:[:cls | cls name asLowercase startsWith:lcName]. |
4835 triedMatchers add:[:cls | cls nameWithoutNameSpacePrefix asLowercase = lcName]. |
|
4836 triedMatchers add:[:cls | cls nameWithoutNameSpacePrefix asLowercase startsWith:lcName]. |
4851 triedMatchers add:[:cls | cls nameWithoutNameSpacePrefix asLowercase startsWith:lcName]. |
4837 triedMatchers add:[:cls | cls nameWithoutPrefix asLowercase = lcName]. |
|
4838 triedMatchers add:[:cls | cls nameWithoutPrefix asLowercase startsWith:lcName]. |
4852 triedMatchers add:[:cls | cls nameWithoutPrefix asLowercase startsWith:lcName]. |
4839 triedMatchers add:[:cls | cls nameWithoutPrefix asLowercase includesString:lcName]. |
4853 triedMatchers add:[:cls | cls nameWithoutPrefix asLowercase includesString:lcName]. |
4840 |
4854 triedMatchers add:[:cls | cls name asLowercase includesString:lcName]. |
|
4855 |
|
4856 triedDetectors do:[:eachTry | |
|
4857 |class| |
|
4858 |
|
4859 class := allClasses detect:eachTry ifNone:nil. |
|
4860 class notNil ifTrue:[^ Array with:class]. |
|
4861 ]. |
|
4862 |
|
4863 allMatchingClasses := IdentitySet new. |
4841 triedMatchers do:[:eachTry | |
4864 triedMatchers do:[:eachTry | |
4842 class := allClasses detect:eachTry ifNone:nil. |
4865 |matchingClasses| |
4843 class notNil ifTrue:[^ class]. |
4866 |
4844 ]. |
4867 matchingClasses := allClasses select:eachTry. |
4845 ^ nil |
4868 matchingClasses size == 1 ifTrue:[^ matchingClasses]. |
|
4869 allMatchingClasses addAll:matchingClasses. |
|
4870 ]. |
|
4871 allMatchingClasses isEmpty ifTrue:[^ #()]. |
|
4872 |
|
4873 allMatchingClasses := allMatchingClasses asOrderedCollection. |
|
4874 allMatchingClasses sort:[:a :b | (lcName levenshteinTo:a name asLowercase) |
|
4875 < |
|
4876 (lcName levenshteinTo:b name asLowercase)]. |
|
4877 ^ allMatchingClasses. |
4846 ! |
4878 ! |
4847 |
4879 |
4848 extractClassAndSelectorFrom:aString into:aBlock |
4880 extractClassAndSelectorFrom:aString into:aBlock |
4849 "given a string which can be either 'class>>sel' or |
4881 "given a string which can be either 'class>>sel' or |
4850 'class sel', extract className and selector, and call aBlock with |
4882 'class sel', extract className and selector, and call aBlock with |