#UI_ENHANCEMENT by cg
class: Explainer
changed: #explain:in:forClass:short:
minor hack to show some instvar types.
"
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' }"
"{ NameSpace: Smalltalk }"
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' menu 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 (then a short explanaition
is shown in the lower info area).
Most of the texts returned here are heuristically motivated,
based on the experience with beginners and their frequently asked questions.
[author:]
Claus Gittinger
"
! !
!Explainer class methodsFor:'explaining'!
explainLiteralNode:node in:code forClass:cls short:short interval:intervalIfKnown
|expl literalValue findInnerMost elementIndex codeOfCharacterBeforeCursor|
literalValue := node value.
expl := literalValue class name "allBold" , '-constant'.
(literalValue isInteger) ifTrue:[
(literalValue ~~ 0 and:[literalValue ~~ 1]) ifTrue:[
expl := expl , ' ('.
#(2 10 16) with:#('binary: ' 'decimal: ' 'hex: ')do:[:base :baseExpl |
|bStr|
base ~= (node token radix ? 10) ifTrue:[
bStr := base==10
ifTrue:[literalValue printString]
ifFalse:[literalValue radixPrintStringRadix:base].
expl := expl , ' ' , baseExpl, bStr
].
].
expl := expl , ' )'.
].
^ expl.
].
(literalValue isCharacter) ifTrue:[
expl := expl , ' ',literalValue storeString,' (code: ',literalValue codePoint printString,' hex: 16r',literalValue codePoint hexPrintString,')'.
^ expl.
].
(node isLiteralArray and:[intervalIfKnown notNil]) ifTrue:[
"/ see which element we have to explain
findInnerMost :=
[:token |
token value keysAndValuesDo:[:index :eachToken |
|selectorOrName|
((eachToken start to:eachToken stop) intersect:intervalIfKnown) notEmpty ifTrue:[
elementIndex := index. "/ see below
eachToken value isArray ifTrue:[
findInnerMost value:eachToken.
].
eachToken value isSymbol ifTrue:[
selectorOrName := eachToken value.
selectorOrName isUppercaseFirst ifTrue:[
(Smalltalk includesKey:selectorOrName) ifTrue:[
^ expl, ' / ', (Explainer explainGlobal:selectorOrName inClass:cls short:short)
].
].
^ expl, ' / ', (Explainer explainSelector:selectorOrName inClass:cls short:short)
].
].
]
].
findInnerMost value:node token.
].
(literalValue isArray or:[ literalValue isByteArray or:[ literalValue isString ]]) ifTrue:[
literalValue size == 0 ifTrue:[
^ 'empty ' , expl
].
elementIndex notNil ifTrue:[
^ expl , (' (size=%1; element=%2)' bindWith:literalValue size with:elementIndex)
].
literalValue isString ifTrue:[
elementIndex := intervalIfKnown start - node token start.
(elementIndex between:1 and:literalValue size) ifTrue:[
codeOfCharacterBeforeCursor := (literalValue at:elementIndex) codePoint.
^ expl , (' (size=%1; position=%2; codePoint=16r%3)'
bindWith:literalValue size
with:elementIndex
with:codeOfCharacterBeforeCursor hexPrintString)
]
].
^ expl , (' (size=%1)' bindWith:literalValue size)
].
^ expl
"Modified: / 09-10-2006 / 12:09:43 / cg"
!
explainMessageNode:node in:code forClass:cls short:short interval:intervalIfKnown
"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 hint|
selector := node buildSelectorString.
selector := selector asSymbolIfInterned. "/ avoid creating new symbols.
selectorString := selector printString contractTo:30.
boldSelectorString := selectorString "allBold".
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.
(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
].
(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 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 and:[(cls includesBehavior:implClass) not]) 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 <= 8 ifTrue:[
implMethods size < 4 ifTrue:[
"/ show full comments
comments := implMethods
collect:[:implMethod | implMethod comment]
thenSelect:[:comment | comment notEmptyOrNil].
] ifFalse:[
"/ show first lines one
comments := implMethods
collect:[:implMethod | (self fetchCommentOfMethod:implMethod)]
thenSelect:[:comment | comment notEmptyOrNil].
].
comments := comments collect:[:each | each colorizeAllWith:(UserPreferences current commentColor) ].
short ifTrue:[
comments := comments collect:[:implMethodComment | implMethodComment firstLine] as:Set.
comments size == 1 ifTrue:[
^ info , ' ' , (comments first).
].
^ info
].
info := info,'\'withCRs.
comments
with:implementingClasses
do:[:eachComment :eachClass |
info := info,'\comment in ',eachClass name,':\',(eachComment asStringCollection asString)
].
].
].
^ info
"Modified: / 06-02-2007 / 19:26:11 / cg"
!
explainMethodNode:node in:code forClass:cls short:short interval:intervalIfKnown
|srchClass selector selectorString implClass
"sendingMethods numSendingMethods sendingClasses" boldSelectorString|
selector := node selector.
selector := selector asSymbolIfInterned. "/ avoid creating new symbols.
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 includesSelector: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
self explainNode:node in:code forClass:cls short:short interval:nil
!
explainNode:node in:code forClass:cls short:short interval:intervalIfKnown
node isVariable ifTrue:[
^ self explainVariableNode:node in:code forClass:cls short:short interval:intervalIfKnown.
].
node isLiteral ifTrue:[
^ self explainLiteralNode:node in:code forClass:cls short:short interval:intervalIfKnown
].
node isMessage ifTrue:[
^ self explainMessageNode:node in:code forClass:cls short:short interval:intervalIfKnown
].
node isMethod ifTrue:[
^ self explainMethodNode:node in:code forClass:cls short:short interval:intervalIfKnown
].
^ nil
!
explainVariableNode:node in:code forClass:cls short:short interval:intervalIfKnown
|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|
"/ with wait cursor, because it accesses sourcecode (via SCM)
WindowGroup activeGroup withWaitCursorDo:[
methodComment := mthd comment.
].
methodComment isEmptyOrNil ifTrue:[^ nil].
lines := methodComment asStringCollection.
methodComment := lines first.
methodComment := methodComment withoutSeparators.
(methodComment endsWith:',') ifTrue:[ methodComment := methodComment copyButLast:1].
methodComment := methodComment withoutSeparators.
(lines size > 1) ifTrue:[
methodComment := methodComment , ' ...'
].
^ ('"' , methodComment , '"') colorizeAllWith:(UserPreferences current commentColor).
"Created: / 14-09-2006 / 14:11:58 / cg"
!
guessPossibleImplementorClassesFor:node in:code forClass:cls
"given a node of some code of a method in cls,
return a collection of possible receiver classes."
|nm globalValue definer instances classesOfInstVars ns|
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] as:Set.
^ classesOfInstVars.
].
(cls classVariableNames includes:nm) ifTrue:[
^ Array with:(cls classVarAt:nm asSymbol) class.
].
nm isUppercaseFirst ifTrue:[
nm knownAsSymbol ifTrue:[
globalValue := Smalltalk at:nm asSymbol.
globalValue isClass ifTrue:[
^ Array with:globalValue class.
].
].
((ns := cls topNameSpace) notNil and:[ns ~~ Smalltalk]) ifTrue:[
nm knownAsSymbol ifTrue:[
globalValue := ns 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
"Modified: / 07-02-2012 / 22:19:53 / cg"
! !
!Explainer class methodsFor:'explaining-naive'!
commonSuperClassOf:listOfClassesOrClassNames
<resource: #obsolete>
^ Behavior commonSuperclassOf:listOfClassesOrClassNames
"Modified (format): / 28-02-2012 / 09:00:37 / cg"
!
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
"Modified: / 07-06-2007 / 11:34:05 / cg"
!
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."
|explainer variables c string explanation tmp1
spc sym sel stringText cls clsName val valString
instIndex setOfTypes toRemove toAdd|
string := someText string withoutSeparators.
string isEmpty ifTrue:[ ^ nil ].
stringText := string allBold.
"/ stringText := '''' , stringText , ''''.
"
ask parser for variable names
"
ParseError catch:[
explainer := self parseMethod:source in:aClass ignoreErrors:true ignoreWarnings:true.
].
"/ bad leftover from a stupid return value from ancient times
explainer == #Error ifTrue:[ explainer := nil ].
(explainer notNil) ifTrue:[
"look for variables"
variables := explainer methodVars.
(variables notNil and:[variables includes:string]) ifTrue:[
^ stringText , ' a method variable.'
].
variables := explainer methodArgs.
(variables notNil and:[variables includes:string]) ifTrue:[
^ stringText , ' a method argument.'
]
].
explainer isNil ifTrue:[
explainer := self for:(ReadStream on:source) in:aClass
].
"instvars/class instVars"
c := aClass whichClassDefinesInstVar:string.
c notNil ifTrue:[
c isMeta ifTrue:[
clsName := c theNonMetaclass name.
shortText ifTrue:[
stringText := stringText , ': a class instVar in ' , clsName
] ifFalse:[
stringText := stringText, ': a class instance variable inherited from ' , clsName
].
val := aClass theNonMetaclass instVarNamed:string.
valString := self valueStringFor:val.
^ stringText , ' (' , valString , ').'
].
clsName := c name.
shortText ifTrue:[
stringText := stringText , ': an instVar in ' , clsName , '.'
] ifFalse:[
stringText := stringText , ': an instance variable inherited from ' , clsName , '.'
].
"/ look for instances
setOfTypes := IdentitySet new.
instIndex := c instVarIndexFor:string.
c allSubInstancesDo:[:i |
|varClass|
varClass := (i instVarAt:instIndex) class.
setOfTypes add:varClass.
].
"/ TODO: look for assignments
c withAllSubclassesDo:[:cls |
cls methodDictionary do:[:m |
|tree code visitor|
"/ quick check
code := m source.
(code notNil and:[code includesString:string]) ifTrue:[
tree := Parser parse:code class:cls.
(tree notNil and:[tree ~~ #Error]) ifTrue:[
visitor := PluggableParseNodeVisitor new.
visitor
actionForNodeClass:AssignmentNode
put:[:node |
|val|
node variable name = string ifTrue:[
"/ only look for wellknown types on the right side.
node expression isConstant ifTrue:[
val := node expression evaluate.
val isArray ifTrue:[
setOfTypes add:Array
] ifFalse:[
setOfTypes add:val class
].
] ifFalse:[
node expression isMessage ifTrue:[
( #(+ - * /) includes:node expression selector ) ifTrue:[
setOfTypes add:Number
] ifFalse:[
( #(// size) includes:node expression selector ) ifTrue:[
setOfTypes add:Integer
] ifFalse:[
( #(copy shallowCopy) includes:node expression selector ) ifTrue:[
] ifFalse:[
( #(new new: basicNew basicNew:) includes:node expression selector ) ifTrue:[
node expression receiver isGlobal ifTrue:[
setOfTypes add:node expression receiver evaluate
].
] ifFalse:[
self breakPoint:#cg.
]
]
]
]
].
].
].
true "/ yes - visit subnodes
].
visitor visit:tree.
].
]
]
].
"/ reduce...
toAdd := Set new.
toRemove := Set new.
setOfTypes do:[:type1 |
setOfTypes do:[:type2 |
|common|
type1 superclass == type2 ifTrue:[
toRemove add:type1.
] ifFalse:[
type2 superclass == type1 ifTrue:[
toRemove add:type2.
] ifFalse:[
common := type1 commonSuperclass:type2.
common ~~ Object ifTrue:[
toRemove add:type1.
toRemove add:type2.
toAdd add:common.
].
].
].
]
].
setOfTypes removeAll:toRemove.
setOfTypes addAll:toRemove.
setOfTypes := setOfTypes collect:#name as:OrderedCollection.
setOfTypes sort.
setOfTypes size == 1 ifTrue:[
stringText := stringText,' (',setOfTypes first,')'
] ifFalse:[
setOfTypes size == 2 ifTrue:[
stringText := stringText,' (',setOfTypes first,' or ',setOfTypes second,')'
] ifFalse:[
setOfTypes size == 3 ifTrue:[
stringText := stringText,' (',setOfTypes first,', ',setOfTypes second,' or ',setOfTypes third,')'
] ifFalse:[
setOfTypes size == 0 ifTrue:[
stringText := stringText,(' (type unknown)' bindWith:setOfTypes size)
] ifFalse:[
stringText := stringText,(' (one of %1 types)' bindWith:setOfTypes size)
].
].
].
].
^ stringText
].
string isWideString ifFalse:[
"classvars"
c := explainer inWhichClassIsClassVar:string.
c notNil ifTrue:[
clsName := c name.
shortText ifTrue:[
stringText := stringText , ': a classVar in ' , clsName
] ifFalse:[
stringText := stringText , ': a class variable in ' , clsName
].
val := c theNonMetaclass classVarAt:string. "/ Smalltalk at:(clsName , ':' , string) asSymbol.
valString := self valueStringFor:val.
^ stringText , ' (' , valString , ').'
].
"private classes"
c := aClass theNonMetaclass.
c privateClasses do:[:pClass |
(pClass name = string
or:[pClass nameWithoutPrefix = string]) ifTrue:[
stringText := stringText , ': a private class in ''' , c name , '''.'.
shortText ifFalse:[
stringText := (stringText , '\\It is only visible locally.') withCRs
].
^ stringText withCRs
].
].
aClass theNonMetaclass sharedPoolNames do:[:eachPoolName |
|sharedPool sharedPoolSym|
sharedPoolSym := string asSymbolIfInterned.
sharedPoolSym notNil ifTrue:[
sharedPool := Smalltalk classNamed:eachPoolName.
sharedPool notNil ifTrue:[
sharedPool isSharedPool ifFalse:[
^ 'oops - not a shared pool: ',eachPoolName
].
(sharedPool includesKey:sharedPoolSym) ifTrue:[
stringText := stringText , ': a pool variable in ',sharedPool name.
val := sharedPool at:sharedPoolSym.
valString := self valueStringFor:val.
^ stringText , ' (' , valString , ').'
].
].
].
].
"namespace & global variables"
(spc := aClass nameSpace) notNil ifTrue:[
sym := (spc name , '::' , string) asSymbolIfInterned.
sym notNil ifTrue:[
(cls := Smalltalk at:sym) isBehavior ifTrue:[
string := stringText , ': '.
cls name = sym ifFalse:[
string := string , 'refers to ',cls name,', '
].
cls isSharedPool ifTrue:[
string := string , 'a sharedPool'.
] ifFalse:[
string := string , 'a class'.
].
string := string , ' in the ''' , spc name , ''' nameSpace'.
string := string , ' {', cls 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"
explanation := self explainKnownSymbol:string inClass:aClass short:shortText.
explanation notNil ifTrue:[
string isBinarySelector ifTrue:[
"/ some are both known as syntax AND as selector (for example: #| )
tmp1 := self explainSyntax:string short:shortText.
tmp1 notNil ifTrue:[
^ tmp1 , '\\also:\\' withCRs , explanation
].
].
^ explanation
].
"/ try with added colon ...
sel := string , ':'.
Symbol allInstancesDo:[:sym |
(sym startsWith:sel) ifTrue:[
explanation := self explainKnownSymbol:sym inClass:aClass short:shortText.
explanation notNil ifTrue:[ ^ explanation].
]
].
"/ ].
"try for some obvious things"
explanation := self explainPseudoVariable:string in:aClass short:true.
explanation notNil ifTrue:[ ^ explanation].
].
"try syntax ..."
explanation := self explainSyntax:string short:shortText.
explanation notNil ifTrue:[ ^ explanation].
shortText ifTrue:[
^ 'no explanation'
].
explainer isNil ifTrue:[
^ 'parse error - no explanation'
].
^ 'Sorry, I cannot explain this (could not figure out what this is).
Please try again with an individual token selected.'
"Created: / 03-12-1995 / 12:47:37 / cg"
"Modified: / 16-04-1997 / 12:46:11 / stefan"
"Modified: / 27-07-2013 / 09:53:30 / cg"
!
explainGlobal:string inClass:aClass short:shortText
"return an explanation or nil"
^ self explainGlobalOrPoolVariable:string inClass:aClass short:shortText
"Modified: / 14-10-2010 / 11:33:17 / cg"
"Modified (comment): / 28-02-2012 / 10:45:58 / cg"
!
explainGlobalOrPoolVariable:string inClass:aClass short:shortText
"return an explanation or nil"
|sym stringText explanation val classCategory what pool valText doc|
"if not even known as key, its definitely not a global"
sym := string asSymbolIfInterned.
sym isNil ifTrue:[^ nil].
stringText := string allBold.
"/ stringText := '''' , stringText , ''''.
stringText := stringText , ': '.
"a pool variable?"
aClass notNil ifTrue:[
aClass theNonMetaclass sharedPoolNames do:[:eachPoolName |
pool := Smalltalk at:eachPoolName.
pool isNil ifTrue:[
] ifFalse:[
(pool classVarNames includes:string) ifTrue:[
what := 'a pool variable in "%1".' bindWith:eachPoolName.
val := pool classVarAt:sym.
].
].
].
].
what isNil ifTrue:[
"try globals"
(Smalltalk includesKey:sym) ifTrue:[
what := 'a global variable.'.
val := Smalltalk at:sym.
] ifFalse:[
(aClass theNonMetaclass sharedPoolNames includes:string) ifTrue:[
pool := Smalltalk at:sym ifAbsent:nil.
pool isNil ifTrue:[
^ stringText,'a missing pool'.
].
] ifFalse:[
^ nil
].
].
].
explanation := stringText , what.
val isBehavior ifTrue:[
"/ a class
val name = sym ifFalse:[
stringText := stringText , ' a global; refers to ',val name,', '.
].
(val isRealNameSpace) ifTrue:[
^ stringText , 'a namespace.'
].
classCategory := val category ? 'uncategorized'.
shortText ifTrue:[
stringText := stringText , (val isLoaded ifTrue:['a'] ifFalse:['an autoloaded']).
stringText := stringText , (val isSharedPool ifTrue:[' sharedPool'] ifFalse:[' class']).
^ stringText , ' in ',val package,' {' , classCategory , '}.'.
].
val name = string ifTrue:[
false ifTrue:[
"/ TODO: generate a short documentation string (comment plus interface)
"/ and return { #html->htmlText . #text->regularText}
"/ so caller can extrat what he wants to see...
^ (HTMLDocGenerator htmlDocOf:val).
].
explanation := explanation , '\' withCRs , string , ' is '.
explanation := explanation , (val isLoaded ifTrue:['a'] ifFalse:['an autoloaded']).
explanation := explanation , (val isSharedPool ifTrue:[' sharedPool'] ifFalse:[' class']).
explanation := explanation , ' categorized as "' , classCategory , '"'.
explanation := explanation , '\' withCRs , 'in the "' , val package , '" package.'.
(doc := val commentOrDocumentationString) notEmptyOrNil ifTrue:[
doc := doc asStringCollection.
doc size > 25 ifTrue:[
doc := doc copyTo:25.
doc add:''; add:' ... <more documentation cut off>'.
].
doc := doc asString colorizeAllWith:(UserPreferences current commentColor).
explanation := explanation,'\\' withCRs,val name,'''s documentation:\'withCRs, doc
].
^ explanation.
].
explanation := explanation , '
' , string , ' is bound to the class ' , val name ,
' in the "' , classCategory , '" category.'.
^ explanation.
].
valText := self valueStringFor:val.
shortText ifTrue:[
^ stringText,' a global (',valText,')'.
].
explanation := explanation , '
Its current value is "%1".' bindWith:valText.
^ explanation.
"Created: / 14-10-2010 / 11:33:04 / cg"
"Modified: / 14-02-2012 / 15:31:28 / cg"
"Modified (comment): / 28-02-2012 / 10:45:48 / cg"
!
explainHereIn:aClass
"return an explanation"
<resource: #obsolete>
^ self explainHereIn:aClass short:false
"Modified (comment): / 28-02-2012 / 10:47:29 / cg"
!
explainHereIn:aClass short:shortText
"return an explanation"
|className|
className := aClass name.
shortText ifTrue:[
^ '"here" - message lookup always starts in "%1" (always call local method).' bindWith:className
].
^ 'like "self", "','here'allBold,'" 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 (' , className , '),
instead of the receiver''s class (' , className , ' or subclass).
Thus, using "here", redefined methods will NOT be reached with a here-send and it is ensured,
that the local method is called.'
"Created: / 28-02-2012 / 10:44:55 / cg"
!
explainKnownSymbol:string inClass:aClass
"return an explanation or nil"
^ self explainKnownSymbol:string inClass:aClass short:false
"Modified (comment): / 28-02-2012 / 10:45:40 / cg"
!
explainKnownSymbol:string inClass:aClass short:shortText
"return an explanation or nil"
|sym expl|
sym := string asSymbolIfInterned.
sym isNil ifTrue:[^ nil].
"try globals and pools"
(Smalltalk includesKey:sym) ifTrue:[
expl := self explainGlobalOrPoolVariable:string inClass:aClass short:shortText.
expl notNil ifTrue:[^ expl].
].
expl := self explainSelector:string inClass:aClass short:shortText.
expl notNil ifTrue:[^ expl].
^ self explainGlobalOrPoolVariable:string inClass:aClass short:shortText.
"Modified: / 18-01-2011 / 19:13:07 / cg"
"Modified (comment): / 28-02-2012 / 10:46:06 / cg"
!
explainPseudoVariable:string in:aClass
"return an explanation for the pseudoVariables self, super etc."
<resource: #obsolete>
^ self explainPseudoVariable:string in:aClass short:false
"Modified (format): / 28-02-2012 / 10:47:17 / cg"
!
explainPseudoVariable:string in:aClass short:shortText
"return an explanation for the pseudoVariables self, super etc."
(string = 'self') ifTrue:[
^ self explainSelfIn:aClass short:shortText
].
(string = 'super') ifTrue:[
^ self explainSuperIn:aClass short:shortText
].
(string = 'here') ifTrue:[
^ self explainHereIn:aClass short:shortText
].
(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
"Modified (comment): / 28-02-2012 / 10:46:18 / cg"
!
explainSelector:string inClass:aClass short:shortText
"return an explanation or nil"
|sym listOfImplementingClasses listOfSimilarSelectors
firstImplementingClassOfSimilar count tmp commonSuperClass s s2
firstImplementingClass cm msg t check|
sym := string asSymbolIfInterned.
sym isNil ifTrue:[^ nil].
"
try selectors
look who implements it
"
listOfImplementingClasses := Set new.
listOfSimilarSelectors := Set new.
check :=
[:sel :mthd :cls |
sel == sym ifTrue:[
listOfImplementingClasses add:(cls name).
firstImplementingClass isNil ifTrue:[
firstImplementingClass := cls
]
] ifFalse:[
(sel startsWith:sym) ifTrue:[
listOfSimilarSelectors add:sel.
firstImplementingClassOfSimilar isNil ifTrue:[
firstImplementingClassOfSimilar := cls
]
]
]
].
Smalltalk allClassesDo:[:c|
c methodDictionary keysAndValuesDo:[:sel :mthd |
check value:sel value:mthd value:c
].
c class methodDictionary keysAndValuesDo:[:sel :mthd |
check value:sel value:mthd value: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 := listOfImplementingClasses size.
(count ~~ 0) ifTrue:[
"
for up-to 4 implementing classes,
list them
"
listOfImplementingClasses := listOfImplementingClasses asOrderedCollection sort.
shortText ifTrue:[
tmp := ' is implemented in '.
] ifFalse:[
tmp := ' is a selector implemented in '.
].
s := "'#' ," string allBold.
(count == 1) ifTrue:[
(t := listOfImplementingClasses first) isMeta ifTrue:[
t := 'the ' , t
].
msg := s , tmp , t , '.'.
shortText ifFalse:[
msg := msg , s2.
]
] ifFalse:[
(count == 2) ifTrue:[
msg := s,tmp,(listOfImplementingClasses at:1),' and ',(listOfImplementingClasses at:2),'.'.
shortText ifFalse:[
msg := msg , s2.
].
] ifFalse:[
(count == 3) ifTrue:[
msg := s,tmp,(listOfImplementingClasses at:1),',',(listOfImplementingClasses at:2),' and ',(listOfImplementingClasses at:3),'.'.
shortText ifFalse:[
msg := msg , s2.
].
] ifFalse:[
shortText ifTrue:[
msg := s , tmp , count printString , ' classes'.
commonSuperClass := Class commonSuperclassOf:listOfImplementingClasses.
commonSuperClass notNil ifTrue:[
(commonSuperClass == Object
and:[commonSuperClass includesSelector:sym]) ifTrue:[
msg := msg , ' (including ' , 'Object' "allBold", ')'
] ifFalse:[
(commonSuperClass ~= Object) ifTrue:[
msg := msg , ' (under ' , commonSuperClass name, ')'
]
].
].
msg := msg , '.'.
^ msg
].
(count == 3) ifTrue:[
msg := s , tmp , '
' , (listOfImplementingClasses at:1) , ', ' , (listOfImplementingClasses at:2) , ' and ' , (listOfImplementingClasses at:3) , '.' , s2
] ifFalse:[
(count == 4) ifTrue:[
msg := s , tmp , '
' , (listOfImplementingClasses at:1) , ', ' , (listOfImplementingClasses at:2) , ', ' , (listOfImplementingClasses at:3), ' and ' , (listOfImplementingClasses at:4) , '.' , s2
] ifFalse:[
"
if there are more, look for a common
superclass and show it ...
"
commonSuperClass := Behavior commonSuperclassOf:listOfImplementingClasses.
(commonSuperClass ~~ Object
and:[commonSuperClass ~~ Behavior
and:[commonSuperClass ~~ Class
and:[commonSuperClass ~~ ClassDescription]]]) ifTrue:[
(listOfImplementingClasses 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 := self fetchCommentOfMethod:(firstImplementingClass compiledMethodAt:sym).
"/ ].
"/ cm notNil ifTrue:[
"/ msg := msg , '\\The comment in ' withCRs
"/ , firstImplementingClass name "allBold" , ' is:\' withCRs
"/ , '"' , cm allItalic , '"'.
"/ ]
"/ ].
].
^ msg
].
count := listOfSimilarSelectors size.
(count ~~ 0) ifTrue:[
listOfSimilarSelectors := listOfSimilarSelectors asOrderedCollection sort.
shortText ifTrue:[
tmp := ' is implemented in '.
] ifFalse:[
tmp := ' is a selector implemented in '.
].
(count == 1) ifTrue:[
msg := listOfSimilarSelectors first allBold , tmp , firstImplementingClassOfSimilar name , '.'.
shortText ifFalse:[
msg := msg , s2.
]
] ifFalse:[
msg := 'similar selectors: %1, %2' bindWith:listOfSimilarSelectors first allBold with:listOfSimilarSelectors second allBold.
count > 2 ifTrue:[
msg := msg,'...'.
].
].
^ msg
].
^ nil
"Modified: / 17-06-1996 / 17:09:30 / stefan"
"Created: / 23-03-1999 / 13:29:33 / cg"
"Modified: / 27-07-2013 / 09:59:46 / cg"
!
explainSelfIn:aClass short:shortText
"return an explanation"
|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"
"Modified (comment): / 28-02-2012 / 10:47:06 / cg"
!
explainSuperIn:aClass short:shortText
"return an explanation"
|superName|
superName := aClass superclass name.
shortText ifTrue:[
^ '"super" - message lookup starts in superclass "%1" (call redefined method).' bindWith:superName
].
^ 'like "self", "','super'allBold,'" 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 receiver''s class (' , aClass name , ' or subclass).
Thus, using "super", a redefined method can call the original (redefined) method of its superclass.'
"Modified (comment): / 28-02-2012 / 10:47:03 / cg"
!
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 (syntax)'.
].
^ '<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>.
The "_" form is historic and should not be used with new code.'
].
(string = '^') ifTrue:[
shortText ifTrue:[
^ '"^" - return value from method (syntax)'.
].
^ '^ <expression>
A return statement evaluates <expression> and returns its value from the method.
A return inside a block exits the method where the block is defined (not only the block).'
].
(string = ';') ifTrue:[
shortText ifTrue:[
^ '";" - a cascade expression (syntax)'.
].
^ '<expression> ; selector1 ; .... ; selectorN
a cascade expression; evaluate expression, and send messages
<selector1> ... <selectorN> to the first expression''s receiver.
Returns the value of the last send. The cascade sends may also have arguments.'
].
(string = '|') ifTrue:[
shortText ifTrue:[
^ '"|" - local variables (syntax)'.
].
^ '| 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 arg nams must be prefixed by a colon character.
"|" is also a selector understood by Booleans.'
].
(string startsWith:'$' ) ifTrue:[
shortText ifTrue:[
^ '"$x" - character literal (syntax)'.
].
^ 'is a Character literal constant.
Character objects represent indivdual text cheracters in Unicode encoding.
For example, $a is the character "a" with an encoding of 97 "hex: 16r61".
Smalltalk/X supports unicode and uses this encoding internally for all characters
and strings. Notice, that not all Smalltalk implementations allow non-ascii (i.e. codes > 255).'
].
(string startsWith:'#' ) ifTrue:[
(string startsWith:'#(' ) ifTrue:[
shortText ifTrue:[
^ '"#(..)" - array literal (syntax)'.
].
^ 'is a constant Array (literal).
The array-object is created at compilation time and a reference to this is
used at execution time (thus, the same object is referred to every time).
The elements of a constant Array must be numbers, strings, symbols, nil, true or false,
other array constants or byte-arrays.
(notice, that not all Smalltalk implementations allow true, false and nil as
element in an Array-constant).'
].
(string startsWith:'#[') ifTrue:[
shortText ifTrue:[
^ '"#[..]" - byteArray literal (syntax)'.
].
^ 'is a constant ByteArray (literal).
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 (syntax)'.
].
^ '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 but are immutable.'
].
shortText ifTrue:[
^ '"#.." - symbol literal (syntax)'.
].
^ 'is a constant 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 but are immutable.'
].
((string startsWith:'(') or:[string endsWith:')']) ifTrue:[
shortText ifTrue:[
^ ''.
].
^ '( <expression> )
expression grouping. Without them, expressions are evaluated left to right,
with unary messages preceeding binary messages, preceeding keyword mesages.'
].
((string startsWith:'[') or:[string endsWith:']']) ifTrue:[
shortText ifTrue:[
^ '"[..]" - a block (aka lambda/closure for experts)'.
].
^ '[:arg1 .. :argN | statements]
defines a block.
Blocks represent pieces of executable code. The definition of a block does
not evaluate it, instead a reference to the blocks computation is created.
The block can be evaluated later, by sending it a value/value: message
(it can be even evaluated multiple times).
Blocks are often passed as arguments to Booleans (i.e. "bool ifTrue:[...]"),
other blocks (i.e. "[...] whileTrue: [...]"]) or collections (i.e. "coll do:[...]").
Blocks are also often used as callbacks from UI components or as exception handlers.'
].
((string startsWith:'{') or:[string endsWith:'}']) ifTrue:[
shortText ifTrue:[
^ '"{..}" array instantiation (syntax)'.
].
^ '{ <expr1>. .. <exprN> }
This is syntactic sugar for "Array with:<expr1> .. with:<exprN>".
A new array is created with N elements initialized from the N expressions.
The expressions are separated by a period statement separator.
The expressions are evaluated at execution time, and a new array is always created
when executed (as opposed to an array literal, which is computed only once at
compilation time) and which is shared.
Notice that this construct is not supported by all Smalltalk dialects, so its use
makes your program somewhat dialect specific.'
].
(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 withoutSeparators startsWith:'"') ifTrue:[
(string withoutSeparators startsWith:'"/') ifTrue:[
shortText ifTrue:[
^ 'an end-of-line comment (syntax)'.
].
^ '"/ comment
EOL (end-of-line) comment
anything up to the end of line is a comment and ignored (but not inside a string).
Notice that EOL-comments are only supported by Smalltalk/X (i.e. non-portable).
'
].
(string withoutSeparators startsWith:'"<<') ifTrue:[
shortText ifTrue:[
^ 'a token delimited comment (syntax)'.
].
^ '"<<TOKEN
...
TOKEN
Token delimited comment
anything up to a line which contains the token alone is a comment and ignored (but not inside a string).
Notice that Token-comments are only supported by Smalltalk/X (i.e. non-portable).
'
].
shortText ifTrue:[
^ 'a comment (syntax)'.
].
^ '" comment ... "
comment
anything between double quotes is a comment and ignored (but not inside a string).
'
].
"/ 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: / 27-07-2013 / 10:08:57 / cg"
!
valueStringFor:aValue
|valString|
"/ only show the value, if it is really short...
(aValue isBoolean
or:[aValue isNil
or:[aValue isString
or:[aValue isNumber
or:[aValue isPoint
or:[aValue isCharacter
]]]]]) ifTrue:[
^ aValue storeString.
].
(aValue isColor) ifTrue:[
^ 'Color: ',(' ' emphasizeAllWith:(#backgroundColor->aValue)).
].
((aValue isKindOf:GUID)
or:[aValue isUUID]) ifTrue:[
valString := aValue printString.
].
(valString isEmptyOrNil
or:[ valString size > 50
or:[ valString includes:Character cr ]]) ifTrue:[
valString := aValue classNameWithArticle.
].
^ valString
"Modified: / 14-10-2010 / 11:57:52 / cg"
! !
!Explainer class methodsFor:'documentation'!
version
^ '$Header$'
!
version_CVS
^ '$Header$'
! !