#UI_ENHANCEMENT by cg
authorClaus Gittinger <cg@exept.de>
Wed, 11 May 2016 01:34:38 +0200
changeset 3867 f3ee89e69ba3
parent 3866 3f2dd51c8a76
child 3868 7be5e57bd1dd
child 3875 45c02b9a43a0
#UI_ENHANCEMENT by cg class: Explainer changed: #methodInheritanceInfoFor: #methodSpecialInfoFor:
Explainer.st
--- a/Explainer.st	Wed May 11 01:32:42 2016 +0200
+++ b/Explainer.st	Wed May 11 01:34:38 2016 +0200
@@ -2339,6 +2339,93 @@
     "
 !
 
+methodImplementorsInfoFor:aMethod inEnvironment:environment
+    "get something about the implementors of aMethod
+     to be shown in the info line at the bottom"
+
+    |implementors msg senders msg2|
+
+    implementors := SystemBrowser
+        findImplementorsOf:aMethod selector
+        in:(environment allClasses)
+        ignoreCase:false.
+
+    implementors notEmpty ifTrue:[
+        msg := 'Only implemented here.'.
+        implementors remove:aMethod ifAbsent:nil.
+        implementors notEmpty ifTrue:[
+            implementors := implementors collect:[:mthd | mthd mclass ? mthd getMclass].
+            implementors notEmpty ifTrue:[
+                msg := 'Also implemented in '.
+                msg := msg , (self infoStringForClasses:implementors withPrefix:'other ').
+                msg := msg , '.'.
+            ]
+        ].
+    ].
+
+false ifTrue:[  "/ too slow
+    senders := SystemBrowser
+        findSendersOf:aMethod selector
+        in:(environment allClasses)
+        ignoreCase:false.
+    senders notEmpty ifTrue:[
+        msg2 := 'Sent from ' , senders size printString, ' methods.'.
+    ] ifFalse:[
+        msg2 := 'No senders.'.
+    ].
+    msg := msg , '/' , msg2
+].
+
+    ^ msg
+!
+
+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" to:(self actionToOpenMethodFinderFor:sel)) 
+            with:(self asLink:inheritedClass name "allBold" 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|
+
+    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').
+        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.
@@ -2359,6 +2446,28 @@
     ].
 !
 
+methodSpecialInfoFor:aMethod
+    "handles special cases - such as documentation methods"
+
+    |cls sel|
+
+    (cls := aMethod mclass) isNil ifTrue:[^ nil].
+    (sel := aMethod selector) isNil ifTrue:[^ nil].
+
+    cls isMeta ifTrue:[
+        (AbstractSourceCodeManager isVersionMethodSelector:sel) ifTrue:[
+            ^ 'The version method is required for the source code repository - do not modify.'.
+        ].
+        sel == #documentation ifTrue:[
+            ^ 'ST/X stores documentation in this method (not in comment slots)'.
+        ].
+        sel == #copyright ifTrue:[
+            ^ 'By convention, the copyright method consists of a copyright as comment'
+        ].
+    ].
+    ^ nil
+!
+
 thisOrNewBrowserInto:aTwoArgBlock
     "if I am invoked by a browser, 
      invoke the twoArgBlock withit and an #newBuffer arg.