preps for SmallTeam
authorClaus Gittinger <cg@exept.de>
Fri, 10 Nov 2006 17:57:10 +0100
changeset 7504 34ab937df8de
parent 7503 2bfbc25a5601
child 7505 e364eb9079fe
preps for SmallTeam
Tools_ClassCategoryList.st
--- a/Tools_ClassCategoryList.st	Fri Nov 10 17:57:04 2006 +0100
+++ b/Tools_ClassCategoryList.st	Fri Nov 10 17:57:10 2006 +0100
@@ -498,7 +498,7 @@
             ^ Iterator on:[:whatToDo |
                                Smalltalk allClassesDo:[:cls |
                                    cls isLoaded ifTrue:[
-                                       (cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
+                                       (cls isRealNameSpace not) ifTrue:[
                                            (nameSpaceFilter isNil
                                            or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
                                                (packageFilter isNil
@@ -513,7 +513,7 @@
         ].
         ^ Iterator on:[:whatToDo | 
                            Smalltalk allClassesDo:[:cls |
-                               (cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
+                               (cls isRealNameSpace not) ifTrue:[
                                     (nameSpaceFilter isNil
                                     or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
                                         (packageFilter isNil
@@ -530,7 +530,7 @@
                        Smalltalk allClassesDo:[:cls | |cat|
                            (hideUnloadedClasses not or:[cls isLoaded]) 
                            ifTrue:[
-                               (cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
+                               (cls isRealNameSpace not) ifTrue:[
                                    cat := cls category ? '* no category *'.
                                    (cats includes:cat) ifTrue:[
                                        (nameSpaceFilter isNil
@@ -546,8 +546,8 @@
                        ]
                   ]
 
-    "Created: / 5.2.2000 / 13:42:12 / cg"
-    "Modified: / 18.8.2000 / 15:52:41 / cg"
+    "Created: / 05-02-2000 / 13:42:12 / cg"
+    "Modified: / 10-11-2006 / 17:13:26 / cg"
 ! !
 
 !ClassCategoryList methodsFor:'private'!
@@ -569,7 +569,8 @@
 
 listOfCategories
     |categories hideUnloadedClasses generator nameSpaceFilter packageFilter allName
-     categoriesWithExtensions categoriesWithChangedCode classesInChangeSet|
+     categoriesWithExtensions categoriesWithChangedCode categoriesWithRemoteChangedCode
+     classesInChangeSet classesInRemoteChangeSet|
 
     allName := self class nameListEntryForALL.
 
@@ -586,10 +587,14 @@
     categories := Set new.
     categoriesWithExtensions := Set new.
     categoriesWithChangedCode := Set new.
+    categoriesWithRemoteChangedCode := Set new.
 
     classesInChangeSet := ChangeSet current changedClasses.
     classesInChangeSet := classesInChangeSet collect:[:eachClass | eachClass theNonMetaclass].
 
+    classesInRemoteChangeSet := SmallTeam isNil ifTrue:[#()] ifFalse:[ SmallTeam changedClasses ].
+    classesInRemoteChangeSet := classesInRemoteChangeSet collect:[:each | each theNonMetaclass].
+
     classes := IdentitySet new.
     inGeneratorHolder isNil ifTrue:[
         Smalltalk allClassesDo:[:cls | 
@@ -597,7 +602,7 @@
 
             (hideUnloadedClasses not or:[cls isLoaded])
             ifTrue:[
-                (cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
+                (cls isRealNameSpace not) ifTrue:[
                     (nameSpaceFilter isNil
                     or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
                         (packageFilter isNil
@@ -609,10 +614,12 @@
 
                             (classesInChangeSet includes:cls theNonMetaclass) ifTrue:[
                                 categoriesWithChangedCode add:cat
-                            ] ifFalse:[
-                                cls hasExtensions ifTrue:[
-                                    categoriesWithExtensions add:cat
-                                ]
+                            ].
+                            (classesInRemoteChangeSet includes:cls theNonMetaclass) ifTrue:[
+                                categoriesWithRemoteChangedCode add:cat
+                            ].
+                            cls hasExtensions ifTrue:[
+                                categoriesWithExtensions add:cat
                             ].
                         ]
                     ]
@@ -646,7 +653,11 @@
                      "/ cannot add a + here - need separate list for presentation and filter
                      "/ cat , (self colorizeForDifferentPackage:self stringForExtensions)
                 ] ifFalse:[
-                     cat
+                    (categoriesWithRemoteChangedCode includes:cat) ifTrue:[
+                         (self colorizeForChangedCodeInSmallTeam:cat copy asText).
+                    ] ifFalse:[
+                        cat
+                    ]
                 ]
             ]
         ].
@@ -659,7 +670,7 @@
     ^ categories
 
     "Created: / 05-02-2000 / 13:42:12 / cg"
-    "Modified: / 23-08-2006 / 11:40:45 / cg"
+    "Modified: / 10-11-2006 / 17:43:19 / cg"
 !
 
 listView 
@@ -813,5 +824,5 @@
 !ClassCategoryList class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.17 2006-10-18 11:11:29 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.18 2006-11-10 16:57:10 cg Exp $'
 ! !