diff -r 41f056db1b83 -r bc62fb9a8df6 extensions.st --- 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