# HG changeset patch # User Jan Vrany # Date 1462858745 -7200 # Node ID 4f9db2d4c2b70865a20672fb8338be362cf9da6e # Parent 707275c1f86d30b72abe6d74b92846e393657c95# Parent eaf3615351672977496195b9cc9975c77832dd7e Merge diff -r 707275c1f86d -r 4f9db2d4c2b7 Explainer.st --- a/Explainer.st Mon May 09 21:50:46 2016 +0200 +++ b/Explainer.st Tue May 10 07:39:05 2016 +0200 @@ -519,7 +519,7 @@ (lines size > 1) ifTrue:[ methodComment := methodComment , ' ...' ]. - ^ ('"' , methodComment , '"') colorizeAllWith:(UserPreferences current commentColor). + ^ ('"' , methodComment , '"') withColor:(UserPreferences current commentColor). "Created: / 14-09-2006 / 14:11:58 / cg" "Modified (comment): / 30-04-2016 / 16:17:18 / cg" @@ -897,7 +897,7 @@ doc := doc copyTo:25. doc add:''; add:' ... '. ]. - doc := doc asString colorizeAllWith:(UserPreferences current commentColor). + doc := doc asString withColor:(UserPreferences current commentColor). explanation := explanation,'\\' withCRs,val name,'''s documentation:\'withCRs, doc ]. ^ explanation. @@ -2148,65 +2148,6 @@ withColor:(Color blue) ! -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 classes sortedByName classNames - link1 link2 link3 link4| - - aCollectionOfClasses isEmpty ifTrue:[ - ^ 'No %1classes' bindWith:prefix. - ]. - - classes := aCollectionOfClasses asIdentitySet asOrderedCollection. - classNames := classes collect:[:each | each theNonMetaclass name]. - - nClassNames := classNames size. - - nClassNames <= 4 ifTrue:[ - sortedByName := classNames sortWith:classes. - - link1 := self asLink:classNames first "allBold" to:(self actionToBrowseClass:classes first). - nClassNames == 1 ifTrue:[ - ^ '%2' "'1 %1class: %2'" - bindWith:prefix - with:link1. - ]. - link2 := self asLink:classNames second "allBold" to:(self actionToBrowseClass:classes second). - nClassNames == 2 ifTrue:[ - ^ '%2 and %3' "'2 %1classes: %2 and %3'" - bindWith:prefix - with:link1 - with:link2. - ]. - link3 := self asLink:classNames third "allBold" to:(self actionToBrowseClass:classes third). - nClassNames == 3 ifTrue:[ - ^ '%2, %3 and %4' "'3 %1classes: %2, %3 and %4'" - bindWith:prefix - with:link1 - with:link2 - with:link3. - ]. - link4 := self asLink:classNames fourth "allBold" to:(self actionToBrowseClass:classes fourth). - nClassNames == 4 ifTrue:[ - ^ '%2, %3, %4 and %5' "'4 %1classes: %2, %3, %4 and %5'" - bindWith:prefix - with:link1 - with:link2 - with:link3 - with:link4. - ]. - ]. - ^ self asLink:('%1 %2classes' bindWith:(nClassNames printString "allBold") with:prefix) - to:(self actionToBrowseClasses:classes) - - "Modified: / 27-07-2006 / 10:09:02 / cg" -! - infoStringForMethods:aCollectionOfMethods withPrefix:prefix "get a nice user readable list for some methods. Up to 3 are named, otherwise the count is presented. @@ -2261,95 +2202,6 @@ " ! -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 selector mthd selectorString| - - methodsClass := aMethod mclass. - methodsClass isNil ifTrue:[^ nil]. - - methodsSuperclass := methodsClass superclass. - methodsSuperclass isNil ifTrue:[^ nil]. - - selector := aMethod selector. - selector isNil ifTrue:[^ nil]. - - inheritedClass := methodsSuperclass whichClassIncludesSelector:selector. - inheritedClass isNil ifTrue:[^ nil]. - - mthd := inheritedClass compiledMethodAt:selector. - - (mthd sends:#'subclassResponsibility') ifTrue:[ - msg := '%1 overrides subclassResponsibility in %2'. - ] ifFalse:[ - msg := '%1 overrides implementation in %2'. - ]. - selectorString := selector contractTo:30. - ^ msg - bindWith:(self asLink:selectorString "allBold" to:(self actionToOpenMethodFinderFor:selector)) - with:(self asLink:inheritedClass name "allBold" - to:(self actionToBrowseClass:inheritedClass selector:selector)) -! - -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. @@ -2370,25 +2222,6 @@ ]. ! -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)'. - ]. - ]. - ^ nil -! - thisOrNewBrowserInto:aTwoArgBlock "if I am invoked by a browser, invoke the twoArgBlock withit and an #newBuffer arg. diff -r 707275c1f86d -r 4f9db2d4c2b7 InstrumentingCompiler.st --- a/InstrumentingCompiler.st Mon May 09 21:50:46 2016 +0200 +++ b/InstrumentingCompiler.st Tue May 10 07:39:05 2016 +0200 @@ -593,7 +593,7 @@ source := owningMethod source asText. startPosition isNil ifTrue:[ - source colorizeAllWith: Color red. + source withColor: Color red. ] ifFalse:[ endPosition isNil ifTrue:[ source emphasizeFrom:startPosition to:source string size with: #bold. @@ -1179,10 +1179,10 @@ !InstrumentingCompiler class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libcomp/InstrumentingCompiler.st,v 1.35 2015-02-13 21:03:04 vrany Exp $' + ^ '$Header$' ! version_CVS - ^ '$Header: /cvs/stx/stx/libcomp/InstrumentingCompiler.st,v 1.35 2015-02-13 21:03:04 vrany Exp $' + ^ '$Header$' ! ! diff -r 707275c1f86d -r 4f9db2d4c2b7 TextCollectingCompilationErrorHandler.st --- a/TextCollectingCompilationErrorHandler.st Mon May 09 21:50:46 2016 +0200 +++ b/TextCollectingCompilationErrorHandler.st Tue May 10 07:39:05 2016 +0200 @@ -11,6 +11,8 @@ " "{ Package: 'stx:libcomp' }" +"{ NameSpace: Smalltalk }" + CompilationErrorHandler subclass:#TextCollectingCompilationErrorHandler instanceVariableNames:'lines collectWarnings' classVariableNames:'' @@ -58,7 +60,7 @@ aCompiler classToCompileFor name , '>>', (aCompiler selector ? '???') - , '] ' , (aMessage allBold colorizeAllWith:Color red darkened)). + , '] ' , (aMessage allBold withColor:Color red darkened)). "Created: / 02-11-2010 / 12:52:23 / cg" "Modified: / 03-11-2010 / 12:28:49 / cg" @@ -92,5 +94,6 @@ !TextCollectingCompilationErrorHandler class methodsFor:'documentation'! version_CVS - ^ '$Header: /cvs/stx/stx/libcomp/TextCollectingCompilationErrorHandler.st,v 1.6 2010-11-03 11:31:30 cg Exp $' + ^ '$Header$' ! ! +