--- a/CodeGeneratorTool.st	Thu Oct 22 11:01:00 2009 +0200
+++ b/CodeGeneratorTool.st	Thu Oct 22 12:29:40 2009 +0200
@@ -731,6 +731,34 @@
     ^ method
 ! !
 
+!CodeGeneratorTool class methodsFor:'utilities'!
+
+missingRequiredProtocolFor:aClass
+    "return the missing required protocol; 
+     that is the set of selectors which send #subclassResponsibility in a superclass and 
+     have no implementation in aClass or in any class between aClass and that superclass"
+
+    |requiredSelectors implementedSelectors|
+
+    requiredSelectors := IdentitySet new.
+    implementedSelectors := IdentitySet withAll:(aClass methodDictionary keys).
+
+    aClass allSuperclassesDo:[:eachSuperClass |
+        eachSuperClass methodDictionary keysAndValuesDo:[:eachSelector :eachMethod |
+            ((eachMethod sends:#subclassResponsibility) or:[eachMethod sends:#subclassResponsibility:]) ifTrue:[
+                (implementedSelectors includes:eachSelector) ifFalse:[
+                    requiredSelectors add:eachSelector.
+                ]
+            ] ifFalse:[
+                (requiredSelectors includes:eachSelector) ifFalse:[
+                    implementedSelectors add:eachSelector.
+                ].
+            ].
+        ]
+    ].
+    ^ requiredSelectors
+! !
+
 !CodeGeneratorTool methodsFor:'buld changes'!
 
 addChange:aChange
@@ -2785,61 +2813,74 @@
     "create stubs for the required protocol.
      aClass may be a a MetaClass or a non-MetaClass"
 
-    |selectors|
-
-    selectors := IdentitySet new.
-    aClass allSuperclassesDo:[:eachSuperClass |
-        eachSuperClass methodDictionary keysAndValuesDo:[:eachSelector :eachMethod |
-            (eachMethod sends:#subclassResponsibility) ifTrue:[
-                selectors add:eachSelector.
-            ]
-        ]
-    ].
-
-    selectors do:[:eachSelector |
-        |mthd comment implClass methodBodyStream|
-
-        implClass := aClass whichClassIncludesSelector:eachSelector.
-        implClass ~~ aClass ifTrue:[
+    |requiredProtocol|
+
+    requiredProtocol := self class missingRequiredProtocolFor:aClass.
+    requiredProtocol do:[:eachSelector |
+        |mthd comment implClass methodBodyStream tree searcher errorMessageString|
+
+        implClass := aClass whichClassImplements:eachSelector.
+        implClass == Object ifFalse:[
             mthd := implClass compiledMethodAt:eachSelector.
-            (mthd sends:#subclassResponsibility) ifTrue:[
-                methodBodyStream := '' writeStream.
+
+            methodBodyStream := '' writeStream.
+            methodBodyStream 
+                nextPutAll:mthd methodDefinitionTemplate; cr;
+                nextPutAll:'    "'.
+
+            "/ include the comment of the subclassResponsibility-sending method
+            comment := mthd methodComment.
+            comment isEmptyOrNil ifTrue:[
                 methodBodyStream 
-                    nextPutAll:mthd methodDefinitionTemplate; cr;
-                    nextPutAll:'    "'.
-
-                comment := mthd methodComment.
-                comment isEmptyOrNil ifTrue:[
-                    methodBodyStream 
-                        nextPutAll:('Superclass <1s> says that I am responsible to implement this method'  
-                                    expandMacrosWith:implClass name)
-                ] ifFalse:[
-                    comment asStringCollection do:[:eachLine|
-                        methodBodyStream nextPutAll:eachLine.
-                    ] separatedBy:[
-                        methodBodyStream cr; nextPutAll:'     '.
-                    ].
+                    nextPutAll:('Superclass <1s> says that I am responsible to implement this method'  
+                                expandMacrosWith:implClass name)
+            ] ifFalse:[
+                comment asStringCollection do:[:eachLine|
+                    methodBodyStream nextPutAll:eachLine.
+                ] separatedBy:[
+                    methodBodyStream cr; nextPutAll:'     '.
                 ].
-
+            ].
+            methodBodyStream 
+                nextPut:$"; cr; cr.
+
+            "/ include the argument of the subclassResponsibility:-sending method
+            self canUseRefactoringSupport ifTrue:[
+                (mthd sends:#subclassResponsibility:) ifTrue:[
+                    searcher := ParseTreeSearcher new.
+                    searcher
+                            matches: 'self subclassResponsibility: `''.*'''
+                            do:[:node :answer | 
+                                errorMessageString := node arguments first value.
+                                true.
+                            ].
+                    searcher executeTree: (mthd parseTree) initialAnswer: false.
+                    self halt.
+                ].
+            ].
+            errorMessageString notEmptyOrNil ifTrue:[
                 methodBodyStream 
-                    nextPut:$"; cr; cr;
-                    nextPutAll:'    self shouldImplement'; cr.
-
-                self 
-                    compile:methodBodyStream contents
-                    forClass:aClass 
-                    inCategory:mthd category.
+                    nextPutAll:'    self shouldImplement: '; 
+                    nextPutLine:(errorMessageString storeString)
+            ] ifFalse:[
+                methodBodyStream 
+                    nextPutLine:'    self shouldImplement'.
             ].
-        ].
+
+            self 
+                compile:methodBodyStream contents
+                forClass:aClass 
+                inCategory:mthd category.
+        ]
     ].
 ! !
 
 !CodeGeneratorTool class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.64 2009-10-14 13:32:30 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.65 2009-10-22 10:29:40 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.64 2009-10-14 13:32:30 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.65 2009-10-22 10:29:40 cg Exp $'
 ! !