--- a/Tools_MethodCategoryList.st	Thu Oct 22 14:43:13 2009 +0200
+++ b/Tools_MethodCategoryList.st	Thu Oct 22 14:43:18 2009 +0200
@@ -34,6 +34,13 @@
 	privateIn:MethodCategoryList
 !
 
+Method variableSubclass:#MissingMethod
+	instanceVariableNames:'selector'
+	classVariableNames:''
+	poolDictionaries:''
+	privateIn:MethodCategoryList
+!
+
 !MethodCategoryList class methodsFor:'documentation'!
 
 copyright
@@ -799,6 +806,7 @@
             |protocols 
              allProtocols superSendProtocols uncommentedProtocols obsoleteProtocols 
              documentationProtocols longProtocols extensionProtocols redefinedProtocols overrideProtocols
+             missingRequiredProtocols
              noCat static notStatic classSelectorPairsAlreadyDone
              packages remainingClasses remainingCategories classesAlreadyDone noPackage|
 
@@ -822,6 +830,7 @@
                 extensionProtocols := protocols includes:(self class nameListEntryForExtensions).
                 redefinedProtocols := protocols includes:(self class nameListEntryForRedefined).
                 overrideProtocols := protocols includes:(self class nameListEntryForOverride).
+                missingRequiredProtocols := protocols includes:(self class nameListEntryForRequired).
 
 "/                packages := packageFilter value value.
 "/                (packages notNil and:[packages includes:(self class nameListEntryForALL)]) ifTrue:[
@@ -836,7 +845,7 @@
 
                 leafClasses do:[:aLeafClass |  
                     (self classesToProcessForClasses:(Array with:aLeafClass)) do:[:aClass |
-                        |supportsMethodCategories isJavaClass anyInThisClass|
+                        |supportsMethodCategories isJavaClass anyInThisClass requiredProtocolForClass|
 
                         (classesAlreadyDone includes:aClass) ifFalse:[
                             classesAlreadyDone add:aClass.
@@ -912,6 +921,18 @@
                                     ]
                                 ]
                             ].
+
+                            missingRequiredProtocols ifTrue:[
+                                requiredProtocolForClass := CodeGeneratorTool missingRequiredProtocolFor:aClass.
+                                requiredProtocolForClass do:[:sel | 
+                                    |selectorInRed missingMethodPlaceHolder|
+
+                                    selectorInRed := sel colorizeAllWith:Color red.
+                                    missingMethodPlaceHolder := MissingMethod basicNew.
+                                    missingMethodPlaceHolder mclass:aClass; selector:selectorInRed.
+                                    whatToDo value:aClass value:'required' value:selectorInRed value:missingMethodPlaceHolder.
+                                ].
+                            ].
                             anyInThisClass ifTrue:[ remainingClasses remove:aClass ifAbsent:nil. ].
                         ].
                     ].
@@ -1031,7 +1052,7 @@
      packageFilterOnInput packageFilter nameListEntryForALL changeSet 
      emphasizedPlus emphasisForRef emphasisForMod
      numObsolete numSuper numUncommented numDocumentation numLong numOverride
