--- a/Explainer.st Sun May 08 03:34:07 2016 +0200
+++ b/Explainer.st Sun May 08 12:51:05 2016 +0200
@@ -158,7 +158,7 @@
^ '%1 is NOWHERE impemented.' bindWith:boldSelectorString
].
- selectorString := selectorString actionForAll:(self actionToBrowseImplementorsOf:selector).
+ selectorString := self asLink:selectorString to:(self actionToBrowseImplementorsOf:selector).
boldSelectorString := selectorString "allBold".
recClassSet := self guessPossibleImplementorClassesFor:(node receiver) in:code forClass:cls.
@@ -250,9 +250,9 @@
implClass := implementingClasses anElement.
implMethod := implClass compiledMethodAt:selector.
clsName := implClass name.
- clsName := clsName actionForAll:(self actionToBrowseClass:implClass selector:selector).
+ clsName := self asLink:clsName to:(self actionToBrowseClass:implClass selector:selector).
info := '%1 >> %2' bindWith:clsName "allBold" with:selectorString.
- info := info actionForAll:(self actionToBrowseClass:implClass selector:selector).
+ info := self asLink:info to:(self actionToBrowseClass:implClass selector:selector).
implMethodComment := self fetchCommentOfMethod:implMethod.
implMethodComment notNil ifTrue:[
@@ -304,23 +304,22 @@
explainMethodNode:node in:code forClass:cls short:short interval:intervalIfKnown
|srchClass selector selectorString implClass
- "sendingMethods numSendingMethods sendingClasses" boldSelectorString|
+ "sendingMethods numSendingMethods sendingClasses" |
selector := node selector.
selector := selector asSymbolIfInterned. "/ avoid creating new symbols.
selectorString := selector printString contractTo:50.
- boldSelectorString := selectorString "allBold".
(srchClass := cls superclass) notNil ifTrue:[
implClass := srchClass whichClassIncludesSelector:selector.
implClass notNil ifTrue:[
^ '%1 overrides implementation in %2.'
- bindWith:boldSelectorString
- with:(implClass name "allBold" actionForAll:(self actionToBrowseClass:implClass selector:selector))
+ bindWith:(self asLink:selectorString "allBold" to:(self actionToOpenMethodFinderFor:selector))
+ with:(self asLink:implClass name "allBold" to:(self actionToBrowseClass:implClass selector:selector))
].
].
(cls includesSelector:selector) ifFalse:[
- ^ '%1: a new method.' bindWith:boldSelectorString
+ ^ '%1: a new method.' bindWith:selectorString "allBold"
].
"/
"/ sendingMethods := SystemBrowser
@@ -663,7 +662,7 @@
c isMeta ifTrue:[
clsName := c theNonMetaclass name.
shortText ifTrue:[
- clsName := (clsName actionForAll:(self actionToBrowseClass:c)).
+ clsName := self asLink:clsName to:(self actionToBrowseClass:c).
stringText := stringText , ': a class instVar in ' , clsName
] ifFalse:[
stringText := stringText, ': a class instance variable inherited from ' , clsName
@@ -681,7 +680,7 @@
c notNil ifTrue:[
clsName := c name.
shortText ifTrue:[
- clsName := (clsName actionForAll:(self actionToBrowseClass:c)).
+ clsName := self asLink:clsName to:(self actionToBrowseClass:c).
stringText := stringText , ': a classVar in ' , clsName
] ifFalse:[
stringText := stringText , ': a class variable in ' , clsName
@@ -697,7 +696,7 @@
c privateClasses do:[:pClass |
(pClass name = string
or:[pClass nameWithoutPrefix = string]) ifTrue:[
- stringText := (stringText actionForAll:(self actionToBrowseClass:pClass)).
+ stringText := self asLink:stringText to:(self actionToBrowseClass:pClass).
stringText := stringText , ': a private class in ''' , c name , '''.'.
shortText ifFalse:[
stringText := (stringText , '\\It is only visible locally.') withCRs
@@ -718,7 +717,7 @@
].
(sharedPool includesKey:sharedPoolSym) ifTrue:[
poolName := sharedPool name.
- poolName := (poolName actionForAll:(self actionToBrowseClass:sharedPool)).
+ poolName := self asLink:poolName to:(self actionToBrowseClass:sharedPool).
stringText := stringText , ': a pool variable in ',poolName.
val := sharedPool at:sharedPoolSym.
valString := self valueStringFor:val.
@@ -733,7 +732,7 @@
sym := (spc name , '::' , string) asSymbolIfInterned.
sym notNil ifTrue:[
(cls := Smalltalk at:sym) isBehavior ifTrue:[
- stringText := (stringText actionForAll:(self actionToBrowseClass:cls)).
+ stringText := self asLink:stringText to:(self actionToBrowseClass:cls).
string := stringText , ': '.
cls name = sym ifFalse:[
string := string , 'refers to ',cls name,', '
@@ -966,8 +965,8 @@
shortText ifTrue:[
template := '%1: an instVar in %2'.
- varNameInText := varNameInText actionForAll:(self actionToBrowseInstvarRefsTo:instVarName inClass:aClass).
- classNameInText := classNameInText actionForAll:(self actionToBrowseClass:aClass).
+ varNameInText := self asLink:varNameInText to:(self actionToBrowseInstvarRefsTo:instVarName inClass:aClass).
+ classNameInText := self asLink:classNameInText to:(self actionToBrowseClass:aClass).
] ifFalse:[
template := '%1: an instance variable in %2'
].
@@ -1156,9 +1155,9 @@
].
s := string allBold.
count > 1 ifTrue:[
- s := s actionForAll:(self actionToOpenMethodFinderFor:selector).
+ s := self asLink:s to:(self actionToOpenMethodFinderFor:selector).
] ifFalse:[
- s := s actionForAll:(self actionToBrowseImplementorsOf:selector).
+ s := self asLink:s to:(self actionToBrowseImplementorsOf:selector).
].
shortText ifTrue:[
@@ -1710,18 +1709,18 @@
"/ now make this a nice string
numTypes := types size.
type1 := types first.
- nm1 := type1 name actionForAll:(self actionToBrowseClass:type1 selector:selectorOrNil).
+ nm1 := self asLink:type1 name to:(self actionToBrowseClass:type1 selector:selectorOrNil).
numTypes == 1 ifTrue:[
^ nm1
].
type2 := types second.
- nm2 := type2 name actionForAll:(self actionToBrowseClass:type2 selector:selectorOrNil).
+ nm2 := self asLink:type2 name to:(self actionToBrowseClass:type2 selector:selectorOrNil).
numTypes == 2 ifTrue:[
^ nm1,' ',wordbetween,' ',nm2
].
type3 := types third.
- nm3 := type3 name actionForAll:(self actionToBrowseClass:type3 selector:selectorOrNil).
+ nm3 := self asLink:type3 name to:(self actionToBrowseClass:type3 selector:selectorOrNil).
numTypes == 3 ifTrue:[
^ nm1,', ',nm2,' ',wordbetween,' ',nm3
].
@@ -1729,7 +1728,7 @@
"/ selectorOrNil notNil ifTrue:[
"/ link := self actionToOpenMethodFinderFor:selectorOrNil.
"/ ].
- ^ ('%1 classes' bindWith:numTypes) actionForAll:link.
+ ^ self asLink:('%1 classes' bindWith:numTypes) to:link.
!
valueStringFor:aValue
@@ -2078,28 +2077,15 @@
!
actionToBrowseClass:class selector:selectorOrNil
- selectorOrNil notNil ifTrue:[
- ^ [
- self thisOrNewBrowserInto:[:browser :openHow |
- browser
- spawnFullBrowserInClass:class selector:selectorOrNil in:openHow
+ ^ [
+ self thisOrNewBrowserInto:[:browser :openHow |
+ browser
+ spawnFullBrowserInClass:class selector:selectorOrNil in:openHow
"/ spawnMethodBrowserFor:{class compiledMethodAt:selectorOrNil}
"/ in:openHow
"/ label:nil
- ]
]
].
- ^ self actionToBrowseClasses:{ class }
-"/ ^ [
-"/ self thisOrNewBrowserInto:[:browser :openHow |
-"/ browser
-"/ spawnBrowserOnClass:class
-"/ ]
-"/ ]
-"/ selectorOrNil isNil ifTrue:[
-"/ ^ [Tools::NewSystemBrowser openInClass:class]
-"/ ].
-"/ ^ [Tools::NewSystemBrowser openInClass:class selector:selectorOrNil]
!
actionToBrowseClasses:classes
@@ -2150,8 +2136,13 @@
cls := Smalltalk classNamed:nameOfClass string asUppercaseFirst.
cls isNil ifTrue:[^ nameOfClass].
-
- ^ nameOfClass actionForAll:(self actionToBrowseClass:cls)
+
+ self asLink:nameOfClass to:(self actionToBrowseClass:cls)
+!
+
+asLink:aString to:action
+ ^ (aString actionForAll:action)
+ withColor:(Color blue)
!
infoStringForMethods:aCollectionOfMethods withPrefix:prefix
@@ -2226,6 +2217,28 @@
] ifFalse:[
^ 'No senders.'.
].
+!
+
+thisOrNewBrowserInto:aTwoArgBlock
+ "if I am invoked by a browser,
+ invoke the twoArgBlock withit and an #newBuffer arg.
+ Otherwise, create a new (invisible) browser and pass it to the block
+ with a #newBrowser arg."
+
+ |windowGroupClass browserClass wg app|
+
+ "/ stupid: I am in libcomp; should be in libtool
+ windowGroupClass := Smalltalk at:#WindowGroup.
+ windowGroupClass isNil ifTrue:[^ self].
+ browserClass := Smalltalk at:#'Tools::NewSystemBrowser'.
+ browserClass isNil ifTrue:[^ self].
+
+ ((wg := windowGroupClass activeGroup) notNil
+ and:[ (app := wg application) isKindOf:browserClass ]
+ ) ifTrue:[
+ ^ aTwoArgBlock value:app value:#newBuffer
+ ].
+ ^ aTwoArgBlock value:(browserClass basicNew) value:#newBrowser
! !
!Explainer class methodsFor:'documentation'!