# HG changeset patch
# User Claus Gittinger <cg@exept.de>
# Date 1142844131 -3600
# Node ID d6e9cae51834d07daba1ca68bd12d75653bbb1a9
# Parent  34a0a1b149894f9318e76e11dab0ded870d96124
more generators;

diff -r 34a0a1b14989 -r d6e9cae51834 CodeGeneratorTool.st
--- a/CodeGeneratorTool.st	Mon Mar 20 09:40:58 2006 +0100
+++ b/CodeGeneratorTool.st	Mon Mar 20 09:42:11 2006 +0100
@@ -88,10 +88,16 @@
     ^ self new createEnumTypeCodeFor:aClass
 !
 
-createStandardInitializationMethodsIn:aClass
+createInitializedInstanceCreationMethodsIn:aClass
     "create a #new and #initialize methods (I'm tired of typing)"
 
-    ^ self new createStandardInitializationMethodsIn:aClass
+    ^ self new createInitializedInstanceCreationMethodsIn:aClass
+!
+
+createParametrizedInstanceCreationMethodsNamed:selector in:aClass
+    "create a #selector instance creation method (I'm tired of typing)"
+
+    ^ self new createParametrizedInstanceCreationMethodsNamed:selector in:aClass
 !
 
 createTestCaseSampleCodeFor:aClass
@@ -881,7 +887,7 @@
     "Modified: / 1.2.1998 / 16:10:03 / cg"
 !
 
-createStandardInitializationMethodsIn:aClass
+createInitializedInstanceCreationMethodsIn:aClass
     "create a #new and #initialize methods (I'm tired of typing)"
 
     |nonMetaClass metaClass className code initializer m|
@@ -897,31 +903,25 @@
 'initialize
     "Invoked when a new instance is created."
 
-    super initialize.
-
     "/ please change as required (and remove this comment)
 '.
 
-        m := nonMetaClass responseTo:#initialize.
-        m notNil ifTrue:[
-            m messagesSent size == 0 ifTrue:[
-                "/ inherits an empty initialize.
+        nonMetaClass instVarNames do:[:eachInstVar |
+            initializer := 'nil'. "/ need more intelligence here (try to guess class from messages sent to it) ...
+            code := code , ('    "/ ' , eachInstVar , ' := ' , initializer , '.' , Character cr).
+        ].
 
-                code :=
-'initialize
-    "Invoked when a new instance is created."
+        m := nonMetaClass responseTo:#initialize.
+        (m notNil and:[m messagesSent size == 0]) ifTrue:[
+            "/ inherits an empty initialize.
 
-    "/ please change as required (and remove this comment)
-
+            code := code , '
     "/ super initialize.   -- commented since inherited method does nothing
 '.
-
-            ].
-        ].
-
-        nonMetaClass instVarNames do:[:eachInstVar |
-            initializer := 'nil'. "/ need more intelligence here (try to guess class from messages sent to it) ...
-            code := code , ('    ' , eachInstVar , ' := ' , initializer , Character cr).
+        ] ifFalse:[
+            code := code , '
+    super initialize.
+'.
         ].
 
         self 
@@ -932,27 +932,92 @@
 
     (metaClass includesSelector:#'new') ifFalse:[
         m := metaClass responseTo:#new.
-        m notNil ifTrue:[
-            (m sends:#initialize) ifTrue:[
-                (self confirm:'The inherited #new method already seems to invoke #initialize. Redefine ?')
-                ifFalse:[
-                    ^ self
-                ]
-            ].
-        ].
-        code :=
+        (m isNil 
+        or:[ (m sends:#initialize) not 
+        or:[ |answer|
+            (Dialog 
+                confirmWithCancel:'The inherited #new method already seems to invoke #initialize. Redefine ?'
+                onCancel:[^ self]) ]]) ifTrue:[
+            code :=
 'new
     ^ self basicNew initialize.
 '.
+            self 
+                compile:code
+                forClass:metaClass 
+                inCategory:'instance creation'.
+        ].
+    ].
+
+    self executeCollectedChangesNamed:('Add Initialized Instance Creation to ' , className).
+
+    "Created: / 11.10.2001 / 22:18:55 / cg"
+!
+
+createParametrizedInstanceCreationMethodsNamed:selector in:aClass
+    "create a #selector instance creation method (I'm tired of typing)"
+
+    |nonMetaClass metaClass className code initializer m dfn|
+
+    dfn := Method methodDefinitionTemplateForSelector:selector.
+
+    nonMetaClass := aClass theNonMetaclass.
+    metaClass := aClass theMetaclass.
+    className := nonMetaClass name.
+
+    self startCollectChanges.
+
+    (nonMetaClass includesSelector:selector asSymbol) ifFalse:[
+        code :=
+'initialize',dfn asUppercaseFirst,'
+    "Invoked when a new instance is created for arg."
+
+    "/ please change as required (and remove these comments)
+    "/ do something with arg here (instVar-foo := arg)
+'.
+        nonMetaClass instVarNames do:[:eachInstVar |
+            initializer := 'nil'. "/ need more intelligence here (try to guess class from messages sent to it) ...
+            code := code , ('    "/ ' , eachInstVar , ' := ' , initializer , '.' , Character cr).
+        ].
+
+        m := nonMetaClass responseTo:#initialize.
+        (m notNil and:[ m messagesSent size == 0 ]) ifTrue:[
+            "/ inherits an empty initialize.
+
+            code := code , '
+    "/ super initialize.   -- commented since inherited method does nothing
+'.
+        ] ifFalse:[
+            code := code , '
+    super initialize.  
+'.
+        ].
+
         self 
             compile:code
-            forClass:metaClass 
-            inCategory:'instance creation'.
+            forClass:nonMetaClass 
+            inCategory:'initialization'.
     ].
 
-    self executeCollectedChangesNamed:('Add Initialization to ' , className).
+    (metaClass includesSelector:selector) ifFalse:[
+        m := metaClass responseTo:selector.
+        (m isNil 
+        or:[ (Dialog confirmWithCancel:'The ',selector,'- method is already inherited. Redefine ?' onCancel:[^ self]) ])
+        ifTrue:[
+            code :=
+dfn,'
+    "Create & return a new instance for arg."
 
-    "Created: / 11.10.2001 / 22:18:55 / cg"
+    ^ self basicNew initialize',dfn asUppercaseFirst,'
+'.
+            self 
+                compile:code
+                forClass:metaClass 
+                inCategory:'instance creation'.
+        ].
+    ].
+
+    self executeCollectedChangesNamed:('Add Parametrized Instance Creation to ' , className).
 !
 
 createStandardPrintOnMethodIn:aClass
@@ -1858,5 +1923,5 @@
 !CodeGeneratorTool class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.36 2006-03-06 08:53:21 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.37 2006-03-20 08:42:11 cg Exp $'
 ! !