--- a/extensions.st Tue May 03 06:42:52 2016 +0200
+++ b/extensions.st Wed May 04 06:51:10 2016 +0200
@@ -872,6 +872,169 @@
^ self printStringForBrowserWithSelector:selector inClass:nil
! !
+!Explainer class methodsFor:'utilities'!
+
+infoStringForClasses:aCollectionOfClasses withPrefix:prefix
+ "get a nice user readable list for some classes.
+ Up to 4 are named, otherwise the count is presented.
+ The prefix can be sth like ' other', ' sub', ' super',
+ ' implementing' etc. Or it can be an empty string.
+ To be shown in the info line at the bottom."
+
+ |nClassNames sortedByName classNames|
+
+ aCollectionOfClasses isEmpty ifTrue:[
+ ^ 'No %1classes' bindWith:prefix.
+ ].
+
+ classNames := aCollectionOfClasses asIdentitySet asOrderedCollection collect:[:each | each theNonMetaclass name].
+
+ nClassNames := classNames size.
+
+ nClassNames <= 4 ifTrue:[
+ nClassNames == 1 ifTrue:[
+ ^ '%2' "'1 %1class: %2'" bindWith:prefix with:(classNames first allBold).
+ ].
+ sortedByName := classNames sort.
+ nClassNames == 2 ifTrue:[
+ ^ '%2 and %3' "'2 %1classes: %2 and %3'" bindWith:prefix
+ with:(sortedByName first allBold)
+ with:(sortedByName second allBold).
+ ].
+ nClassNames == 3 ifTrue:[
+ ^ '%2, %3 and %4' "'3 %1classes: %2, %3 and %4'" bindWith:prefix
+ with:(sortedByName first allBold)
+ with:(sortedByName second allBold)
+ with:(sortedByName third allBold).
+ ].
+ nClassNames == 4 ifTrue:[
+ ^ '%2, %3, %4 and %5' "'4 %1classes: %2, %3, %4 and %5'" bindWith:prefix
+ with:(sortedByName first allBold)
+ with:(sortedByName second allBold)
+ with:(sortedByName third allBold)
+ with:(sortedByName fourth allBold).
+ ].
+ ].
+ ^ '%1 %2classes' bindWith:nClassNames printString allBold with:prefix
+
+ "Modified: / 27-07-2006 / 10:09:02 / cg"
+! !
+
+!Explainer class methodsFor:'utilities'!
+
+methodImplementorsInfoFor:aMethod
+ "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
+! !
+
+!Explainer class methodsFor:'utilities'!
+
+methodInheritanceInfoFor:aMethod
+ |methodsSuperclass inheritedClass msg methodsClass sel mthd|
+
+ 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.
+ msg := (sel contractTo:30) allBold.
+ (mthd sends:#'subclassResponsibility') ifTrue:[
+ msg := msg , ' overrides subclassResponsibility in '.
+ ] ifFalse:[
+ msg := msg , ' overrides implementation in '.
+ ].
+ msg := msg , inheritedClass name allBold.
+ "/ msg := msg , '.'.
+ ].
+
+ ^ msg
+! !
+
+!Explainer class methodsFor:'utilities'!
+
+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
+! !
+
+!Explainer class methodsFor:'utilities'!
+
+methodSpecialInfoFor:aMethod
+ "handles special cases - such as documentation methods"
+
+ |cls sel|
+
+ cls := aMethod mclass.
+ cls isNil ifTrue:[^ nil].
+ sel := aMethod selector.
+ cls 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)'.
+ ].
+ ].
+ ^ nil
+! !
+
!Filename methodsFor:'debugging'!
inspector2TabContentsView