--- a/Explainer.st Sun May 15 06:58:25 2016 +0200
+++ b/Explainer.st Tue May 17 07:03:59 2016 +0200
@@ -55,6 +55,10 @@
Most of the texts returned here are heuristically motivated,
based on the experience with beginners and their frequently asked questions.
+ TODO:
+ this is in an experimental stage; the naive type inferer replicates code
+ found in DWIM support; it should use the code there.
+
[author:]
Claus Gittinger
"
@@ -168,7 +172,7 @@
selectorString := self asLink:selectorString to:(self actionToBrowseImplementorsOf:selector).
boldSelectorString := selectorString "allBold".
- recClassSet := self guessPossibleImplementorClassesFor:(node receiver) in:code forClass:cls.
+ recClassSet := self guessPossibleClassesFor:(node receiver) in:code forClass:cls.
recClassSet size == 1 ifTrue:[
srchClass := recClassSet first.
"take care - Set cannot store nil!!"
@@ -182,7 +186,7 @@
].
(#('self' 'super' 'true' 'false' 'thisContext') includes:selector) ifTrue:[
- ^ ('NOT understood here: %1 (missing period after previous statement?)'
+ ^ ('%1 is NOT understood here (missing period after previous statement?)'
bindWith:selector allBold)
].
@@ -192,12 +196,12 @@
].
bestMatches := Parser findBestSelectorsFor:selector in:srchClass.
bestMatches size > 0 ifTrue:[
- ^ ('NOT understood here: %1 (best guess is: "%2" from %3)'
+ ^ ('%1 is NOT understood here (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
+ ^ ('%1 is NOT understood here' bindWith:selector allBold),hint
].
].
@@ -287,9 +291,9 @@
].
].
- implMethodComment := self fetchCommentOfMethod:implMethod.
+ implMethodComment := self fetchDescriptionOfMethod:"fetchCommentOfMethod:"implMethod.
implMethodComment notNil ifTrue:[
- info := info , ' ' , implMethodComment.
+ info := info , Character cr , implMethodComment.
action1 info:implMethod source.
].
^ info
@@ -474,9 +478,9 @@
definingNode isMethod ifTrue:[
argNode := definingNode arguments detect:[:arg | arg name = nm] ifNone:nil.
argNode notNil ifTrue:[
- expl := namePart , ' is a method argument.'.
-
- argClassSet := self guessPossibleImplementorClassesFor:argNode in:code forClass:cls.
+ expl := namePart , ': a method argument.'.
+
+ argClassSet := self guessPossibleClassesFor:argNode in:code forClass:cls.
argClassSet size == 1 ifTrue:[
argClass := argClassSet first.
].
@@ -485,24 +489,25 @@
expl isNil ifTrue:[
definingNode isBlock ifTrue:[
(definingNode arguments contains:[:arg | arg name = nm]) ifTrue:[
- expl := namePart , ' is a block argument.'
+ expl := namePart , ': a block argument.'
].
].
].
expl isNil ifTrue:[
- | parentNode setOfTypes isLocal typesDescription|
+ | parentNode setOfTypes isLocal typesDescription |
(parentNode := definingNode parent) notNil ifTrue:[
(isLocal := parentNode isMethod) ifTrue:[
- expl := namePart , ' is a method temporary.'.
+ expl := namePart , ': a method temporary.'.
] ifFalse:[
(isLocal := parentNode isBlock) ifTrue:[
- expl := namePart , ' is a block temporary.'.
+ expl := namePart , ': a block temporary.'.
]
].
isLocal ifTrue:[
setOfTypes := Set new.
self addTypesAssignedToLocal:nm inTree:parentNode to:setOfTypes.
+ setOfTypes remove:UndefinedObject ifAbsent:[].
typesDescription := self typeDescriptionFor:setOfTypes andSelector:nil.
typesDescription notNil ifTrue:[
expl := expl,' (',typesDescription,')'.
@@ -511,10 +516,10 @@
].
].
expl isNil ifTrue:[
- expl := namePart , ' is a temporary.'
+ expl := namePart , ': temporary.'
].
(cls allInstanceVariableNames includes:nm) ifTrue:[
- expl := expl , ' (Instance Variable is hidden)'
+ expl := expl , ' (instance variable is hidden)'
].
^ expl.
].
@@ -525,42 +530,86 @@
!
fetchCommentOfMethod:mthd
- "retrieve the comment of a method (if possible and there is one; otherwise, return nil)"
-
- |windowGroup methodComment lines|
-
- "/ with wait cursor, because it accesses sourcecode (via SCM)
- "/ however: this class is in libcomp (should be in libtool)
- "/ so check if WindowGroup (from libview) is present
- windowGroup := Smalltalk at:#WindowGroup.
- windowGroup isNil ifTrue:[
- methodComment := mthd comment.
- ] ifFalse:[
- windowGroup activeGroup withWaitCursorDo:[
- methodComment := mthd comment.
+ "retrieve the comment of a method
+ (if possible and there is one; otherwise, return nil)"
+
+ |methodSource methodComment lines maxNumLines|
+
+ self withWaitCursorDo:[
+ SourceCodeManagerError handle:[:ex |
+ ] do:[
+ methodSource := mthd source.
+ methodComment := mthd comment
].
].
- "/ Transcript showCR:methodComment.
-
+
methodComment isEmptyOrNil ifTrue:[^ nil].
-
+
lines := methodComment asStringCollection.
+ maxNumLines := 1.
+true ifTrue:[
+ methodComment := (lines copyToMax:maxNumLines) asString.
+ maxNumLines := 5.
+] ifFalse:[
methodComment := lines first.
methodComment := methodComment withoutSeparators.
(methodComment endsWith:',') ifTrue:[ methodComment := methodComment copyButLast:1].
methodComment := methodComment withoutSeparators.
- (lines size > 1) ifTrue:[
- methodComment := methodComment , ' ...'
+].
+ (lines size > maxNumLines) ifTrue:[
+ methodComment := methodComment , '\...' withCRs
].
- ^ ('"' , methodComment , '"') withColor:(UserPreferences current commentColor).
+ ^ (methodComment) withColor:(UserPreferences current commentColor).
"Created: / 14-09-2006 / 14:11:58 / cg"
"Modified (comment): / 30-04-2016 / 16:17:18 / cg"
!
-guessPossibleImplementorClassesFor:node in:code forClass:cls
+fetchDescriptionOfMethod:mthd
+ "retrieve a desription of a method
+ (if possible and there is one; otherwise, return nil)"
+
+ |methodDecl methodSource methodComment lines maxNumLines |
+
+ self withWaitCursorDo:[
+ SourceCodeManagerError handle:[:ex |
+ ] do:[
+ methodSource := mthd source.
+ methodDecl := mthd methodDefinitionTemplate.
+ methodComment := mthd comment.
+ ].
+ ].
+ methodComment isEmptyOrNil ifTrue:[
+ ^ methodDecl
+ ].
+ ^ methodDecl , Character cr ,
+ (methodComment withColor:(UserPreferences current commentColor)).
+
+ methodComment isEmptyOrNil ifTrue:[^ nil].
+
+ lines := methodComment asStringCollection.
+ maxNumLines := 1.
+true ifTrue:[
+ methodComment := (lines copyToMax:maxNumLines) asString.
+ maxNumLines := 5.
+] ifFalse:[
+ methodComment := lines first.
+ methodComment := methodComment withoutSeparators.
+ (methodComment endsWith:',') ifTrue:[ methodComment := methodComment copyButLast:1].
+ methodComment := methodComment withoutSeparators.
+].
+ (lines size > maxNumLines) ifTrue:[
+ methodComment := methodComment , '\...' withCRs
+ ].
+ ^ (methodComment) withColor:(UserPreferences current commentColor).
+
+ "Created: / 14-09-2006 / 14:11:58 / cg"
+ "Modified (comment): / 30-04-2016 / 16:17:18 / cg"
+!
+
+guessPossibleClassesFor:node in:code forClass:cls
"given a node of some code of a method in cls,
- return a collection of possible receiver classes."
+ return a collection of possible types of the node."
|nm globalValue definer instances classesOfInstVars ns|
@@ -606,6 +655,29 @@
]
].
].
+ definer isMethod ifTrue:[
+ |callers argNr setOfTypes|
+
+ argNr := definer arguments findFirst:[:arg | arg name = nm].
+ setOfTypes := IdentitySet new.
+ "/ see who calls this message; are there any calls with an obvious type?
+ callers := SystemBrowser allCallsOn:definer selector.
+ callers do:[:eachCaller |
+ |tree|
+ tree := eachCaller parseTree.
+ tree allMessageNodesDo:[:msg |
+ |argExpr|
+
+ msg selector = definer selector ifTrue:[
+ argExpr := (msg arguments at:argNr).
+ self addTypeOfExpressionNode:argExpr forAssignmentTo:nil to:setOfTypes.
+ ].
+ ].
+ ].
+ setOfTypes notEmpty ifTrue:[
+ ^ setOfTypes.
+ ].
+ ].
^ nil
].
@@ -625,6 +697,22 @@
^ nil
"Modified: / 07-02-2012 / 22:19:53 / cg"
+!
+
+withWaitCursorDo:aBlock
+ "with wait cursor;
+ however: this class is in libcomp (should be in libtool)
+ so check if WindowGroup (from libview) is present"
+
+ |windowGroup wg|
+
+ windowGroup := Smalltalk at:#WindowGroup.
+ windowGroup notNil ifTrue:[
+ (wg := windowGroup activeGroup) notNil ifTrue:[
+ ^ wg withWaitCursorDo:aBlock.
+ ].
+ ].
+ ^ aBlock value.
! !
!Explainer class methodsFor:'explaining-naive'!
@@ -825,6 +913,13 @@
explanation notNil ifTrue:[ ^ explanation].
shortText ifTrue:[
+ |selector|
+
+ (selector := SystemBrowser extractSelectorFrom:string) notNil ifTrue:[
+ selector ~= string string ifTrue:[
+ ^ self explain:selector in:source forClass:aClass short:shortText
+ ].
+ ].
^ 'no explanation'
].
@@ -904,7 +999,7 @@
"/ a real class
bindings at:'category' put:(val category ? 'uncategorized').
shortText ifTrue:[
- template := template , (val isLoaded ifTrue:[' a'] ifFalse:[' an autoloaded']).
+ template := template , ',' , (val isLoaded ifTrue:[' a'] ifFalse:[' an autoloaded']).
template := template , (val isSharedPool ifTrue:[' pool'] ifFalse:[' class']).
template := template , ' in %(package) {%(category)}.'.
bindings at:'package' put:val package.
@@ -1001,7 +1096,7 @@
classNameInText := aClass name.
shortText ifTrue:[
- template := '%1: an instVar in %2'.
+ template := '%1: instVar in %2'.
varNameInText := self
asLink:varNameInText
info:('Click to browse references to %1' bindWith:instVarName)
@@ -1200,7 +1295,7 @@
count > 1 ifTrue:[
s := self asLink:selector to:(self actionToOpenMethodFinderFor:selector).
] ifFalse:[
- s := self asLink:selector to:(self actionToBrowseClass:listOfImplementingClassNames first selector:selector).
+ s := self asLink:selector to:(self actionToBrowseClass:listOfImplementingClasses first selector:selector).
].
shortText ifTrue:[
@@ -1326,7 +1421,7 @@
].
].
classProvidingComment notNil ifTrue:[
- cm := self fetchCommentOfMethod:(classProvidingComment compiledMethodAt:selector).
+ cm := self fetchDescriptionOfMethod:"fetchCommentOfMethod:"(classProvidingComment compiledMethodAt:selector).
].
cm isNil ifTrue:[
"/ should: find the class with most subclasses from the list
@@ -1336,18 +1431,26 @@
(listOfImplementingClasses includes:Stream) ifTrue:[
classProvidingComment := Stream
] ifFalse:[
- classProvidingComment := listOfImplementingClasses detect:[:cls | (self fetchCommentOfMethod:(cls compiledMethodAt:selector)) notNil] ifNone:nil.
+ classProvidingComment := listOfImplementingClasses
+ detect:[:cls |
+ |mthd|
+ (mthd := cls compiledMethodAt:selector) notNil
+ and:[ (self fetchCommentOfMethod:mthd) notNil]]
+ ifNone:nil.
]
].
- classProvidingComment notNil ifTrue:[
- cm := self fetchCommentOfMethod:(classProvidingComment compiledMethodAt:selector).
- cm notNil ifTrue:[
- cm := (' %1 says: ' bindWith:classProvidingComment name),cm
- ].
+ cm isNil ifTrue:[
+ classProvidingComment notNil ifTrue:[
+ cm := self fetchDescriptionOfMethod:(classProvidingComment compiledMethodAt:selector).
+ ]
+ ].
+ cm notNil ifTrue:[
+ cm := (' %1 says:\' withCRs bindWith:(self asClassLink:classProvidingComment name)),cm
].
].
cm notNil ifTrue:[
- msg := msg,(msg last isSeparator ifTrue:[''] ifFalse:[' ']),cm
+ "/ msg := msg,(msg last isSeparator ifTrue:[''] ifFalse:[' ']),cm
+ msg := msg,(Character cr),cm
].
^ msg
].
@@ -1393,31 +1496,40 @@
explainSelfIn:aClass short:shortText
"return an explanation"
- |sub subNames selfString className nSubClasses|
+ |subClasses subNames selfString className nSubClasses
+ classLink classLink2 subclassesLink|
selfString := '''' , 'self' "allBold" , ''''.
- sub := aClass allSubclasses.
- nSubClasses := sub size.
+ subClasses := aClass allSubclasses.
+ nSubClasses := subClasses size.
aClass isMeta ifTrue:[
className := aClass theNonMetaclass name.
- subNames := sub collect:[:c | c theNonMetaclass name].
+ subNames := subClasses collect:[:c | c theNonMetaclass name].
+ shortText ifTrue:[
+ classLink := (self asClassLink:className).
+ nSubClasses == 0 ifTrue:[
+ ^ selfString , (' - the %1 class.' bindWith:classLink)
+ ].
+ nSubClasses == 1 ifTrue:[
+ classLink2 := self asClassLink:subNames first.
+ ^ selfString , (' - the %1- or %2 class.' bindWith:classLink with:classLink2)
+ ].
+ subclassesLink := self
+ asLink:('%1 subclasses' bindWith:nSubClasses)
+ info:('Click to browse subclasses')
+ to:(self actionToBrowseClasses:subClasses).
+
+ ^ selfString , (' - the %1 class or one of its %2.' bindWith:classLink with:subclassesLink)
+ ].
+
nSubClasses == 0 ifTrue:[
- shortText ifTrue:[
- ^ selfString , ' - the ''' , className , '''-class.'
- ].
^ selfString , 'refers to the object which received the message.
In this case, it will be the ' , className , '-class itself.'
].
- shortText ifTrue:[
- nSubClasses == 1 ifTrue:[
- ^ selfString , ' - the ''' , className , '''- or ''' , subNames first , '''-class.'
- ].
- ^ selfString , ' - the ''' , className , '''-class or one of its subclasses.'
- ].
nSubClasses <= 5 ifTrue:[
^ selfString , ' refers to the object which received the message.
@@ -1433,23 +1545,31 @@
or one of its ' , nSubClasses printString , ' subclasses.'
].
- subNames := aClass allSubclasses collect:[:c | c theNonMetaclass name].
+ subClasses := aClass allSubclasses.
+ subNames := subClasses collect:[:c | c theNonMetaclass name].
className := aClass name.
+ shortText ifTrue:[
+ classLink := self asClassLink:className.
+ nSubClasses == 0 ifTrue:[
+ ^ selfString , (' - an instance of %1.' bindWith:classLink)
+ ].
+ nSubClasses == 1 ifTrue:[
+ classLink2 := self asClassLink:subNames first.
+ ^ selfString , (' - an instance of %1 or %2.' bindWith:classLink with:classLink2)
+ ].
+ subclassesLink := self
+ asLink:('%1 subclasses' bindWith:nSubClasses)
+ info:('Click to browse subclasses')
+ to:(self actionToBrowseClasses:subClasses).
+ ^ selfString , (' - an instance of %1 or one of its %2.' bindWith:classLink with:subclassesLink)
+ ].
+
nSubClasses == 0 ifTrue:[
- shortText ifTrue:[
- ^ selfString , ' - an instance of ''' , className , '''.'
- ].
^ selfString , 'refers to the object which received the message.
In this case, it will be an instance of ' , className , '.'
].
- shortText ifTrue:[
- nSubClasses == 1 ifTrue:[
- ^ selfString , ' - an instance of ''' , className , ''' or ''' , subNames first , '''.'
- ].
- ^ selfString , ' - an instance of ''' , className , ''' or one of its subclasses.'
- ].
nSubClasses <= 5 ifTrue:[
^ selfString , ' refers to the object which received the message.
@@ -1499,7 +1619,7 @@
"try syntax ...; return explanation or nil.
This is meant for beginners..."
- |fullMsg|
+ |fullMsg stringWithoutSeparators|
((string = ':=') or:[string = '_']) ifTrue:[
fullMsg := '<variable> := <expression>
@@ -1692,8 +1812,10 @@
'
].
- (string withoutSeparators startsWith:'"') ifTrue:[
- (string withoutSeparators startsWith:'"/') ifTrue:[
+ stringWithoutSeparators := string withoutSeparators.
+
+ (stringWithoutSeparators startsWith:'"') ifTrue:[
+ (stringWithoutSeparators startsWith:'"/') ifTrue:[
shortText ifTrue:[
^ 'an end-of-line comment (syntax)'.
].
@@ -1704,7 +1826,7 @@
Notice that EOL-comments are only supported by Smalltalk/X (i.e. non-portable).
'
].
- (string withoutSeparators startsWith:'"<<') ifTrue:[
+ (stringWithoutSeparators startsWith:'"<<') ifTrue:[
shortText ifTrue:[
^ 'a token delimited comment (syntax)'.
].
@@ -1740,6 +1862,21 @@
"/Beside this, Symbols behave mostly like Strings.'
"/ ].
+ ((stringWithoutSeparators startsWith:'<') and:[stringWithoutSeparators endsWith:'>']) ifTrue:[
+ shortText ifTrue:[
+ (stringWithoutSeparators includesString:'resource:') ifTrue:[
+ ^ 'a ',(self
+ asLink:'resource annotation'
+ info:fullMsg
+ to:(self actionToBrowseClass:Annotation)),' (syntax)'
+ ].
+ ^ 'an ',(self
+ asLink:'annotation / pragma'
+ info:fullMsg
+ to:(self actionToBrowseClass:Annotation)),' (syntax)'
+ ].
+ ].
+
^ nil
"Modified: / 27-07-2013 / 10:08:57 / cg"
@@ -1873,13 +2010,17 @@
"/ really really only very low hanging fruit...
"/ ignore #/ here, because of filename
( #(+ - *) includes:msgSelector ) ifTrue:[
- "/ ignore foo := foo OP expr
- "/ ignore foo := expr OP foo
- (msgReceiver isVariable and:[msgReceiver name = varName]) ifFalse:[
- (expr arg1 isVariable and:[expr arg1 name = varName]) ifFalse:[
- self rememberType:Number in:setOfTypes.
- ]
- ].
+ true "(msgReceiver isLiteralNumber or:[expr arg1 isLiteralNumber])" ifTrue:[
+ self rememberType:Number in:setOfTypes.
+ ^ setOfTypes.
+ ].
+"/ "/ ignore foo := foo OP expr
+"/ "/ ignore foo := expr OP foo
+"/ (msgReceiver isVariable and:[msgReceiver name = varName]) ifFalse:[
+"/ (expr arg1 isVariable and:[expr arg1 name = varName]) ifFalse:[
+"/ self rememberType:Number in:setOfTypes.
+"/ ]
+"/ ].
^ setOfTypes.
].
@@ -1893,7 +2034,7 @@
rcvrTypes := self addTypeOfExpressionNode:msgReceiver forAssignmentTo:nil to:Set new.
rcvrTypes notEmpty ifTrue:[
-self breakPoint:#cg.
+ self breakPoint:#cg.
self rememberType:Character in:setOfTypes.
].
^ setOfTypes.
@@ -2138,18 +2279,11 @@
!
actionToBrowseClass:class selector:selectorOrNil
- ^ ActionWithInfo
- block:
- [
- self thisOrNewBrowserInto:[:browser :openHow |
- browser
- spawnFullBrowserInClass:class selector:selectorOrNil in:openHow
- ]
- ]
- info:nil.
+ ^ self actionToBrowseClass:class selector:selectorOrNil info:nil
!
actionToBrowseClass:class selector:selectorOrNil info:info
+ self assert:class isBehavior.
^ ActionWithInfo
block:
[
@@ -2207,6 +2341,7 @@
!
actionToBrowseMethod:mthd
+ self assert:mthd isMethod.
^ self actionToBrowseClass:(mthd mclass) selector:(mthd selector).
!
@@ -2252,7 +2387,7 @@
' implementing' etc. Or it can be an empty string.
To be shown in the info line at the bottom."
- |nClassNames sortedByName classNames|
+ |nClassNames sortedByName classNames link1 link2 link3 link4|
aCollectionOfClasses isEmpty ifTrue:[
^ 'No %1classes' bindWith:prefix.
@@ -2263,30 +2398,37 @@
nClassNames := classNames size.
nClassNames <= 4 ifTrue:[
+ sortedByName := classNames sort.
+ link1 := self asClassLink:sortedByName first.
nClassNames == 1 ifTrue:[
- ^ '%2' "'1 %1class: %2'" bindWith:prefix with:(classNames first allBold).
+ ^ '%2' "'1 %1class: %2'" bindWith:prefix with:link1.
].
- sortedByName := classNames sort.
+ link2 := self asClassLink:classNames second.
nClassNames == 2 ifTrue:[
^ '%2 and %3' "'2 %1classes: %2 and %3'" bindWith:prefix
- with:(sortedByName first allBold)
- with:(sortedByName second allBold).
+ with:link1
+ with:link2.
].
+ link3 := self asClassLink:classNames third.
nClassNames == 3 ifTrue:[
^ '%2, %3 and %4' "'3 %1classes: %2, %3 and %4'" bindWith:prefix
- with:(sortedByName first allBold)
- with:(sortedByName second allBold)
- with:(sortedByName third allBold).
+ with:link1
+ with:link2
+ with:link3.
].
+ link4 := self asClassLink:classNames fourth.
nClassNames == 4 ifTrue:[
^ '%2, %3, %4 and %5' "'4 %1classes: %2, %3, %4 and %5'" bindWith:prefix
- with:(sortedByName first allBold)
- with:(sortedByName second allBold)
- with:(sortedByName third allBold)
- with:(sortedByName fourth allBold).
+ with:link1
+ with:link2
+ with:link3
+ with:link4.
].
].
- ^ '%1 %2classes' bindWith:nClassNames printString allBold with:prefix
+ ^ self
+ asLink:('%1 %2classes' bindWith:nClassNames printString with:prefix)
+ info:'Browse classes'
+ to:(self actionToBrowseClasses:aCollectionOfClasses)
"Modified: / 27-07-2006 / 10:09:02 / cg"
!