-     numRedefine numExtension showPseudoProtocols|
+     numRedefine numExtension numMissingRequired showPseudoProtocols|
 
     generator := inGeneratorHolder value.
     generator isNil ifTrue:[ ^ #() ].
@@ -1063,7 +1084,7 @@
     variablesToHighlight := variableFilter value.
     classVarsToHighLight := filterClassVars value.
     numObsolete := numSuper := numUncommented := numDocumentation := numLong := 0.
-    numRedefine := numOverride := numExtension := 0.
+    numRedefine := numOverride := numExtension := numMissingRequired := 0.
 
     generator do:[:clsIn :catIn | 
                         |emptyProtocols clsName doHighLight doHighLightRed suppress|
@@ -1145,7 +1166,7 @@
     changeSet := ChangeSet current.
 
     classesProcessed do:[:eachClass |
-        |classPackage|
+        |classPackage required|
 
         classPackage := eachClass package.
         eachClass methodDictionary keysAndValuesDo:[:mSelector :mthd |
@@ -1177,7 +1198,12 @@
             (SmallTeam notNil and:[ SmallTeam includesChangeForClass:eachClass selector:mSelector] ) ifTrue:[
                 itemsInRemoteChangeSet add:mCategory.    
             ].
-        ]
+        ].
+        showPseudoProtocols value ifTrue:[
+            "/ see if there is a subclassResponsibility in a superclass
+            required := CodeGeneratorTool missingRequiredProtocolFor:eachClass.
+            numMissingRequired := numMissingRequired + required size.
+        ].
     ].
 
     categoryList := categoryList asOrderedCollection.
@@ -1253,42 +1279,47 @@
     ].
     categoryList notEmpty ifTrue:[
         noAllItem value ~~ true ifTrue:[
-            categoryList addFirst:(nameListEntryForALL asText allItalic).
+            categoryList addFirst:(nameListEntryForALL allItalic).
             rawProtocolList addFirst:nameListEntryForALL.
         ].
         showPseudoProtocols value ifTrue:[
             numSuper > 0 ifTrue:[
-                categoryList add:((self class nameListEntryForSuperSend bindWith:numSuper) asText allItalic).
+                categoryList add:((self class nameListEntryForSuperSend bindWith:numSuper) allItalic).
                 rawProtocolList add:self class nameListEntryForSuperSend.
             ].
             numRedefine > 0 ifTrue:[
-                categoryList add:((self class nameListEntryForRedefined bindWith:numRedefine) asText allItalic).
+                categoryList add:((self class nameListEntryForRedefined bindWith:numRedefine) allItalic).
                 rawProtocolList add:self class nameListEntryForRedefined.
             ].
             numDocumentation > 0 ifTrue:[
-                categoryList add:((self class nameListEntryForDocumentation bindWith:numDocumentation) asText allItalic).
+                categoryList add:((self class nameListEntryForDocumentation bindWith:numDocumentation) allItalic).
                 rawProtocolList add:self class nameListEntryForDocumentation.
             ].
             numUncommented > 0 ifTrue:[
-                categoryList add:((self class nameListEntryForUncommented bindWith:numUncommented) asText allItalic).
+                categoryList add:((self class nameListEntryForUncommented bindWith:numUncommented) allItalic).
                 rawProtocolList add:self class nameListEntryForUncommented.
             ].
             numLong > 0 ifTrue:[
-                categoryList add:((self class nameListEntryForLong bindWith:numLong) asText allItalic).
+                categoryList add:((self class nameListEntryForLong bindWith:numLong) allItalic).
                 rawProtocolList add:self class nameListEntryForLong.
             ].
             numObsolete > 0 ifTrue:[
-                categoryList add:((self class nameListEntryForObsolete bindWith:numObsolete) asText allItalic).
+                categoryList add:((self class nameListEntryForObsolete bindWith:numObsolete) allItalic).
                 rawProtocolList add:self class nameListEntryForObsolete.
             ].
             numExtension > 0 ifTrue:[
-                categoryList add:((self class nameListEntryForExtensions bindWith:numExtension) asText allItalic).
+                categoryList add:((self class nameListEntryForExtensions bindWith:numExtension) allItalic).
                 rawProtocolList add:self class nameListEntryForExtensions.
             ].
             numOverride > 0 ifTrue:[
-                categoryList add:((self class nameListEntryForOverride bindWith:numOverride) asText allItalic).
+                categoryList add:((self class nameListEntryForOverride bindWith:numOverride) allItalic).
                 rawProtocolList add:self class nameListEntryForOverride.
             ].
+            numMissingRequired > 0 ifTrue:[
+                categoryList add:((self class nameListEntryForRequired bindWith:numMissingRequired) allItalic colorizeAllWith:Color red).
+                rawProtocolList add:self class nameListEntryForRequired.
+            ].
+
         ].
     ].
     ^ categoryList
@@ -1651,14 +1682,40 @@
                 ifFalse:[ flags bitClear: FlagSendsSuper]
 ! !
 
+!MethodCategoryList::MissingMethod methodsFor:'accessing'!
+
+mclass:aClass
+    mclass := aClass
+!
+
+selector
+    ^ selector
+!
+
+selector:something
+    selector := something.
+!
+
+source
+    ^ (CodeGeneratorTool basicNew
+        codeFor_shouldImplementFor:selector string asSymbol 
+        inClass:mclass) colorizeAllWith:Color red
+! !
+
+!MethodCategoryList::MissingMethod methodsFor:'printing & storing'!
+
+printStringForBrowserWithSelector:selector inClass:aClass
+    ^ selector,' (** missing required **)' colorizeAllWith:Color red
+! !
+
 !MethodCategoryList class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.42 2009-10-15 11:43:58 fm Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.43 2009-10-22 12:43:18 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.42 2009-10-15 11:43:58 fm Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.43 2009-10-22 12:43:18 cg Exp $'
 ! !
 
 MethodCategoryList initialize!