Tools_ClassCategoryList.st
changeset 8751 2cd8c5f2536c
parent 8748 5abc96ba76eb
child 9005 897d90c333e7
--- a/Tools_ClassCategoryList.st	Tue Sep 22 12:24:09 2009 +0200
+++ b/Tools_ClassCategoryList.st	Tue Sep 22 12:30:25 2009 +0200
@@ -412,15 +412,14 @@
     |categoryOfClass|
 
     changedObject == Smalltalk ifTrue:[
-        something == #methodInClass ifTrue:[
+        (something == #methodInClass 
+        or:[ something == #classComment
+        or:[ something == #methodDictionary
+        or:[ something == #methodTrap
+        or:[ something == #methodInClassRemoved ]]]]) ifTrue:[
             ^ self
         ].
-        something == #classComment ifTrue:[
-            ^ self.
-        ].
-        something == #methodDictionary ifTrue:[
-            ^ self 
-        ].
+
         (something == #classVariables
         or:[something == #classDefinition]) ifTrue:[
             categoryOfClass := aParameter category.
@@ -429,12 +428,6 @@
                 self updateOutputGenerator.                
             ].
         ].
-        something == #methodTrap ifTrue:[
-            ^ self
-        ].
-        something == #methodInClassRemoved ifTrue:[
-            ^ self
-        ].
     ].
 
 "/    changedObject == ChangeSet ifTrue:[
@@ -513,7 +506,8 @@
 makeGenerator
     "return a generator which enumerates the classes from the selected category."
 
-    |cats hideUnloadedClasses allName nameSpaceFilter packageFilter showChangedClasses|
+    |cats hideUnloadedClasses allName nameSpaceFilter packageFilter 
+     showChangedClasses showUnloaded showUndocumented inclusionTest changedClasses|
 
     cats := self selectedCategoriesStrings.
     cats size == 0 ifTrue:[
@@ -529,6 +523,8 @@
     ].
 
     showChangedClasses := cats includes:(self class nameListEntryForChanged).
+    showUnloaded := cats includes:(self class nameListEntryForUnloaded).
+    showUndocumented := cats includes:(self class nameListEntryForUndocumented).
 
     hideUnloadedClasses := self hideUnloadedClasses value ? false.
     nameSpaceFilter := self nameSpaceFilter value.
@@ -542,65 +538,52 @@
 
     (cats includes:allName) ifTrue:[
         hideUnloadedClasses ifTrue:[
-            ^ Iterator on:[:whatToDo |
-                               Smalltalk allClassesDo:[:cls |
-                                   cls isLoaded ifTrue:[
-                                       (cls isRealNameSpace not) ifTrue:[
-                                           (nameSpaceFilter isNil
-                                           or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
-                                               (packageFilter isNil
-                                               or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
-                                                   whatToDo value:cls
-                                               ]
-                                           ]
-                                       ]
-                                   ]
-                               ]
-                          ]
+            inclusionTest := [:cls | cls isLoaded].
+        ] ifFalse:[
+            inclusionTest := [:cls | true].
         ].
-        ^ Iterator on:[:whatToDo | 
-                           Smalltalk allClassesDo:[:cls |
-                               (cls isRealNameSpace not) ifTrue:[
-                                    (nameSpaceFilter isNil
-                                    or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
-                                        (packageFilter isNil
-                                        or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
-                                            whatToDo value:cls
-                                        ]
-                                    ]
-                               ]
-                           ]
-                      ]
+    ] ifFalse:[
+        inclusionTest := 
+            [:cls | 
+                |cat isLoaded included|
+
+                isLoaded := cls isLoaded.
+                included := isLoaded not and:[ showUnloaded ].
+                included ifFalse:[
+                    (hideUnloadedClasses not or:[isLoaded]) ifTrue:[
+                        cat := cls category ? '* no category *'.
+                        included := cats includes:cat.
+                        included ifFalse:[
+                            included := showChangedClasses 
+                                        and:[ (changedClasses includes:cls theNonMetaclass)
+                                                or:[(changedClasses includes:cls theMetaclass)] ].
+                            included ifFalse:[
+                                included := showUndocumented and:[ isLoaded and:[ (cls theMetaclass implements:#documentation) not ]].
+                            ].
+                        ].
+                    ].
+                ].
+                included
+            ].
     ].
 
     ^ Iterator on:[:whatToDo |
-                       |changedClasses|
-
-                       showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].
-
-                       Smalltalk allClassesDo:[:cls | 
-                           |cat|
+            showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].
 
-                           (hideUnloadedClasses not or:[cls isLoaded]) 
-                           ifTrue:[
-                               (cls isRealNameSpace not) ifTrue:[
-                                   cat := cls category ? '* no category *'.
-                                   ((cats includes:cat)
-                                    or:[showChangedClasses 
-                                        and:[ (changedClasses includes:cls theNonMetaclass)
-                                              or:[(changedClasses includes:cls theMetaclass)] ]]) ifTrue:[
-                                       (nameSpaceFilter isNil
-                                       or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
-                                           (packageFilter isNil
-                                           or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
-                                               whatToDo value:cls
-                                           ]
-                                       ]
-                                   ]
-                               ]
-                           ]
-                       ]
-                  ]
+            Smalltalk allClassesDo:[:cls |
+                (cls isRealNameSpace) ifFalse:[
+                    (inclusionTest value:cls) ifTrue:[
+                        (nameSpaceFilter isNil
+                        or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
+                            (packageFilter isNil
+                            or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
+                                whatToDo value:cls
+                            ]
+                        ]
+                    ].
+                ].
+            ].
+        ].
 
     "Created: / 05-02-2000 / 13:42:12 / cg"
     "Modified: / 10-11-2006 / 17:13:26 / cg"
