--- a/Tools_MethodCategoryList.st	Wed Jul 20 17:46:13 2011 +0200
+++ b/Tools_MethodCategoryList.st	Wed Jul 20 18:30:01 2011 +0200
@@ -437,7 +437,7 @@
                     newProtocol := mthd category.
                     oldProtocol := aParameter at:3.
 
-                    self invalidateList.
+                    listValid == true ifTrue:[ self invalidateList ].
 
                     selectedCategories := selectedProtocolsHolder value.
                     selectedCategories size > 0 ifTrue:[
@@ -467,13 +467,13 @@
                     oldMethod notNil ifTrue:[
                         variableFilter value size > 0 ifTrue:[
                             "/ sigh - must invalidate
-                            self invalidateList.
+                            listValid == true ifTrue:[ self invalidateList ].
                         ].
                         ^ self.
                     ].
                     "/ method was added - update the methodList
                     "/ Q: is this needed (methodCategoryList should send me a new inGenerator)
-                    self invalidateList.
+                    listValid == true ifTrue:[ self invalidateList ].
 
                     "/ if its category is selected, updateOutputGenerator
                     selectedCategories := selectedProtocolsHolder value.
@@ -513,10 +513,10 @@
             or:[ something == #methodCategoryRenamed ]]]]) ifTrue:[
                 cls := (something == #classOrganization) ifTrue:aParameter ifFalse:[aParameter first].
                 (classes includesIdentical:cls) ifTrue:[
-                    self invalidateList.
+                    listValid == true ifTrue:[ self invalidateList ].
                 ] ifFalse:[
                     (classes contains:[:aClass | aClass name = cls name]) ifTrue:[
-                        self invalidateList.
+                        listValid == true ifTrue:[ self invalidateList ].
                         "/ self error:'obsolete class: should not happen'.
                     ]
                 ].
@@ -536,11 +536,17 @@
                         ].
                     ].
                 ] ifFalse:[
-                    self invalidateList.
+                    listValid == true ifTrue:[ self invalidateList ].
                 ].
                 ^ self
             ].
 
+            (something == #methodCoverageInformation) ifTrue:[
+                "/ already checked if it is one of my classes
+                listValid == true ifTrue:[ self invalidateList ].
+                ^ self
+            ].
+
             (something == #classDefinition or:[something == #classVariables])
             ifTrue:[
                 self classDefinitionChanged:aParameter.
@@ -639,7 +645,7 @@
     super delayedUpdate:something with:aParameter from:changedObject
 
     "Created: / 05-02-2000 / 13:42:10 / cg"
-    "Modified: / 06-07-2011 / 11:43:55 / cg"
+    "Modified: / 20-07-2011 / 18:05:53 / cg"
 !
 
 getSelectedProtocolsFromIndices
@@ -680,7 +686,7 @@
 !
 
 update:something with:aParameter from:changedObject
-    |cls sel oldMethod newMethod|
+    |cls sel mthd oldMethod newMethod|
 
     "/ some can be ignored immediately
     changedObject == Smalltalk ifTrue:[
@@ -690,7 +696,7 @@
         ].
 
         something == #currentChangeSet ifTrue:[
-            self invalidateList.
+            listValid == true ifTrue:[ self invalidateList ].
             ^ self.
         ].
 
@@ -706,15 +712,15 @@
             oldMethod notNil ifTrue:[
                 variableFilter value size > 0 ifTrue:[
                     "/ sigh - must invalidate
-                    self invalidateList.
+                    listValid == true ifTrue:[ self invalidateList ].
                     ^ self.    
                 ].
                 oldMethod category ~= newMethod category ifTrue:[
-                    self invalidateList.
+                    listValid == true ifTrue:[ self invalidateList ].
                     ^ self.    
                 ].
                 "/ mhmh - its now changed (so coloring will change).
-                self invalidateList.
+                listValid == true ifTrue:[ self invalidateList ].
                 ^ self.
             ].
         ].
@@ -743,11 +749,17 @@
         something == #methodTrap ifTrue:[
             ^ self
         ].
+
+        something == #methodCoverageInfo ifTrue:[
+            self showCoverageInformation value ifFalse:[^ self].
+            mthd := aParameter.
+            (classes notNil and:[classes includesIdentical:mthd mclass]) ifFalse:[^ self].
+        ].
     ].
 
     super update:something with:aParameter from:changedObject.
 
-    "Modified: / 09-07-2011 / 10:03:06 / cg"
+    "Modified: / 20-07-2011 / 18:07:48 / cg"
 ! !
 
 !MethodCategoryList methodsFor:'drag & drop'!
