Explainer.st
changeset 3871 3c8741b74ab9
parent 3868 7be5e57bd1dd
child 3872 446f75051730
--- 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.