CodeGeneratorTool.st
changeset 6791 6559c9ebb561
parent 6718 d6e9cae51834
child 6839 c25218305e50
--- a/CodeGeneratorTool.st	Wed Jun 07 17:42:47 2006 +0200
+++ b/CodeGeneratorTool.st	Wed Jun 07 17:47:22 2006 +0200
@@ -39,7 +39,7 @@
 "
     This utility class contains various code generation facilites;
     these were extracted from the old and newBrowser.
-    There is probably more to gome...
+    There is probably more to come...
 
     [author:]
         Claus Gittiner
@@ -1879,42 +1879,53 @@
 !
 
 privCreateClassResponsibleProtocolFor:aClass
-    "create stubs for the required protocol aClass may be a a MetaClass
-     or a NonMetaClass"
+    "create stubs for the required protocol.
+     aClass may be a a MetaClass or a non-MetaClass"
 
     |selectors|
 
     selectors := IdentitySet new.
-    aClass allSuperclassesDo:[:cls |
-        cls methodDictionary keysAndValuesDo:[:sel :mthd |
-            (mthd sends:#subclassResponsibility) ifTrue:[
-                selectors add:sel.
+    aClass allSuperclassesDo:[:eachSuperClass |
+        eachSuperClass methodDictionary keysAndValuesDo:[:eachSelector :eachMethod |
+            (eachMethod sends:#subclassResponsibility) ifTrue:[
+                selectors add:eachSelector.
             ]
         ]
     ].
 
     selectors do:[:eachSelector |
-        |cat comment mthd implClass|
+        |mthd comment implClass methodBodyStream|
 
-        implClass := aClass whichClassImplements:eachSelector.
+        implClass := aClass whichClassIncludesSelector:eachSelector.
         implClass ~~ aClass ifTrue:[
             mthd := implClass compiledMethodAt:eachSelector.
             (mthd sends:#subclassResponsibility) ifTrue:[
-                cat := mthd category.
+                methodBodyStream := '' writeStream.
+                methodBodyStream 
+                    nextPutAll:mthd methodDefinitionTemplate; cr;
+                    nextPutAll:'    "'.
+
                 comment := mthd methodComment.
-                comment size == 0 ifTrue:[
-                    comment := 'Superclass says that I am responsible to implement this method'
+                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:'     '.
+                    ].
                 ].
 
+                methodBodyStream 
+                    nextPut:$"; cr; cr;
+                    nextPutAll:'    self shouldImplement'; cr.
+
                 self 
-                    compile:
-(Method methodDefinitionTemplateForSelector:eachSelector), Character cr, '    "', comment,
-'"
-
-    self shouldImplement
-' 
+                    compile:methodBodyStream contents
                     forClass:aClass 
-                    inCategory:cat.
+                    inCategory:mthd category.
             ].
         ].
     ].
@@ -1923,5 +1934,5 @@
 !CodeGeneratorTool class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.37 2006-03-20 08:42:11 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.38 2006-06-07 15:47:22 stefan Exp $'
 ! !