#UI_ENHANCEMENT by cg
class: Explainer
changed:
#methodInheritanceInfoFor:
#methodSpecialInfoFor:
--- 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.