Merge jv
authorJan Vrany <jan.vrany@fit.cvut.cz>
Tue, 10 May 2016 07:39:05 +0200
branchjv
changeset 3874 4f9db2d4c2b7
parent 3873 707275c1f86d (current diff)
parent 3864 eaf361535167 (diff)
child 3875 45c02b9a43a0
Merge
Explainer.st
InstrumentingCompiler.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:'   ... <more documentation cut off>'.
                 ].
-                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.
--- 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$'
 ! !
 
--- 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$'
 ! !
+