--- a/Explainer.st Fri Jun 21 09:53:12 2013 +0200
+++ b/Explainer.st Sun Jun 23 10:26:55 2013 +0200
@@ -141,114 +141,114 @@
recClassSet := self guessPossibleImplementorClassesFor:(node receiver) in:code forClass:cls.
recClassSet size == 1 ifTrue:[
- srchClass := recClassSet first.
- "take care - Set cannot store nil!!"
- implementingClasses := (recClassSet collect:[:cls | cls whichClassIncludesSelector:selector]) asArray.
+ srchClass := recClassSet first.
+ "take care - Set cannot store nil!!"
+ implementingClasses := (recClassSet collect:[:cls | cls whichClassIncludesSelector:selector]) asArray.
- (implementingClasses includes:nil) ifTrue:[
- implementingClasses size > 1 ifTrue:[
- ^ 'possibly not understood: %1 (%2 other implementors)'
- bindWith:selector "allBold"
- with:(implementingClasses size - 1)
- ].
+ (implementingClasses includes:nil) ifTrue:[
+ implementingClasses size > 1 ifTrue:[
+ ^ 'possibly not understood: %1 (%2 other implementors)'
+ bindWith:selector "allBold"
+ with:(implementingClasses size - 1)
+ ].
- (#('self' 'super' 'true' 'false' 'thisContext') includes:selector) ifTrue:[
- ^ ('NOT understood here: %1 (missing period after previous statement?)' bindWith:selector allBold),hint
- ].
+ (#('self' 'super' 'true' 'false' 'thisContext') includes:selector) ifTrue:[
+ ^ ('NOT understood here: %1 (missing period after previous statement?)' bindWith:selector allBold),hint
+ ].
- (recClassSet contains:[:cls | cls isMeta not and:[cls theMetaclass canUnderstand:selector]]) ifTrue:[
- hint := '. But class understands it - did you mean "rcvr class ',selector,'..." ?'.
- ].
- bestMatches := Parser findBestSelectorsFor:selector in:srchClass.
- bestMatches size > 0 ifTrue:[
- ^ ('NOT understood here: %1 (best guess is: "%2" from %3)'
- bindWith:selector allBold
- with:(bestMatches first "allBold")
- with:(srchClass whichClassIncludesSelector:bestMatches first) name) , hint
- ].
- ^ ('NOT understood here: %1' bindWith:selector allBold),hint
- ].
+ (recClassSet contains:[:cls | cls isMeta not and:[cls theMetaclass canUnderstand:selector]]) ifTrue:[
+ hint := '. But class understands it - did you mean "rcvr class ',selector,'..." ?'.
+ ].
+ bestMatches := Parser findBestSelectorsFor:selector in:srchClass.
+ bestMatches size > 0 ifTrue:[
+ ^ ('NOT understood here: %1 (best guess is: "%2" from %3)'
+ bindWith:selector allBold
+ with:(bestMatches first "allBold")
+ with:(srchClass whichClassIncludesSelector:bestMatches first) name) , hint
+ ].
+ ^ ('NOT understood here: %1' bindWith:selector allBold),hint
+ ].
].
implementingClasses isNil ifTrue:[
- receiver := node receiver.
- receiver isVariable ifTrue:[
- nm := receiver name.
- nm = 'self' ifTrue:[
- srchClass := cls
- ].
- nm = 'super' ifTrue:[
- srchClass := cls superclass
- ].
- definer := receiver whoDefines:nm.
- definer isNil ifTrue:[
- "/ not a local or argument
- (cls instanceVariableNames includes:nm) ifTrue:[
- "/ ok - an instVar; see what values we find...
- instances := cls allSubInstances.
- classesOfInstVars := instances collect:[:eachInst | (eachInst instVarNamed:nm) class] as:Set.
- canBeNil := (classesOfInstVars remove:UndefinedObject ifAbsent:[]) notNil.
- "take care - Set cannot store nil!!"
- implementingClasses := classesOfInstVars collect:[:cls | (cls whichClassIncludesSelector:selector) ? 0].
- implementingClasses remove:0 ifAbsent:[].
- ] ifFalse:[
- nm isUppercaseFirst ifTrue:[
- nm knownAsSymbol ifTrue:[
- globalValue := Smalltalk at:nm asSymbol.
- globalValue isClass ifTrue:[
- srchClass := globalValue class.
- ].
- ]
- ].
- ].
- ].
- ].
+ receiver := node receiver.
+ receiver isVariable ifTrue:[
+ nm := receiver name.
+ nm = 'self' ifTrue:[
+ srchClass := cls
+ ].
+ nm = 'super' ifTrue:[
+ srchClass := cls superclass
+ ].
+ definer := receiver whoDefines:nm.
+ definer isNil ifTrue:[
+ "/ not a local or argument
+ (cls instanceVariableNames includes:nm) ifTrue:[
+ "/ ok - an instVar; see what values we find...
+ instances := cls allSubInstances.
+ classesOfInstVars := instances collect:[:eachInst | (eachInst instVarNamed:nm) class] as:Set.
+ canBeNil := (classesOfInstVars remove:UndefinedObject ifAbsent:[]) notNil.
+ "take care - Set cannot store nil!!"
+ implementingClasses := classesOfInstVars collect:[:cls | (cls whichClassIncludesSelector:selector) ? 0].
+ implementingClasses remove:0 ifAbsent:[].
+ ] ifFalse:[
+ nm isUppercaseFirst ifTrue:[
+ nm knownAsSymbol ifTrue:[
+ globalValue := Smalltalk at:nm asSymbol.
+ globalValue isClass ifTrue:[
+ srchClass := globalValue class.
+ ].
+ ]
+ ].
+ ].
+ ].
+ ].
- receiver isLiteral ifTrue:[
- srchClass := receiver value class
- ].
+ receiver isLiteral ifTrue:[
+ srchClass := receiver value class
+ ].
- srchClass notNil ifTrue:[
- implClass := srchClass whichClassIncludesSelector:selector.
- implClass isNil ifTrue:[
- ^ '%1 is NOT understood here.' bindWith:boldSelectorString
- ].
- info := '%1 >> %2' bindWith:implClass name "allBold" with:selectorString "allBold".
+ srchClass notNil ifTrue:[
+ implClass := srchClass whichClassIncludesSelector:selector.
+ implClass isNil ifTrue:[
+ ^ '%1 is NOT understood here.' bindWith:boldSelectorString
+ ].
+ info := '%1 >> %2' bindWith:implClass name "allBold" with:selectorString "allBold".
- implMethod := implClass compiledMethodAt:selector.
- implMethodComment := self fetchCommentOfMethod:implMethod.
- implMethodComment notNil ifTrue:[
- info := info , ' ' , implMethodComment.
- ].
- ^ info
- ].
- implementingClasses isNil ifTrue:[
- implementingClasses := Smalltalk allImplementorsOf:selector
- ].
+ implMethod := implClass compiledMethodAt:selector.
+ implMethodComment := self fetchCommentOfMethod:implMethod.
+ implMethodComment notNil ifTrue:[
+ info := info , ' ' , implMethodComment.
+ ].
+ ^ info
+ ].
+ implementingClasses isNil ifTrue:[
+ implementingClasses := Smalltalk allImplementorsOf:selector
+ ].
].
implementingClasses size == 1 ifTrue:[
- implClass := implementingClasses anElement.
- info := '%1 >> %2' bindWith:implClass name "allBold" with:selectorString.
- srchClass isNil ifTrue:[
- "/ info := 'guess: ', info.
- info := info , ' (guess)'.
- ].
+ implClass := implementingClasses anElement.
+ info := '%1 >> %2' bindWith:implClass name "allBold" with:selectorString.
+ (srchClass isNil and:[(cls includesBehavior:implClass) not]) ifTrue:[
+ "/ info := 'guess: ', info.
+ info := info , ' (guess)'.
+ ].
] ifFalse:[
- info := Explainer explainSelector:selector inClass:cls short:short.
+ info := Explainer explainSelector:selector inClass:cls short:short.
].
implementingClasses notEmptyOrNil ifTrue:[
- implMethods := implementingClasses collect:[:implClass | implClass compiledMethodAt:selector].
- implMethods size <= 5 ifTrue:[
- comments := implMethods collect:[:implMethod | implMethod comment ? ''].
- (comments includes:'') ifFalse:[
- comments := comments collect:[:implMethodComment | implMethodComment firstLine] as:Set.
- comments size == 1 ifTrue:[
- info := info , ' ' , (self fetchCommentOfMethod:implMethods first).
- ].
- ].
- ].
+ implMethods := implementingClasses collect:[:implClass | implClass compiledMethodAt:selector].
+ implMethods size <= 5 ifTrue:[
+ comments := implMethods collect:[:implMethod | implMethod comment ? ''].
+ (comments includes:'') ifFalse:[
+ comments := comments collect:[:implMethodComment | implMethodComment firstLine] as:Set.
+ comments size == 1 ifTrue:[
+ info := info , ' ' , (self fetchCommentOfMethod:implMethods first).
+ ].
+ ].
+ ].
].
^ info
@@ -1515,9 +1515,10 @@
!Explainer class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Explainer.st,v 1.126 2013-06-21 01:49:37 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Explainer.st,v 1.127 2013-06-23 08:26:55 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libcomp/Explainer.st,v 1.126 2013-06-21 01:49:37 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Explainer.st,v 1.127 2013-06-23 08:26:55 cg Exp $'
! !
+