"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libcomp' }"
Parser subclass:#Explainer
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'System-Compiler'
!
!Explainer class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
a very simple explainer - much more should be added ...
This one is involved, when the 'explain' function is used in a
codeView (popup or via CMD-E), or if the mouse button is clicked
on some code construct in the new browser.
[author:]
Claus Gittinger
"
! !
!Explainer class methodsFor:'explaining'!
explainLiteralNode:node in:code forClass:cls short:short
|expl literalValue|
literalValue := node value.
expl := literalValue class name "allBold" , '-constant.'.
(literalValue isArray or:[ literalValue isByteArray ]) ifTrue:[
literalValue size == 0 ifTrue:[
^ 'empty ' , expl
].
].
^ expl
"Modified: / 09-10-2006 / 12:09:43 / cg"
!
explainMessageNode:node in:code forClass:cls short:short
"answer a string which explains node"
|receiver nm srchClass selector selectorString implClass
boldSelectorString globalValue recClassSet
implMethod implMethodComment info implMethods comments definer
instances classesOfInstVars implementingClasses canBeNil
bestMatches|
selector := node selector.
selectorString := selector printString contractTo:30.
boldSelectorString := selectorString "allBold".
recClassSet := self guessPossibleImplementorClassesFor:(node receiver) in:code forClass:cls.
recClassSet size == 1 ifTrue:[
srchClass := recClassSet first.
implementingClasses := recClassSet collect:[:cls | cls whichClassIncludesSelector:selector].
(implementingClasses includes:nil) ifTrue:[
implementingClasses size > 1 ifTrue:[
^ 'possibly not understood: %1 (%2 other implementors)'
bindWith:selector "allBold"
with:(implementingClasses size - 1)
].
bestMatches := Parser findBestSelectorsFor:selector in:srchClass.
bestMatches size > 0 ifTrue:[
^ 'NOT understood here: %1 (Best guess: %2)'
bindWith:selector
with:(bestMatches first "allBold")
].
^ 'NOT understood here: %1' bindWith:selector "allBold"
].
].
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].
classesOfInstVars := classesOfInstVars asSet.
canBeNil := classesOfInstVars includes:UndefinedObject.
classesOfInstVars remove:UndefinedObject ifAbsent:[].
implementingClasses := classesOfInstVars collect:[:cls | cls whichClassIncludesSelector:selector].
] 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
].
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
].
].
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)'.
].
] ifFalse:[
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].
comments asSet size == 1 ifTrue:[
info := info , ' ' , (self fetchCommentOfMethod:implMethods first).
].
].
].
].
^ info
"Modified: / 06-02-2007 / 19:26:11 / cg"
!
explainMethodNode:node in:code forClass:cls short:short
|srchClass selector selectorString implClass
"sendingMethods numSendingMethods sendingClasses" boldSelectorString|
selector := node selector.
selectorString := selector printString contractTo:30.
boldSelectorString := selectorString "allBold".
(srchClass := cls superclass) notNil ifTrue:[
implClass := srchClass whichClassIncludesSelector:selector.
implClass notNil ifTrue:[
^ '%1 hides implementation in %2.'
bindWith:boldSelectorString
with:implClass name "allBold"
].
].
(cls implements:selector) ifFalse:[
^ '%1: a new method.' bindWith:boldSelectorString
].
"/
"/ sendingMethods := SystemBrowser
"/ allCallsOn:selector
"/ in:(cls withAllSubclasses , cls allSubclasses)
"/ ignoreCase:false
"/ match:false.
"/ sendingMethods := sendingMethods select:[:eachMethod | eachMethod mclass notNil]. "/ remove unbound ones
"/
"/ sendingClasses := (sendingMethods collect:[:eachMethod | eachMethod mclass]) asSet.
"/ numSendingMethods := sendingMethods size.
"/ numSendingMethods == 1 ifTrue:[
"/ sendingClasses first == cls ifTrue:[
"/ ^ '%1: sent locally from %2.'
"/ bindWith:boldSelectorString
"/ with:sendingMethods first selector "allBold"
"/ ].
"/ ^ '%1: sent in hierarchy from %2 in %3.'
"/ bindWith:boldSelectorString
"/ with:sendingMethods first selector "allBold"
"/ with:sendingClasses first name.
"/ ].
"/ numSendingMethods == 2 ifTrue:[
"/ sendingClasses asIdentitySet size == 1 ifTrue:[
"/ sendingClasses first == cls ifTrue:[
"/ ^ '%1: sent locally from %2 and %3.'
"/ bindWith:boldSelectorString
"/ with:sendingMethods first selector "allBold"
"/ with:sendingMethods second selector "allBold"
"/ ].
"/ ^ '%1: sent in hierarchy from %2 and %3 in %4.'
"/ bindWith:boldSelectorString
"/ with:sendingMethods first selector "allBold"
"/ with:sendingMethods second selector "allBold"
"/ with:sendingClasses first name.
"/ ].
"/ ].
"/ numSendingMethods == 0 ifTrue:[
"/"/ ^ '%1: no sender found.'
"/"/ bindWith:boldSelectorString.
"/ ^ nil
"/ ].
"/ ^ '%1: %2 sending methods in hierarchy.'
"/ bindWith:boldSelectorString
"/ with:numSendingMethods.
"/
"/ "/ the following is too expensive...
"/"/ sendingMethods := SystemBrowser allCallsOn:selector in:Smalltalk allClasses.
"/"/ numSendingMethods == 0 ifTrue:[
"/"/ ^ '%1: nowhere sent.' bindWith:boldSelectorString
"/"/ ].
"/"/ numSendingMethods == 1 ifTrue:[
"/"/ sendingMethods first mclass == cls ifTrue:[
"/"/ ^ '%1: only sent from %2.'
"/"/ bindWith:boldSelectorString
"/"/ with:sendingMethods first selector "allBold"
"/"/ ].
"/"/ ^ '%1: only sent from %2 in %3.'
"/"/ bindWith:boldSelectorString
"/"/ with:sendingMethods first selector "allBold"
"/"/ with:sendingMethods first mclass name.
"/"/ ].
"/"/ sendingClasses := (sendingMethods collect:[:eachMethod | eachMethod mclass]) asSet.
"/"/ sendingClasses size == 1 ifTrue:[
"/"/ sendingClasses first == cls ifTrue:[
"/"/ ^ '%1: locally sent from %2 methods.'
"/"/ bindWith:boldSelectorString
"/"/ with:numSendingMethods
"/"/ ].
"/"/ ^ '%1 only sent from %2 methods in %3.'
"/"/ bindWith:boldSelectorString
"/"/ with:numSendingMethods
"/"/ with:sendingClasses first name.
"/"/ ].
^ nil
"Modified: / 09-10-2006 / 12:11:16 / cg"
!
explainNode:node in:code forClass:cls short:short
node isVariable ifTrue:[
^ self explainVariableNode:node in:code forClass:cls short:short.
].
node isLiteral ifTrue:[
^ self explainLiteralNode:node in:code forClass:cls short:short
].
node isMessage ifTrue:[
^ self explainMessageNode:node in:code forClass:cls short:short
].
node isMethod ifTrue:[
^ self explainMethodNode:node in:code forClass:cls short:short
].
^ nil
!
explainVariableNode:node in:code forClass:cls short:short
|expl nm nmBold definingNode namePart|
nm := node name.
(#( 'self' 'super' 'thisContext' 'here') includes:nm) ifTrue:[
^ Explainer explainPseudoVariable:nm in:cls short:short
].
nm notNil ifTrue:[ nmBold := nm "allBold" ].
definingNode := node whoDefines:nm.
definingNode notNil ifTrue:[
namePart := '''' , nmBold , ''''.
definingNode isMethod ifTrue:[
(definingNode arguments contains:[:arg | arg name = nm]) ifTrue:[
expl := namePart , ' is a method argument.'
].
].
expl isNil ifTrue:[
definingNode isBlock ifTrue:[
(definingNode arguments contains:[:arg | arg name = nm]) ifTrue:[
expl := namePart , ' is a block argument.'
].
].
].
expl isNil ifTrue:[
definingNode parent notNil ifTrue:[
definingNode parent isMethod ifTrue:[
expl := namePart , ' is a method temporary.'.
] ifFalse:[
definingNode parent isBlock ifTrue:[
expl := namePart , ' is a block temporary.'.
]
]
].
].
expl isNil ifTrue:[
expl := namePart , ' is a temporary.'
].
(cls allInstanceVariableNames includes:nm) ifTrue:[
expl := expl , ' (Instance Variable is hidden)'
].
^ expl.
].
^ Explainer explain:node name in:code forClass:cls short:short
"Modified: / 07-11-2006 / 12:22:09 / cg"
!
fetchCommentOfMethod:mthd
|methodComment lines|
methodComment := mthd comment.
methodComment isNil ifTrue:[^ nil].
lines := methodComment asStringCollection.
methodComment := lines first.
methodComment := methodComment withoutSeparators.
(methodComment endsWith:',') ifTrue:[ methodComment := methodComment copyWithoutLast:1].
methodComment := methodComment withoutSeparators.
(lines size > 1) ifTrue:[
methodComment := methodComment , '...'
].
^ ('"' , methodComment , '"') asText colorizeAllWith:(UserPreferences current commentColor).
"Created: / 14-09-2006 / 14:11:58 / cg"
!
guessPossibleImplementorClassesFor:node in:code forClass:cls
|nm globalValue recClassSet rsltClassSet implSet definer instances classesOfInstVars|
node isVariable ifTrue:[
nm := node name.
nm = 'self' ifTrue:[
^ cls withAllSubclasses
].
nm = 'here' ifTrue:[
^ cls withAllSuperclasses
].
nm = 'super' ifTrue:[
^ cls allSuperclasses
].
definer := node 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].
classesOfInstVars := classesOfInstVars asSet.
^ classesOfInstVars.
].
nm isUppercaseFirst ifTrue:[
nm knownAsSymbol ifTrue:[
globalValue := Smalltalk at:nm asSymbol.
globalValue isClass ifTrue:[
^ Array with:globalValue class.
].
].
(cls topNameSpace notNil and:[cls topNameSpace ~~ Smalltalk]) ifTrue:[
globalValue := cls topNameSpace at:nm asSymbol.
globalValue isClass ifTrue:[
^ Array with:globalValue class.
].
]
].
].
^ nil
].
node isLiteral ifTrue:[
^ Array with:(node value class)
].
node isMessage ifTrue:[
recClassSet := self guessPossibleImplementorClassesFor:(node receiver) in:code forClass:cls.
recClassSet isNil ifTrue:[ ^ nil ].
recClassSet isEmpty ifTrue:[ ^ nil ].
implSet := recClassSet collect:[:recClass | recClass whichClassIncludesSelector:node selector].
"/ toDo: for each implementor, parse its method for possible return types.
^ rsltClassSet.
].
^ nil
! !
!Explainer class methodsFor:'explaining-naive'!
commonSuperClassOf:listOfClassesOrClassNames
^ Behavior commonSuperclassOf:listOfClassesOrClassNames
!
explain:someText in:source forClass:aClass
"Given a source and a substring of it, return a string containing
an explanation.
This is just a q&d implementation - to be correct, it should use the parser,
and explain from the parsetree (instead of doing string matches).
This leads to some wrong explanations, for example if some string is
used as selector within a string, or if a variable is named like a
message selector. I.e. the explanation should be context sensitive.
Also, there could be much more detailed explanations."
^ self
explain:someText in:source forClass:aClass short:false
!
explain:someText in:source forClass:aClass short:shortText
"Given a source and a substring of it, return a string containing
an explanation.
This is just a q&d implementation - to be correct, it should use the parser,
and explain from the parsetree (instead of doing string matches).
This leads to some wrong explanations, for example if some string is
used as selector within a string, or if a variable is named like a
message selector. I.e. the explanation should be context sensitive.
Also, there could be much more detailed explanations."
|parser variables c string tmp
spc sym sel stringText clsName val valString|
string := someText string withoutSeparators.
stringText := string "allBold".
stringText := '''' , stringText , ''''.
"
ask parser for variable names
"
ParseErrorSignal catch:[
parser := self parseMethod:source in:aClass ignoreErrors:true ignoreWarnings:true.
].
(parser notNil and:[parser ~~ #Error]) ifTrue:[
"look for variables"
variables := parser methodVars.
(variables notNil and:[variables includes:string]) ifTrue:[
^ stringText , ' is a method variable.'
].
variables := parser methodArgs.
(variables notNil and:[variables includes:string]) ifTrue:[
^ stringText , ' is a method argument.'
]
].
parser isNil ifTrue:[
parser := self for:(ReadStream on:source) in:aClass
].
"instvars"
c := aClass whichClassDefinesInstVar:string.
c notNil ifTrue:[
c isMeta ifTrue:[
clsName := c theNonMetaclass name.
shortText ifTrue:[
^ stringText , ' is a class instVar in ' , clsName , '.'
].
^ stringText, ' is a class instance variable in ' , clsName , '.'
].
clsName := c name.
shortText ifTrue:[
^ stringText , ' is an instVar in ' , clsName , '.'
].
^ stringText , ' is an instance variable in ' , clsName , '.'
].
"/ variables := aClass allInstVarNames.
"/ (variables notNil and:[variables includes:string]) ifTrue:[
"/ "where is it"
"/ c := aClass.
"/ [c notNil] whileTrue:[ |v|
"/ v := c instVarNames.
"/ (v notNil and:[v includes:string]) ifTrue:[
"/ ^ string , ' is an instance variable in ' , c name
"/ ].
"/ c := c superclass
"/ ].
"/ self error:'oops'
"/ ].
"/ "class instvars"
"/ variables := aClass class allInstVarNames.
"/ (variables notNil and:[variables includes:string]) ifTrue:[
"/ "where is it"
"/ c := aClass.
"/ [c notNil] whileTrue:[ |v|
"/ v := c class instVarNames.
"/ (v notNil and:[v includes:string]) ifTrue:[
"/ ^ string , ' is a class instance variable in ' , c name
"/ ].
"/ c := c superclass
"/ ].
"/ self error:'oops'
"/ ].
"classvars"
c := parser inWhichClassIsClassVar:string.
c notNil ifTrue:[
clsName := c name.
shortText ifTrue:[
stringText := stringText , ' is a classVar in ' , clsName
] ifFalse:[
stringText := stringText , ' is a class variable in ' , clsName
].
val := Smalltalk at:(clsName , ':' , string) asSymbol.
(val isBoolean or:[val isNil]) ifTrue:[
valString := val storeString .
] ifFalse:[
(val isSymbol or:[val isNumber]) ifTrue:[
valString := val className, ' ' , val storeString .
] ifFalse:[
valString := val classNameWithArticle.
].
].
^ stringText , ' (' , valString , ').'
].
c := aClass theNonMetaclass.
c privateClasses do:[:pClass |
(pClass name = string
or:[pClass nameWithoutPrefix = string]) ifTrue:[
string := stringText , ' is a private class in ''' , c name , '''.'.
shortText ifFalse:[
string := (string , '\\It is only visible locally.') withCRs
].
^ string withCRs
].
].
(spc := aClass nameSpace) notNil ifTrue:[
sym := (spc name , '::' , string) asSymbolIfInterned.
sym notNil ifTrue:[
(Smalltalk at:sym) isBehavior ifTrue:[
string := stringText , ': '.
(Smalltalk at:sym) name = sym ifFalse:[
string := stringText , 'refers to ',(Smalltalk at:sym) name,', '
].
string := stringText , 'a class in the ''' , spc name , ''' nameSpace'.
string := string , ' (in "', (Smalltalk at:sym) category ,'")'.
shortText ifFalse:[
string := (string
, '\\It is only visible within this nameSpace.'
, '\Access from the outside is possible'
, '\by the special name ''' , spc name , '::' , string , '''.') withCRs
].
^ string withCRs
].
].
].
"/ string knownAsSymbol ifTrue:[
"globals & symbols"
tmp := self explainKnownSymbol:string inClass:aClass short:shortText.
tmp notNil ifTrue:[ ^ tmp].
"/ try with added colon ...
sel := string , ':'.
Symbol allInstancesDo:[:sym |
(sym startsWith:sel) ifTrue:[
tmp := self explainKnownSymbol:sym inClass:aClass short:shortText.
tmp notNil ifTrue:[ ^ tmp].
]
].
"/ ].
"try for some obvious things"
tmp := self explainPseudoVariable:string in:aClass short:true.
tmp notNil ifTrue:[ ^ tmp].
"try syntax ..."
tmp := self explainSyntax:string short:shortText.
tmp notNil ifTrue:[ ^ tmp].
shortText ifTrue:[
^ 'no explanation'
].
parser isNil ifTrue:[
^ 'parse error - no explanation'
].
^ 'cannot explain this (could not figure out what this is).'
"Created: / 03-12-1995 / 12:47:37 / cg"
"Modified: / 16-04-1997 / 12:46:11 / stefan"
"Modified: / 06-03-2007 / 14:01:28 / cg"
!
explainGlobal:string inClass:aClass short:shortText
"return explanation or nil"
|sym stringText tmp val classCategory|
"if not even known as key, its definitely not a global"
sym := string asSymbolIfInterned.
sym isNil ifTrue:[^ nil].
"try globals"
(Smalltalk includesKey:sym) ifFalse:[ ^ nil].
stringText := string "allBold".
"/ stringText := '''' , stringText , ''''.
stringText := stringText , ': '.
tmp := stringText , 'a global variable.'.
val := Smalltalk at:sym.
val isBehavior ifTrue:[
"/ a class
val name = sym ifFalse:[
stringText := stringText , ' refers to ',val name,', '.
].
(val isRealNameSpace) ifTrue:[
^ stringText , 'a namespace.'
].
classCategory := val category ? 'uncategorized'.
shortText ifTrue:[
^ stringText , (val isLoaded ifTrue:['a'] ifFalse:['an autoloaded'])
, ' class in ',val package,' {' , classCategory , '}.'.
].
val name = string ifTrue:[
tmp := tmp , '
' , string , ' is ' , (val isLoaded ifTrue:['a'] ifFalse:['an autoloaded'])
, ' class categorized as ' , classCategory , '
in the ''' , val package , ''' package.'.
^ tmp.
].
tmp := tmp , '
' , string , ' is bound to the class ' , val name ,
' in the ''' , classCategory , ''' category.'.
^ tmp.
].
shortText ifTrue:[
val isNil ifTrue:[
^ stringText , 'a global, currently nil.'.
].
^ stringText , 'a global, currently bound to ''' , val classNameWithArticle , '''.'.
].
tmp := tmp , '
Its current value is ''' , val classNameWithArticle , '''.'.
^ tmp.
"Modified: / 06-02-2007 / 19:32:15 / cg"
!
explainHereIn:aClass
^ 'like self, here refers to the object which received the message.
However, when sending a message to here the search for methods
implementing this message will start in the defining class (' , aClass name , ')
instead of the receivers class (' , aClass name , ' or subclass).
Thus, using here, redefined methods will NOT be reached with a here-send.'
!
explainKnownSymbol:string inClass:aClass
"return explanation or nil"
^ self explainKnownSymbol:string inClass:aClass short:false
!
explainKnownSymbol:string inClass:aClass short:shortText
"return explanation or nil"
|sym|
sym := string asSymbolIfInterned.
sym isNil ifTrue:[^ nil].
"try globals"
(Smalltalk includesKey:sym) ifTrue:[
^ self explainGlobal:string inClass:aClass short:shortText
].
^ self explainSelector:string inClass:aClass short:shortText
!
explainPseudoVariable:string in:aClass
"return explanation for the pseudoVariables self, super etc."
^ self explainPseudoVariable:string in:aClass short:false
!
explainPseudoVariable:string in:aClass short:shortText
"return explanation for the pseudoVariables self, super etc."
(string = 'self') ifTrue:[
^ self explainSelfIn:aClass short:shortText
].
(string = 'super') ifTrue:[
shortText ifTrue:[
^ '''super'' - message lookup starts in superclass ''' , aClass superclass name , '''.'
].
^ self explainSuperIn:aClass short:shortText
].
(string = 'here') ifTrue:[
shortText ifTrue:[
^ '''here'' - message lookup always starts in ''' , aClass name , '''.'
].
^ self explainHereIn:aClass
].
(string = 'thisContext') ifTrue:[
shortText ifTrue:[
^ '''thisContext'' - the current stack frame as an object.'
].
^ 'thisContext is a pseudo variable (i.e. it is built in).
ThisContext always refers to the context object for the currently executed method or
block (an instance of Context or BlockContext respectively). The calling chain and calling
receivers/selectors can be accessed via thisContext.'
].
(string = 'true') ifTrue:[
shortText ifTrue:[
^ '''true'' - the truth and nothing but the truth.'
].
^ 'true is a pseudo variable (i.e. it is built in).
True represents logical truth. It is the one and only instance of class True.'
].
(string = 'false') ifTrue:[
shortText ifTrue:[
^ '''false'' - obvisously not true.'
].
^ 'false is a pseudo variable (i.e. it is built in).
False represents logical falseness. It is the one and only instance of class False.'
].
(string = 'nil') ifTrue:[
shortText ifTrue:[
^ '''nil'' - undefined, unknown, void or dont care.'
].
^ 'nil is a pseudo variable (i.e. it is built in).
Nil is used for unitialized variables (among other uses).
Nil is the one and only instance of class UndefinedObject.'
].
^ nil
!
explainSelector:string inClass:aClass short:shortText
"return explanation or nil"
|sym list count tmp commonSuperClass s s2
firstImplementingClass cm msg t|
sym := string asSymbolIfInterned.
sym isNil ifTrue:[^ nil].
"
try selectors
look who implements it
"
list := Set new.
Smalltalk allClassesDo:[:c|
(c includesSelector:sym) ifTrue:[
list add:(c name).
firstImplementingClass isNil ifTrue:[
firstImplementingClass := c
]
].
(c class includesSelector:sym) ifTrue:[
list add:(c name , ' class').
firstImplementingClass isNil ifTrue:[
firstImplementingClass := c class
]
]
].
(aClass canUnderstand:sym) ifTrue:[
s2 := ('Instances of ''' , aClass name , ''' respond to #') , sym "allBold" , '.'.
shortText ifFalse:[
s2 := '\\' , s2
, '\- inherited from ' withCRs
, (aClass whichClassIncludesSelector:sym) name "allBold".
].
firstImplementingClass := (aClass whichClassIncludesSelector:sym)
] ifFalse:[
s2 := ''.
].
count := list size.
(count ~~ 0) ifTrue:[
"
for up-to 4 implementing classes,
list them
"
list := list asOrderedCollection sort.
shortText ifTrue:[
tmp := ' is implemented in '.
] ifFalse:[
tmp := ' is a selector implemented in '.
].
s := '#' , string "allBold".
(count == 1) ifTrue:[
(t := list first) isMeta ifTrue:[
t := 'the ' , t
].
msg := s , tmp , t , '.'.
shortText ifFalse:[
msg := msg , s2.
]
] ifFalse:[
(count == 2) ifTrue:[
msg := s , tmp , (list at:1) , ' and ' , (list at:2) , '.'.
shortText ifFalse:[
msg := msg , s2.
].
] ifFalse:[
shortText ifTrue:[
msg := s , tmp , count printString , ' classes'.
commonSuperClass := Class commonSuperclassOf:list.
(commonSuperClass == Object
and:[commonSuperClass includesSelector:sym]) ifTrue:[
msg := msg , ' (including ' , 'Object' "allBold", ')'
].
msg := msg , '.'.
^ msg
].
(count == 3) ifTrue:[
msg := s , tmp , '
' , (list at:1) , ', ' , (list at:2) , ' and ' , (list at:3) , '.' , s2
] ifFalse:[
(count == 4) ifTrue:[
msg := s , tmp , '
' , (list at:1) , ', ' , (list at:2) , ', ' , (list at:3), ' and ' , (list at:4) , '.' , s2
] ifFalse:[
"
if there are more, look for a common
superclass and show it ...
"
commonSuperClass := Behavior commonSuperclassOf:list.
(commonSuperClass ~~ Object
and:[commonSuperClass ~~ Behavior
and:[commonSuperClass ~~ Class
and:[commonSuperClass ~~ ClassDescription]]]) ifTrue:[
(list includes:commonSuperClass) ifTrue:[
msg := s . tmp , count printString , commonSuperClass name
, ' and redefined in ' , (count - 1) printString
, ' subclasses'
, s2.
firstImplementingClass := commonSuperClass
] ifFalse:[
msg := s , tmp, count printString , ' subclasses of ' , commonSuperClass name , s2
]
] ifFalse:[
(commonSuperClass == Object
and:[commonSuperClass includesSelector:sym]) ifTrue:[
msg := s , tmp , count printString , ' classes.
All objects seem to respond to that message,
since there is an implementation in Object.' , s2.
firstImplementingClass := Object
] ifFalse:[
((commonSuperClass == Behavior
or:[commonSuperClass == Class
or:[commonSuperClass == ClassDescription]])
and:[commonSuperClass includesSelector:sym]) ifTrue:[
msg := s , tmp , count printString , ' classes.
All classes seem to respond to that message,
since there is an implementation in ' , commonSuperClass name , '.' , s2.
firstImplementingClass := commonSuperClass
] ifFalse:[
"
otherwise just give the number.
"
msg := s , tmp , count printString , ' classes.' , s2
]
]
]
]
]
].
].
shortText ifTrue:[
count == 1 ifTrue:[
cm := self fetchCommentOfMethod:(firstImplementingClass compiledMethodAt:sym).
cm notNil ifTrue:[
msg := msg,' ',cm
].
].
] ifFalse:[
firstImplementingClass notNil ifTrue:[
WindowGroup activeGroup withWaitCursorDo:[
cm := firstImplementingClass compiledMethodAt:sym.
cm notNil ifTrue:[
cm := cm methodComment.
]
].
cm notNil ifTrue:[
msg := msg , '\\The comment in ' withCRs , firstImplementingClass name "allBold" , ' is:\' withCRs , cm allItalic.
]
].
].
^ msg
].
^ nil
"Modified: / 17-06-1996 / 17:09:30 / stefan"
"Created: / 23-03-1999 / 13:29:33 / cg"
"Modified: / 09-10-2006 / 12:11:58 / cg"
!
explainSelfIn:aClass short:shortText
|sub subNames selfString className nSubClasses|
selfString := '''' , 'self' "allBold" , ''''.
sub := aClass allSubclasses.
nSubClasses := sub size.
aClass isMeta ifTrue:[
className := aClass theNonMetaclass name.
subNames := sub collect:[:c | c theNonMetaclass name].
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.
In this case, it will be the ' , className , '-class
or one of its subclasses:
' , subNames asStringCollection asString
].
^ selfString , ' refers to the object which received the message.
In this case, it will be the ' , className , '-class
or one of its ' , nSubClasses printString , ' subclasses.'
].
subNames := aClass allSubclasses collect:[:c | c theNonMetaclass name].
className := aClass name.
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.
In this case, it will be an instance of ' , className , '
or one of its subclasses:
' , subNames asStringCollection asString
].
^ selfString , ' refers to the object which received the message.
In this case, it will be an instance of ' , className , '
or one of its ' , nSubClasses printString , ' subclasses.'
"Modified: / 09-10-2006 / 12:11:44 / cg"
!
explainSuperIn:aClass short:shortText
|superName|
superName := aClass superclass name.
shortText ifTrue:[
^ '''super'' - message lookup starts in ' , superName , '.'
].
^ 'like self, super refers to the object which received the message.
However, when sending a message to super the search for methods
implementing this message will start in the superclass (' , superName , ')
instead of the receivers class (' , aClass name , ' or subclass).
Thus, using super, a redefined method can call the original method in its superclass.'
!
explainSyntax:string
"try syntax ...; return explanation or nil"
^ self explainSyntax:string short:false
!
explainSyntax:string short:shortText
"try syntax ...; return explanation or nil"
((string = ':=') or:[string = '_']) ifTrue:[
shortText ifTrue:[
^ 'Assign to variable on the left side.'.
].
^ '<variable> := <expression>
'':='' and ''_'' (which is left-arrow in some fonts) mean assignment.
The variable is bound to (i.e. points to) the value of <expression>.'
].
(string = '^') ifTrue:[
shortText ifTrue:[
^ 'Return value from method.'.
].
^ '^ <expression>
returns the value of <expression> as value from the method.
A return from within a block exits the method where the block is defined.'
].
(string = ';') ifTrue:[
shortText ifTrue:[
^ 'Cascade expression.'.
].
^ '<expression> ; selector1 ; .... ; selectorN
a cascade expression; evaluate expression, and send messages
<selector1> ... <selectorN> to the first expressions receiver.
Returns the value of the last send. The cascade sends may also have arguments.'
].
(string = '|') ifTrue:[
shortText ifTrue:[
^ ''.
].
^ '| locals | or: [:arg | statements]
''|'' is used to mark a local variable declaration or separates arguments
from the statements in a block. Notice, that in a block-argument declaration
these must be prefixed by a colon character.
''|'' is also a selector understood by Booleans.'
].
((string startsWith:'(') or:[string endsWith:')']) ifTrue:[
shortText ifTrue:[
^ ''.
].
^ '(<expression>)
expression grouping.'
].
((string startsWith:'[') or:[string endsWith:']']) ifTrue:[
shortText ifTrue:[
^ ''.
].
^ '[:arg1 .. :argN | statements]
defines a block.
Blocks represent pieces of executable code. Definition of a block does
not evaluate it. The block is evaluated by sending it a value/value:
message.
Blocks are often passed as arguments to Booleans (i.e. ifTrue:[...]) or
collections (i.e. do:[...]).'
].
(string = ':') ifTrue:[
shortText ifTrue:[
^ ''.
].
^ 'colons have different meaning depending on context:
1) they separate keyword-parts in symbols and keyword-messages as in:
#at:put: a constant keyword symbol
rec at:index put:value sends the #at:put: message to rec,
passing index and value as arguments.
2) within block-argument declarations as in:
[:arg1 :arg2 | statements]
3) within an identifier, they separate the nameSpace part from
the name part; as in:
Smalltalk::Array - the Array class in the Smalltalk nameSpace.
Foo::Array - the Array class in the Foo nameSpace.
'
].
(string = '.') ifTrue:[
^ 'statement. "<- period here"
statement
within a method or block, individual statements are separated by periods.
'
].
(string startsWith:'#' ) ifTrue:[
(string startsWith:'#(' ) ifTrue:[
shortText ifTrue:[
^ 'Array Literal.'.
].
^ 'is a constant Array.
The elements of a constant Array must be Number-constants, nil, true or false.
(notice, that not all Smalltalk implementations allow true, false and nil as
constant-Array elements).'
].
(string startsWith:'#[') ifTrue:[
shortText ifTrue:[
^ 'ByteArray Literal.'.
].
^ 'is a constant ByteArray.
The elements of a constant ByteArray must be Integer constants in the range
0 .. 255.
(notice, that not all Smalltalk implementations support constant ByteArrays).'
].
(string startsWith:'#''') ifTrue:[
shortText ifTrue:[
^ 'Symbol Literal.'.
].
^ 'is a constant symbol containing non-alphanumeric characters.
Symbols are unique strings, meaning that there exists
exactly one instance of a given symbol. Therefore symbols can
be compared using == (identity compare) in addition to = (contents compare).
Beside this, Symbols behave mostly like Strings.
Notice, that not all Smalltalk implementations support this kind of symbols.'
].
shortText ifTrue:[
^ 'Symbol Literal.'.
].
^ 'is a symbol.
Symbols are unique strings, meaning that there exists
exactly one instance of a given symbol. Therefore symbols can
be compared using == (identity compare) in addition to = (contents compare).
Beside this, Symbols behave mostly like Strings.'
].
"/ is it a symbol without hash-character ?
"/
"/ string knownAsSymbol ifTrue:[
"/ ^ 'is nothing, but #' , string , ' is known as a symbol.
"/
"/Symbols are unique strings, meaning that there exists
"/exactly one instance of a given symbol. Therefore symbols can
"/be compared using == (identity compare) in addition to = (contents compare).
"/Beside this, Symbols behave mostly like Strings.'
"/ ].
^ nil
"Modified: / 31.10.1998 / 14:28:58 / cg"
! !
!Explainer class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libcomp/Explainer.st,v 1.82 2007-03-06 13:22:13 cg Exp $'
! !