--- a/Explainer.st Thu May 12 17:27:13 2016 +0200
+++ b/Explainer.st Thu May 12 17:32:38 2016 +0200
@@ -2338,6 +2338,68 @@
"
!
+methodInheritanceInfoFor:aMethod
+ |methodsSuperclass inheritedClass msg methodsClass sel mthd selectorString|
+
+ methodsClass := aMethod mclass.
+ methodsClass isNil ifTrue:[^ nil].
+
+ methodsSuperclass := methodsClass superclass.
+ methodsSuperclass isNil ifTrue:[^ nil].
+
+ sel := aMethod selector.
+ inheritedClass := methodsSuperclass whichClassIncludesSelector:sel.
+ inheritedClass notNil ifTrue:[
+ mthd := inheritedClass compiledMethodAt:sel.
+ (mthd sends:#'subclassResponsibility') ifTrue:[
+ msg := '%1 overrides subclassResponsibility in %2'.
+ ] ifFalse:[
+ msg := '%1 overrides implementation in %2'.
+ ].
+ selectorString := sel contractTo:30.
+ ^ msg
+ bindWith:(self
+ asLink:selectorString "allBold"
+ info:('Browse all implementors of %1' bindWith:selectorString)
+ to:(self actionToOpenMethodFinderFor:sel))
+ with:(self
+ asLink:inheritedClass name "allBold"
+ info:('Browse %1 » %2' bindWith:inheritedClass name with:sel)
+ to:(self actionToBrowseClass:inheritedClass selector:sel)).
+ ].
+
+ ^ msg
+!
+
+methodRedefinitionInfoFor:aMethod
+ "return a user readable string telling in how many subclasses
+ a method is redefined.
+ To be shown in the info line of a browser"
+
+ |redefiningClasses msg cls foo|
+
+ cls := aMethod mclass.
+ cls isNil ifTrue:[^ nil].
+
+ redefiningClasses := cls allSubclasses select:[:cls | cls includesSelector:aMethod selector. ].
+ redefiningClasses size > 0 ifTrue:[
+ msg := 'redefined in '.
+ msg := msg , (self
+ infoStringForClasses:redefiningClasses
+ withPrefix:'sub'
+ actionGenerator:[:classes |
+ |cls|
+ cls := classes first.
+ self
+ actionToBrowseClass:cls
+ selector:aMethod selector
+ info:('Browse implementation in %1' bindWith:cls name)]).
+ msg := msg , '.'.
+ ].
+
+ ^ msg
+!
+
methodSendersInfoFor:selector inEnvironment:environment
"get something about the senders of a message.
to be shown in the info line at the bottom.