@@ -626,7 +609,7 @@
 listOfCategories
     |categories hideUnloadedClasses generator nameSpaceFilter packageFilter allName
      categoriesWithExtensions categoriesWithChangedCode categoriesWithRemoteChangedCode
-     classesInChangeSet classesInRemoteChangeSet numClassesInChangeSet numClasses|
+     classesInChangeSet classesInRemoteChangeSet numClassesInChangeSet numClasses numUnloaded numUndocumented|
 
     allName := self class nameListEntryForALL.
 
@@ -640,7 +623,7 @@
         (packageFilter includes:allName) ifTrue:[packageFilter := nil].
     ].
 
-    numClasses := 0.
+    numClasses := numUndocumented := numUnloaded := numClassesInChangeSet := 0.
 
     categories := Set new.
     categoriesWithExtensions := Set new.
@@ -656,15 +639,24 @@
     classes := IdentitySet new.
     inGeneratorHolder isNil ifTrue:[
         Smalltalk allClassesDo:[:cls | 
-            |cat|
+            |cat isLoaded|
+
+            (cls isRealNameSpace) ifFalse:[
+                (nameSpaceFilter isNil
+                or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
+                    (packageFilter isNil
+                    or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
 
-            (hideUnloadedClasses not or:[cls isLoaded])
-            ifTrue:[
-                (cls isRealNameSpace not) ifTrue:[
-                    (nameSpaceFilter isNil
-                    or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
-                        (packageFilter isNil
-                        or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
+                        isLoaded := cls isLoaded.
+                        isLoaded ifTrue:[ 
+                            numUnloaded := numUnloaded + 1. 
+                            (cls theMetaclass implements:#documentation) ifFalse:[
+                                numUndocumented := numUndocumented + 1.
+                            ].
+                        ].
+
+                        (hideUnloadedClasses not or:[isLoaded])
+                        ifTrue:[
                             numClasses := numClasses + 1.
 
                             cat := cls category ? '* no category *'.
@@ -716,12 +708,20 @@
                     (categoriesWithRemoteChangedCode includes:cat) ifTrue:[
                          (self colorizeForChangedCodeInSmallTeam:cat copy asText).
                     ] ifFalse:[
-                        cat
+                         cat
                     ]
                 ]
             ]
         ].
 
+    numUnloaded > 0 ifTrue:[
+        "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
+        categories addFirst:((self class nameListEntryForUnloaded "bindWith:numClassesInChangeSet") allItalic).
+    ].
+    numUndocumented > 0 ifTrue:[
+        "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
+        categories addFirst:((self class nameListEntryForUndocumented "bindWith:numClassesInChangeSet") allItalic).
+    ].
     numClassesInChangeSet := ChangeSet current changedClasses size.
     numClassesInChangeSet > 0 ifTrue:[
         "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
@@ -885,5 +885,5 @@
 !ClassCategoryList class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.25 2009-09-21 21:46:51 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.26 2009-09-22 10:30:25 cg Exp $'
 ! !