--- a/Explainer.st Tue May 03 06:42:45 2016 +0200
+++ b/Explainer.st Wed May 04 08:03:08 2016 +0200
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -25,7 +25,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -90,7 +90,7 @@
findInnerMost :=
[:token |
token value keysAndValuesDo:[:index :eachToken |
- |selectorOrName|
+ |selectorOrName selectorExplanation|
((eachToken start to:eachToken stop) intersect:intervalIfKnown) notEmpty ifTrue:[
elementIndex := index. "/ see below
@@ -105,7 +105,9 @@
^ expl, ' / ', (Explainer explainGlobal:selectorOrName inClass:cls short:short)
].
].
- ^ expl, ' / ', (Explainer explainSelector:selectorOrName inClass:cls short:short)
+ selectorExplanation := (Explainer explainSelector:selectorOrName inClass:cls short:short).
+ selectorExplanation isNil ifTrue:[^ expl].
+ ^ expl, ' / ', selectorExplanation.
].
].
]
@@ -149,10 +151,15 @@
bestMatches hint|
selector := node buildSelectorString.
+ selectorString := selector printString contractTo:30.
selector := selector asSymbolIfInterned. "/ avoid creating new symbols.
- selectorString := selector printString contractTo:30.
+ selector isNil ifTrue:[
+ ^ '%1 is NOWHERE impemented.' bindWith:boldSelectorString
+ ].
+
+ selectorString := selectorString actionForAll:[UserPreferences systemBrowserClass browseImplementorsOf:selector].
boldSelectorString := selectorString "allBold".
-
+
recClassSet := self guessPossibleImplementorClassesFor:(node receiver) in:code forClass:cls.
recClassSet size == 1 ifTrue:[
srchClass := recClassSet first.
@@ -178,9 +185,9 @@
^ ('NOT understood here: %1 (best guess is: "%2" from %3)'
bindWith:selector allBold
with:(bestMatches first "allBold")
- with:(srchClass whichClassIncludesSelector:bestMatches first) name) , hint
+ with:(srchClass whichClassIncludesSelector:bestMatches first) name) , (hint?'')
].
- ^ ('NOT understood here: %1' bindWith:selector allBold),hint
+ ^ ('NOT understood here: %1' bindWith:selector allBold),(hint ? '')
].
].
@@ -227,9 +234,12 @@
implClass isNil ifTrue:[
^ '%1 is NOT understood here.' bindWith:boldSelectorString
].
- info := '%1 >> %2' bindWith:implClass name "allBold" with:selectorString "allBold".
implMethod := implClass compiledMethodAt:selector.
+
+ info := '%1 >> %2' bindWith:implClass name "allBold" with:selectorString "allBold".
+ info := info actionForAll:[UserPreferences systemBrowserClass openInClass:implClass selector:selector ].
+
implMethodComment := self fetchCommentOfMethod:implMethod.
implMethodComment notNil ifTrue:[
info := info , ' ' , implMethodComment.
@@ -242,8 +252,12 @@
].
implementingClasses size == 1 ifTrue:[
+ |clsName|
implClass := implementingClasses anElement.
- info := '%1 >> %2' bindWith:implClass name "allBold" with:selectorString.
+ implMethod := implClass compiledMethodAt:selector.
+ clsName := implClass name.
+ clsName := clsName actionForAll:[UserPreferences systemBrowserClass openInClass:implClass selector:selector ].
+ info := '%1 >> %2' bindWith:clsName "allBold" with:selectorString.
(srchClass isNil and:[(cls includesBehavior:implClass) not]) ifTrue:[
"/ info := 'guess: ', info.
info := info , ' (guess)'.
@@ -392,19 +406,19 @@
explainNode:node in:code forClass:cls short:short interval:intervalIfKnown
node isVariable ifTrue:[
- ^ self explainVariableNode:node in:code forClass:cls short:short interval:intervalIfKnown.
+ ^ 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
+ ^ 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
+ ^ 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
+ ^ self explainMethodNode:node in:code forClass:cls short:short interval:intervalIfKnown
].
^ nil
@@ -416,44 +430,54 @@
nm := node name.
(#( 'self' 'super' 'thisContext' 'here') includes:nm) ifTrue:[
- ^ Explainer explainPseudoVariable:nm in:cls short:short
+ ^ 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.
+ 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:[
+ | parentNode setOfTypes isLocal typesDescription|
+
+ (parentNode := definingNode parent) notNil ifTrue:[
+ (isLocal := parentNode isMethod) ifTrue:[
+ expl := namePart , ' is a method temporary.'.
+ ] ifFalse:[
+ (isLocal := parentNode isBlock) ifTrue:[
+ expl := namePart , ' is a block temporary.'.
+ ]
+ ].
+ isLocal ifTrue:[
+ setOfTypes := Set new.
+ self addTypesAssignedToLocal:nm inTree:parentNode to:setOfTypes.
+ typesDescription := self typeDescriptionFor:setOfTypes andSelector:nil.
+ typesDescription notNil ifTrue:[
+ expl := expl,' (',typesDescription,')'.
+ ].
+ ].
+ ].
+ ].
+ 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
@@ -623,6 +647,7 @@
c isMeta ifTrue:[
clsName := c theNonMetaclass name.
shortText ifTrue:[
+ clsName := (clsName actionForAll:[ c browse ]).
stringText := stringText , ': a class instVar in ' , clsName
] ifFalse:[
stringText := stringText, ': a class instance variable inherited from ' , clsName
@@ -640,6 +665,7 @@
c notNil ifTrue:[
clsName := c name.
shortText ifTrue:[
+ clsName := (clsName actionForAll:[ c browse ]).
stringText := stringText , ': a classVar in ' , clsName
] ifFalse:[
stringText := stringText , ': a class variable in ' , clsName
@@ -655,6 +681,7 @@
c privateClasses do:[:pClass |
(pClass name = string
or:[pClass nameWithoutPrefix = string]) ifTrue:[
+ stringText := (stringText actionForAll:[ pClass browse ]).
stringText := stringText , ': a private class in ''' , c name , '''.'.
shortText ifFalse:[
stringText := (stringText , '\\It is only visible locally.') withCRs
@@ -664,7 +691,7 @@
].
aClass theNonMetaclass sharedPoolNames do:[:eachPoolName |
- |sharedPool sharedPoolSym|
+ |sharedPool sharedPoolSym poolName|
sharedPoolSym := string asSymbolIfInterned.
sharedPoolSym notNil ifTrue:[
@@ -674,7 +701,9 @@
^ 'oops - not a shared pool: ',eachPoolName
].
(sharedPool includesKey:sharedPoolSym) ifTrue:[
- stringText := stringText , ': a pool variable in ',sharedPool name.
+ poolName := sharedPool name.
+ poolName := (poolName actionForAll:[ sharedPool browse ]).
+ stringText := stringText , ': a pool variable in ',poolName.
val := sharedPool at:sharedPoolSym.
valString := self valueStringFor:val.
^ stringText , ' (' , valString , ').'
@@ -688,6 +717,7 @@
sym := (spc name , '::' , string) asSymbolIfInterned.
sym notNil ifTrue:[
(cls := Smalltalk at:sym) isBehavior ifTrue:[
+ stringText := (stringText actionForAll:[ cls browse ]).
string := stringText , ': '.
cls name = sym ifFalse:[
string := string , 'refers to ',cls name,', '
@@ -779,10 +809,6 @@
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 |
@@ -797,6 +823,10 @@
].
].
+ stringText := string allBold.
+ "/ stringText := '''' , stringText , ''''.
+ stringText := stringText , ': '.
+
what isNil ifTrue:[
"try globals"
(Smalltalk includesKey:sym) ifTrue:[
@@ -830,6 +860,7 @@
shortText ifTrue:[
stringText := stringText , (val isLoaded ifTrue:['a'] ifFalse:['an autoloaded']).
stringText := stringText , (val isSharedPool ifTrue:[' sharedPool'] ifFalse:[' class']).
+ stringText emphasisFrom:1 to:string size add:(#actionBlock -> [ val browse ]).
^ stringText , ' in ',val package,' {' , classCategory , '}.'.
].
@@ -897,7 +928,7 @@
className := aClass name.
shortText ifTrue:[
- ^ '"here" - message lookup always starts in "%1" (always call local method).' bindWith:className
+ ^ '"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.
@@ -912,7 +943,7 @@
!
explainInstanceVariable:instVarName inClass:aClass short:shortText
- |template stringText setOfTypes|
+ |template stringText setOfTypes typesDescription|
shortText ifTrue:[
template := '%1: an instVar in %2'
@@ -927,32 +958,11 @@
"/ look for assignments
aClass withAllSubclassesDo:[:cls | self addTypesAssignedToInstvar:instVarName inClass:cls to:setOfTypes].
- "/ reduce...
- self compressSetOfTypes:setOfTypes.
- setOfTypes := setOfTypes collect:#name as:OrderedCollection.
- setOfTypes sort.
-
- "/ now make this a nice string
- 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)
- ].
- ].
- ].
- ].
+ typesDescription := self typeDescriptionFor:setOfTypes andSelector:nil.
+ typesDescription notNil ifTrue:[
+ stringText := stringText,' (',typesDescription,')'
+ ].
^ stringText
-
- "Created: / 30-04-2016 / 14:59:22 / cg"
!
explainKnownSymbol:string inClass:aClass
@@ -973,8 +983,8 @@
"try globals and pools"
(Smalltalk includesKey:sym) ifTrue:[
- expl := self explainGlobalOrPoolVariable:string inClass:aClass short:shortText.
- expl notNil ifTrue:[^ expl].
+ expl := self explainGlobalOrPoolVariable:string inClass:aClass short:shortText.
+ expl notNil ifTrue:[^ expl].
].
expl := self explainSelector:string inClass:aClass short:shortText.
@@ -999,22 +1009,22 @@
"return an explanation for the pseudoVariables self, super etc."
(string = 'self') ifTrue:[
- ^ self explainSelfIn:aClass short:shortText
+ ^ self explainSelfIn:aClass short:shortText
].
(string = 'super') ifTrue:[
- ^ self explainSuperIn:aClass short:shortText
+ ^ self explainSuperIn:aClass short:shortText
].
(string = 'here') ifTrue:[
- ^ self explainHereIn:aClass short:shortText
+ ^ 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).
+ 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
@@ -1022,28 +1032,28 @@
].
(string = 'true') ifTrue:[
- shortText ifTrue:[
- ^ '''true'' - the truth and nothing but the truth.'
- ].
- ^ 'true is a pseudo variable (i.e. it is built in).
+ 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).
+ 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).
+ 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.'
@@ -1056,27 +1066,24 @@
explainSelector:string inClass:aClass short:shortText
"return an explanation or nil"
- |sym listOfImplementingClasses listOfImplementingClassNames listOfSimilarSelectors
+ |selector listOfImplementingClasses listOfImplementingClassNames listOfSimilarSelectors
firstImplementingClassOfSimilar count tmp commonSuperClass s s2
firstImplementingClass
firstImplementingClassName secondImplementingClassName thirdImplementingClassName
classProvidingComment
cm msg t check|
- sym := string asSymbolIfInterned.
- sym isNil ifTrue:[^ nil].
+ selector := string asSymbolIfInterned.
+ selector isNil ifTrue:[^ nil].
- "
- try selectors
- look who implements it
- "
+ "/ look who implements it
listOfImplementingClassNames := Set new.
listOfImplementingClasses := Set new.
listOfSimilarSelectors := Set new.
check :=
[:sel :mthd :cls |
- sel == sym ifTrue:[
+ sel == selector ifTrue:[
listOfImplementingClasses add:cls.
listOfImplementingClassNames add:(cls name).
firstImplementingClass isNil ifTrue:[
@@ -1084,7 +1091,7 @@
firstImplementingClassName := cls name.
]
] ifFalse:[
- (sel startsWith:sym) ifTrue:[
+ (sel startsWith:selector) ifTrue:[
listOfSimilarSelectors add:sel.
firstImplementingClassOfSimilar isNil ifTrue:[
firstImplementingClassOfSimilar := cls
@@ -1102,14 +1109,14 @@
].
].
- (aClass canUnderstand:sym) ifTrue:[
- s2 := ('Instances of ''' , aClass name , ''' respond to #') , sym "allBold" , '.'.
+ (aClass canUnderstand:selector) ifTrue:[
+ s2 := ('Instances of ''' , aClass name , ''' respond to #') , selector "allBold" , '.'.
shortText ifFalse:[
s2 := '\\' , s2
, '\- inherited from ' withCRs
- , (aClass whichClassIncludesSelector:sym) name "allBold".
+ , (aClass whichClassIncludesSelector:selector) name "allBold".
].
- firstImplementingClass := (aClass whichClassIncludesSelector:sym)
+ firstImplementingClass := (aClass whichClassIncludesSelector:selector)
] ifFalse:[
s2 := ''.
].
@@ -1127,102 +1134,113 @@
tmp := ' is a selector implemented in '.
].
s := "'#' ," string allBold.
-
- (count == 1) ifTrue:[
- t := firstImplementingClassName.
- firstImplementingClass isMeta ifTrue:[
- t := 'the ' , t
+ s := s actionForAll:[ UserPreferences systemBrowserClass browseImplementorsOf:selector ].
+
+ shortText ifTrue:[
+ |typesDescription|
+
+ msg := s , tmp.
+ typesDescription := (self typeDescriptionFor:listOfImplementingClasses andSelector:selector).
+ typesDescription notNil ifTrue:[
+ msg := msg,' (',typesDescription,')'
].
- msg := s , tmp , t , '.'.
- shortText ifFalse:[
- msg := msg , s2.
- ]
] ifFalse:[
- firstImplementingClassName := listOfImplementingClassNames at:1.
- secondImplementingClassName := listOfImplementingClassNames at:2.
- (count == 2) ifTrue:[
- msg := s,tmp,firstImplementingClassName,' and ',secondImplementingClassName,'.'.
+ (count == 1) ifTrue:[
+ t := firstImplementingClassName.
+ firstImplementingClass isMeta ifTrue:[
+ t := 'the ' , t
+ ].
+ msg := s , tmp , t , '.'.
shortText ifFalse:[
msg := msg , s2.
- ].
+ ]
] ifFalse:[
- thirdImplementingClassName := listOfImplementingClassNames at:3.
- (count == 3) ifTrue:[
- msg := s,tmp,firstImplementingClassName,',',secondImplementingClassName,' and ',thirdImplementingClassName,'.'.
+ firstImplementingClassName := listOfImplementingClassNames at:1.
+ secondImplementingClassName := listOfImplementingClassNames at:2.
+ (count == 2) ifTrue:[
+ msg := s,tmp,firstImplementingClassName,' and ',secondImplementingClassName,'.'.
shortText ifFalse:[
msg := msg , s2.
].
] ifFalse:[
- false "shortText" ifTrue:[
- msg := s , tmp , count printString , ' classes'.
- commonSuperClass := Class commonSuperclassOf:listOfImplementingClassNames.
- commonSuperClass notNil ifTrue:[
- (commonSuperClass == Object
- and:[commonSuperClass includesSelector:sym]) ifTrue:[
- msg := msg , ' (including ' , 'Object' "allBold", ')'
- ] ifFalse:[
- (commonSuperClass ~= Object) ifTrue:[
- msg := msg , ' (under ' , commonSuperClass name, ')'
- ]
+ thirdImplementingClassName := listOfImplementingClassNames at:3.
+ (count == 3) ifTrue:[
+ msg := s,tmp,firstImplementingClassName,',',secondImplementingClassName,' and ',thirdImplementingClassName,'.'.
+ shortText ifFalse:[
+ msg := msg , s2.
+ ].
+ ] ifFalse:[
+ false "shortText" ifTrue:[
+ msg := s , tmp , count printString , ' classes'.
+ commonSuperClass := Class commonSuperclassOf:listOfImplementingClassNames.
+ commonSuperClass notNil ifTrue:[
+ (commonSuperClass == Object
+ and:[commonSuperClass includesSelector:selector]) ifTrue:[
+ msg := msg , ' (including ' , 'Object' "allBold", ')'
+ ] ifFalse:[
+ (commonSuperClass ~= Object) ifTrue:[
+ msg := msg , ' (under ' , commonSuperClass name, ')'
+ ]
+ ].
].
+ msg := msg , '.'.
+ ^ msg
].
- msg := msg , '.'.
- ^ msg
- ].
- "
- if there are more, look for a common
- superclass and show it ...
- "
- commonSuperClass := (Behavior commonSuperclassOf:listOfImplementingClasses) ? Object.
- (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
+ "
+ if there are more, look for a common
+ superclass and show it ...
+ "
+ commonSuperClass := (Behavior commonSuperclassOf:listOfImplementingClasses) ? Object.
+ (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:[
- msg := s , tmp, count printString , ' subclasses of ' , commonSuperClass name , s2
- ]
- ] ifFalse:[
- (commonSuperClass == Object
- and:[commonSuperClass includesSelector:sym]) ifTrue:[
- shortText ifTrue:[
- msg := s , tmp , count printString , ' classes (incl. Object)'.
- ] ifFalse:[
- msg := s , tmp , count printString , ' classes.
+ (commonSuperClass == Object
+ and:[commonSuperClass includesSelector:selector]) ifTrue:[
+ shortText ifTrue:[
+ msg := s , tmp , count printString , ' classes (incl. Object)'.
+ ] ifFalse:[
+ 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:[
- shortText ifTrue:[
- msg := s , tmp , count printString , ' classes (incl. all classes)'.
- ] ifFalse:[
- msg := s , tmp , count printString , ' classes.
+ ].
+ firstImplementingClass := Object
+ ] ifFalse:[
+ ((commonSuperClass == Behavior
+ or:[commonSuperClass == Class
+ or:[commonSuperClass == ClassDescription]])
+ and:[commonSuperClass includesSelector:selector]) ifTrue:[
+ shortText ifTrue:[
+ msg := s , tmp , count printString , ' classes (incl. all classes)'.
+ ] ifFalse:[
+ 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
+ ].
+ firstImplementingClass := commonSuperClass
+ ] ifFalse:[
+ "
+ otherwise just give the number.
+ "
+ msg := s , tmp , count printString , ' classes.' , s2
+ ]
]
]
]
- ]
+ ].
].
].
"/ look for a comment...
@@ -1233,11 +1251,15 @@
commonSuperClass := Behavior commonSuperclassOf:listOfImplementingClasses.
] .
(listOfImplementingClasses includes:commonSuperClass) ifTrue:[
- classProvidingComment := commonSuperClass
+ (commonSuperClass implements:selector) ifTrue:[
+ classProvidingComment := commonSuperClass
+ ] ifFalse:[
+ classProvidingComment := firstImplementingClass.
+ ].
].
].
classProvidingComment notNil ifTrue:[
- cm := self fetchCommentOfMethod:(classProvidingComment compiledMethodAt:sym).
+ cm := self fetchCommentOfMethod:(classProvidingComment compiledMethodAt:selector).
].
cm isNil ifTrue:[
"/ should: find the class with most subclasses from the list
@@ -1247,12 +1269,14 @@
(listOfImplementingClasses includes:Stream) ifTrue:[
classProvidingComment := Stream
] ifFalse:[
- classProvidingComment := listOfImplementingClasses detect:[:cls | (self fetchCommentOfMethod:(cls compiledMethodAt:sym)) notNil] ifNone:nil.
+ classProvidingComment := listOfImplementingClasses detect:[:cls | (self fetchCommentOfMethod:(cls compiledMethodAt:selector)) notNil] ifNone:nil.
]
].
classProvidingComment notNil ifTrue:[
- cm := self fetchCommentOfMethod:(classProvidingComment compiledMethodAt:sym).
- cm := (' %1 says: ' bindWith:classProvidingComment name),cm
+ cm := self fetchCommentOfMethod:(classProvidingComment compiledMethodAt:selector).
+ cm notNil ifTrue:[
+ cm := (' %1 says: ' bindWith:classProvidingComment name),cm
+ ].
].
].
cm notNil ifTrue:[
@@ -1303,33 +1327,33 @@
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.
+ 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.
+ 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.
+ ^ 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.'
@@ -1338,22 +1362,22 @@
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.
+ 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 == 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.
+ ^ selfString , ' refers to the object which received the message.
In this case, it will be an instance of ' , className , '
or one of its subclasses:
@@ -1378,7 +1402,7 @@
superName := aClass superclass name.
shortText ifTrue:[
- ^ '"super" - message lookup starts in superclass "%1" (call redefined method).' bindWith:superName
+ ^ '"super" - message lookup starts in superclass "%1" (call redefined method).' bindWith:superName
].
^ 'like "self", "','super'allBold,'" refers to the object which received the message.
@@ -1634,6 +1658,49 @@
"Modified: / 27-07-2013 / 10:08:57 / cg"
!
+typeDescriptionFor:setOfTypes andSelector:selectorOrNil
+ "up to 3 types are shown by name; more are simply counted"
+
+ |types numTypes
+ type1 type2 type3
+ nm1 nm2 nm3 actionForType|
+
+ "/ reduce...
+ self compressSetOfTypes:setOfTypes.
+ setOfTypes isEmpty ifTrue:[^ nil].
+
+ types := setOfTypes asOrderedCollection.
+ types sortBySelector:#name.
+
+ actionForType :=
+ [:type |
+ selectorOrNil isNil ifTrue:[
+ [Tools::NewSystemBrowser openInClass:type]
+ ] ifFalse:[
+ [Tools::NewSystemBrowser openInClass:type selector:selectorOrNil]
+ ].
+ ].
+
+ "/ now make this a nice string
+ numTypes := types size.
+ type1 := types first.
+ nm1 := type1 name actionForAll:(actionForType value:type1).
+ numTypes == 1 ifTrue:[
+ ^ nm1
+ ].
+ type2 := types second.
+ nm2 := type2 name actionForAll:(actionForType value:type2).
+ numTypes == 2 ifTrue:[
+ ^ nm1,' or ',nm2
+ ].
+ type3 := types third.
+ nm3 := type3 name actionForAll:(actionForType value:type3).
+ numTypes == 3 ifTrue:[
+ ^ nm1,', ',nm2,' or ',nm3
+ ].
+ ^ ('one of %1 classes' bindWith:numTypes) actionForAll:[Tools::NewSystemBrowser browseClasses:types].
+!
+
valueStringFor:aValue
|valString|
@@ -1674,26 +1741,27 @@
|val valClass msgSelector msgReceiver|
"/ only look for wellknown types on the right side.
- expr isConstant ifTrue:[
- val := expr evaluate.
+ expr isLiteral ifTrue:[
+ val := expr value.
valClass := val class.
val isImmutable ifTrue:[
valClass := [ valClass mutableClass ] on:Error do:[ valClass ].
].
self rememberType:valClass in:setOfTypes.
- ^ self.
+ ^ setOfTypes.
].
expr isMessage ifTrue:[
msgSelector := expr selector.
msgReceiver := expr receiver.
-
+
msgSelector == #? ifTrue:[
self addTypeOfExpressionNode:(expr arg1) forAssignmentTo:varName to:setOfTypes.
- ^ self
+ ^ setOfTypes
].
"/ really really only low hanging fruit...
- ( #(+ - * /) includes:msgSelector ) ifTrue:[
+ "/ 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:[
@@ -1701,29 +1769,45 @@
self rememberType:Number in:setOfTypes.
]
].
- ^ self.
+ ^ setOfTypes.
].
( #(// size hash identityHash) includes:msgSelector ) ifTrue:[
self rememberType:Integer in:setOfTypes.
- ^ self.
+ ^ setOfTypes.
].
-
+ ( #(next next:) includes:msgSelector ) ifTrue:[
+ |rcvrTypes|
+
+ rcvrTypes := self addTypeOfExpressionNode:msgReceiver forAssignmentTo:nil to:Set new.
+ rcvrTypes notEmpty ifTrue:[
+self halt.
+ self rememberType:Character in:setOfTypes.
+ ].
+ ^ setOfTypes.
+ ].
+ ( msgSelector startsWith:'as') ifTrue:[
+ valClass := Smalltalk classNamed:(msgSelector copyFrom:3).
+ valClass notNil ifTrue:[
+ self rememberType:valClass in:setOfTypes.
+ ^ setOfTypes.
+ ].
+ ].
( #(copy shallowCopy) includes:msgSelector ) ifTrue:[
- msgReceiver isConstant ifTrue:[
+ msgReceiver isLiteral ifTrue:[
self addTypeOfExpressionNode:msgReceiver forAssignmentTo:varName to:setOfTypes.
].
- ^ self
+ ^ setOfTypes
].
msgReceiver isGlobal ifTrue:[
|globalValue|
- globalValue := msgReceiver evaluate.
+ globalValue := msgReceiver value.
globalValue isBehavior ifTrue:[
( #(new new: basicNew basicNew:) includes:msgSelector ) ifTrue:[
self rememberType:globalValue in:setOfTypes.
- ^ self.
+ ^ setOfTypes.
].
].
self breakPoint:#cg.
@@ -1731,7 +1815,8 @@
self breakPoint:#cg.
]
].
-
+ ^ setOfTypes
+
"Created: / 30-04-2016 / 15:28:59 / cg"
"Modified: / 30-04-2016 / 20:17:35 / cg"
!
@@ -1756,7 +1841,7 @@
This is far from being complete, but gives a hint good enough for code completion
and info in the browser."
- |tree visitor|
+ |tree|
"/ quick check (avoids expensive parse)
(code includesString:instVarName) ifFalse:[ ^ self ].
@@ -1764,6 +1849,30 @@
tree := Parser parse:code class:aClass.
(tree isNil or:[tree == #Error]) ifTrue:[ ^ self ]. "/ unparsable
+ self addTypesAssignedToInstvar:instVarName inTree:tree to:setOfTypes.
+
+ "Created: / 30-04-2016 / 15:09:18 / cg"
+!
+
+addTypesAssignedToInstvar:instVarName inClass:aClass to:setOfTypes
+ "look to asssignments to an instance variable, and pick up low hanging class information.
+ This is far from being complete, but gives a hint good enough for code completion
+ and info in the browser."
+
+ aClass methodDictionary do:[:m |
+ self addTypesAssignedToInstvar:instVarName inClass:aClass method:m to:setOfTypes
+ ].
+
+ "Created: / 30-04-2016 / 14:52:56 / cg"
+!
+
+addTypesAssignedToInstvar:instVarName inTree:tree to:setOfTypes
+ "look to asssignments to an instance variable, and pick up low hanging class information.
+ This is far from being complete, but gives a hint good enough for code completion
+ and info in the browser."
+
+ |visitor|
+
visitor := PluggableParseNodeVisitor new.
visitor
actionForNodeClass:AssignmentNode
@@ -1778,20 +1887,47 @@
true "/ yes - visit subnodes
].
visitor visit:tree.
-
- "Created: / 30-04-2016 / 15:09:18 / cg"
!
-addTypesAssignedToInstvar:instVarName inClass:aClass to:setOfTypes
+addTypesAssignedToLocal:localName inTree:tree to:setOfTypes
"look to asssignments to an instance variable, and pick up low hanging class information.
This is far from being complete, but gives a hint good enough for code completion
and info in the browser."
- aClass methodDictionary do:[:m |
- self addTypesAssignedToInstvar:instVarName inClass:aClass method:m to:setOfTypes
- ].
+ |visitor|
+
+ "/ hack, allowing to deal with both types of AST (sigh)
+ (tree isKindOf:RBProgramNode) ifTrue:[
+ visitor := RBPluggableProgramNodeVisitor new.
+ visitor
+ actionForNodeClass:RBAssignmentNode
+ put:[:node |
+ |leftSide expr|
- "Created: / 30-04-2016 / 14:52:56 / cg"
+ leftSide := node variable.
+ (leftSide isTemporary and:[ leftSide name = localName ]) ifTrue:[
+ expr := node value.
+ self addTypeOfExpressionNode:expr forAssignmentTo:localName to:setOfTypes
+ ].
+ true "/ yes - visit subnodes
+ ].
+ visitor visitNode:tree.
+ ] ifFalse:[
+ visitor := PluggableParseNodeVisitor new.
+ visitor
+ actionForNodeClass:AssignmentNode
+ put:[:node |
+ |leftSide expr|
+
+ leftSide := node variable.
+ (leftSide isLocalVariable and:[ leftSide name = localName ]) ifTrue:[
+ expr := node expression.
+ self addTypeOfExpressionNode:expr forAssignmentTo:localName to:setOfTypes
+ ].
+ true "/ yes - visit subnodes
+ ].
+ visitor visit:tree.
+ ].
!
addTypesOfInstvar:instVarName inClass:aClass fromExistingInstancesTo:setOfTypes
@@ -1866,6 +2002,7 @@
"Modified: / 30-04-2016 / 20:05:09 / cg"
! !
+
!Explainer class methodsFor:'documentation'!
version