@@ -1079,8 +1091,9 @@
      emphasizedPlus emphasisForRef emphasisForMod
      numAll numObsolete numSuper numUncommented numDocumentation numLong numOverride
      numRedefine numExtension numMissingRequired numSubclassResponsibility 
+     numFullyCovered numPartiallyCovered numUncovered 
      showPseudoProtocols showCoverageInformation
-     addPseudoEntry countAll pseudoEntryColor userPreferences|
+     addPseudoEntry addPseudoEntryWithColor countAll pseudoEntryColor userPreferences|
 
     userPreferences := UserPreferences current.
     countAll := true.
@@ -1124,6 +1137,7 @@
     classVarsToHighLight := filterClassVars value.
     numObsolete := numSuper := numUncommented := numDocumentation := numLong := 0.
     numRedefine := numOverride := numExtension := numMissingRequired := numSubclassResponsibility := 0.
+    numFullyCovered := numPartiallyCovered := numUncovered := 0.
 
     generator do:[:clsIn :catIn | 
                         |emptyProtocols clsName doHighLight doHighLightRed suppress|
@@ -1244,11 +1258,14 @@
                             itemsWithCalledMethods add:mCategory.
                             mthd haveAllBlocksBeenExecuted ifTrue:[
                                 itemsWithFullyCoveredMethods add:mCategory.
+                                numFullyCovered := numFullyCovered + 1.
                             ] ifFalse:[
                                 itemsWithPartiallyCoveredMethods add:mCategory.
+                                numPartiallyCovered := numPartiallyCovered + 1.
                             ].
                         ] ifFalse:[
                             itemsWithUncalledMethods add:mCategory.
+                            numUncovered := numUncovered + 1.
                         ].
                     ].
                 ].
@@ -1305,7 +1322,7 @@
                                 clr := (userPreferences colorForInstrumentedPartiallyCoveredCode).
                             ] ifFalse:[
                                  clr := (userPreferences colorForInstrumentedFullyCoveredCode).
-                            ]
+                            ]                    
                         ]
                     ] ifFalse:[
                         clr := (userPreferences colorForInstrumentedNeverCalledCode).
@@ -1386,16 +1403,16 @@
     ].
 
     showPseudoProtocols value ifTrue:[
-        addPseudoEntry := [:s :n | 
+        addPseudoEntryWithColor := [:s :n :clr | 
                                 n > 0 ifTrue:[
                                     categoryList 
-                                        add:((s bindWith:n) 
-                                                allItalic 
-                                                    colorizeAllWith:pseudoEntryColor).
+                                        add:((s bindWith:n) allItalic colorizeAllWith:clr).
                                     rawProtocolList add:s.
                                 ].
                            ].
 
+        addPseudoEntry := [:s :n | addPseudoEntryWithColor value:s value:n value:pseudoEntryColor].
+
         addPseudoEntry value:self class nameListEntryForSuperSend value:numSuper.
         addPseudoEntry value:self class nameListEntryForRedefined value:numRedefine.
         addPseudoEntry value:self class nameListEntryForDocumentation value:numDocumentation.
@@ -1405,6 +1422,11 @@
         addPseudoEntry value:self class nameListEntryForExtensions value:numExtension.
         addPseudoEntry value:self class nameListEntryForOverride value:numOverride.
         addPseudoEntry value:self class nameListEntryForMustBeRedefinedInSubclass value:numSubclassResponsibility.
+        showCoverageInformation ifTrue:[                                                                              
+            addPseudoEntryWithColor value:self class nameListEntryForPartiallyCovered value:numPartiallyCovered value:userPreferences colorForInstrumentedPartiallyCoveredCode.
+            addPseudoEntryWithColor value:self class nameListEntryForUncovered value:numUncovered value:userPreferences colorForInstrumentedNeverCalledCode.
+            addPseudoEntryWithColor value:self class nameListEntryForFullyCovered value:numFullyCovered value:userPreferences colorForInstrumentedFullyCoveredCode.
+        ].
 
         "/ I think red is too much of an alert color (and we get more of them as we think...)
 "/        numMissingRequired > 0 ifTrue:[
@@ -1416,7 +1438,7 @@
     ^ categoryList
 
     "Created: / 05-02-2000 / 13:42:11 / cg"
-    "Modified: / 20-07-2011 / 14:51:46 / cg"
+    "Modified: / 20-07-2011 / 18:28:25 / cg"
 !
 
 makeDependent
@@ -1840,8 +1862,12 @@
 
 !MethodCategoryList class methodsFor:'documentation'!
 
+version
+    ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.65 2011-07-20 16:30:01 cg Exp $'
+!
+
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.64 2011-07-20 12:53:08 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.65 2011-07-20 16:30:01 cg Exp $'
 ! !
 
 MethodCategoryList initialize!