care for metaClass in class wizard
authorClaus Gittinger <cg@exept.de>
Sun, 30 Jan 2011 10:56:43 +0100
changeset 9722 14be18de210f
parent 9721 47aa8329ff01
child 9723 1f088ae4657e
care for metaClass in class wizard
NewSystemBrowser.st
Tools__NewSystemBrowser.st
--- a/NewSystemBrowser.st	Sun Jan 30 10:55:29 2011 +0100
+++ b/NewSystemBrowser.st	Sun Jan 30 10:56:43 2011 +0100
@@ -21169,42 +21169,70 @@
 !
 
 classMenuOpenClassCreationWizard
-    |dialog newClassName superclassName superclass package namespace 
-     namespacePrefix createdClass category|
+    |dialog newClassName superclassName superclass package namespace namespaceName 
+     namespacePrefix createdClass category language|
 
     dialog := NewClassWizardDialog new.
     dialog masterApplication:self.
+
+self halt.
+    dialog categoryHolder value:(self theSingleSelectedCategory).
+    dialog packageHolder value:(self theSingleSelectedProject).
+
     dialog openModal.
     dialog accepted ifFalse:[^ self].
 
+    language := dialog language.
     newClassName := dialog classNameHolder value withoutSeparators.
     superclassName := dialog superclassNameHolder value withoutSeparators.
     superclass := Smalltalk classNamed:superclassName.
     package := (dialog packageHolder value ? '') withoutSeparators.
-    namespace := (dialog nameSpaceHolder value ? 'Smalltalk') withoutSeparators.
+    namespaceName := (dialog nameSpaceHolder value ? 'Smalltalk') withoutSeparators.
     category := (dialog categoryHolder value ? '* as yet unspecified *') withoutSeparators.
 
-    (namespace = 'Smalltalk') ifTrue:[
+    (namespaceName = 'Smalltalk') ifTrue:[
         namespacePrefix := ''
     ] ifFalse:[
-        namespacePrefix := namespace , '::'
-    ].
+        namespacePrefix := namespaceName , '::'
+    ].
+    namespace := NameSpace name:namespaceName.
 
     Class packageQuerySignal answer:package
     do:[
-        createdClass := 
-            superclass
-                subclass: (namespacePrefix,newClassName) asSymbol 
-                instanceVariableNames: dialog instVarNamesHolder value 
-                classVariableNames: dialog classVarNamesHolder value 
-                poolDictionaries: ' '
-                category: category.
-
-        dialog classInstVarNamesHolder value notEmptyOrNil ifTrue:[
-            createdClass class instanceVariableNames: dialog classInstVarNamesHolder value
-        ].
-    ].
-
+        |builder|
+
+"/        createdClass := 
+"/            superclass
+"/                subclass: (namespacePrefix,newClassName) asSymbol 
+"/                instanceVariableNames: dialog instVarNamesHolder value 
+"/                classVariableNames: dialog classVarNamesHolder value 
+"/                poolDictionaries: ' '
+"/                category: category.
+"/
+"/        dialog classInstVarNamesHolder value notEmptyOrNil ifTrue:[
+"/            createdClass class instanceVariableNames: dialog classInstVarNamesHolder value
+"/        ].
+
+        builder := ClassBuilder new.
+        builder metaclass:(language metaClass).
+        builder 
+            name:(namespacePrefix,newClassName) asSymbol 
+            inEnvironment:namespace 
+            subclassOf:superclass 
+            instanceVariableNames:(dialog instVarNamesHolder value) 
+            variable:false 
+            words:false 
+            pointers:false 
+            classVariableNames:(dialog classVarNamesHolder value) 
+            poolDictionaries:'' 
+            category:category 
+            comment:nil 
+            changed:true 
+            classInstanceVariableNames:(dialog classInstVarNamesHolder value).
+        createdClass := builder buildClass.
+    ].
+
+    createdClass isNil ifTrue:[^ self ].
     self switchToClass:createdClass.
 
     Class packageQuerySignal answer:package
@@ -21248,6 +21276,8 @@
                 ].
             ].
     ].
+
+    "Modified: / 30-01-2011 / 10:46:01 / cg"
 !
 
 classMenuPrimitiveCode:aspect
@@ -22280,15 +22310,20 @@
 generateUndoableChange:nameOfOperation overClasses:classes via:aBlock
     "helper for code generators"
 
-    |generator count dict className|
+    |generator count dict className codeGeneratorClass|
 
     "/ remove this a.s.a.p
     (classes conform:[:cls | |lang| lang := cls programmingLanguage. lang isSmalltalk or:[lang isSTXJavaScript]]) ifFalse:[
         Dialog warn:('Sorry.\\For now, this works only for Smalltalk classes.' withCRs).
         ^ self.
     ].
-
-    generator := classes first programmingLanguage codeGeneratorToolClass "CodeGeneratorTool" new.
+    codeGeneratorClass := classes first programmingLanguage codeGeneratorToolClass.
+    codeGeneratorClass isNil ifTrue:[
+        Dialog warn:('Sorry.\\For now, there seems to be no codeGeneratorClass defined for this language.' withCRs).
+        ^ self.
+    ].
+
+    generator := codeGeneratorClass new.
     generator startCollectChanges.
 
     count := 0.
@@ -22326,6 +22361,8 @@
             generator executeCollectedChangesNamed:(nameOfOperation expandPlaceholdersWith:dict)
         ]
     ]
+
+    "Modified: / 30-01-2011 / 10:43:55 / cg"
 !
 
 generateUndoableChangeOverSelectedClasses:nameOfOperation via:aBlock
@@ -44800,11 +44837,11 @@
 !NewSystemBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.1502 2011-01-28 09:29:50 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.1503 2011-01-30 09:56:43 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.1502 2011-01-28 09:29:50 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.1503 2011-01-30 09:56:43 cg Exp $'
 ! !
 
 NewSystemBrowser initialize!
--- a/Tools__NewSystemBrowser.st	Sun Jan 30 10:55:29 2011 +0100
+++ b/Tools__NewSystemBrowser.st	Sun Jan 30 10:56:43 2011 +0100
@@ -21169,42 +21169,70 @@
 !
 
 classMenuOpenClassCreationWizard
-    |dialog newClassName superclassName superclass package namespace 
-     namespacePrefix createdClass category|
+    |dialog newClassName superclassName superclass package namespace namespaceName 
+     namespacePrefix createdClass category language|
 
     dialog := NewClassWizardDialog new.
     dialog masterApplication:self.
+
+self halt.
+    dialog categoryHolder value:(self theSingleSelectedCategory).
+    dialog packageHolder value:(self theSingleSelectedProject).
+
     dialog openModal.
     dialog accepted ifFalse:[^ self].
 
+    language := dialog language.
     newClassName := dialog classNameHolder value withoutSeparators.
     superclassName := dialog superclassNameHolder value withoutSeparators.
     superclass := Smalltalk classNamed:superclassName.
     package := (dialog packageHolder value ? '') withoutSeparators.
-    namespace := (dialog nameSpaceHolder value ? 'Smalltalk') withoutSeparators.
+    namespaceName := (dialog nameSpaceHolder value ? 'Smalltalk') withoutSeparators.
     category := (dialog categoryHolder value ? '* as yet unspecified *') withoutSeparators.
 
-    (namespace = 'Smalltalk') ifTrue:[
+    (namespaceName = 'Smalltalk') ifTrue:[
         namespacePrefix := ''
     ] ifFalse:[
-        namespacePrefix := namespace , '::'
-    ].
+        namespacePrefix := namespaceName , '::'
+    ].
+    namespace := NameSpace name:namespaceName.
 
     Class packageQuerySignal answer:package
     do:[
-        createdClass := 
-            superclass
-                subclass: (namespacePrefix,newClassName) asSymbol 
-                instanceVariableNames: dialog instVarNamesHolder value 
-                classVariableNames: dialog classVarNamesHolder value 
-                poolDictionaries: ' '
-                category: category.
-
-        dialog classInstVarNamesHolder value notEmptyOrNil ifTrue:[
-            createdClass class instanceVariableNames: dialog classInstVarNamesHolder value
-        ].
-    ].
-
+        |builder|
+
+"/        createdClass := 
+"/            superclass
+"/                subclass: (namespacePrefix,newClassName) asSymbol 
+"/                instanceVariableNames: dialog instVarNamesHolder value 
+"/                classVariableNames: dialog classVarNamesHolder value 
+"/                poolDictionaries: ' '
+"/                category: category.
+"/
+"/        dialog classInstVarNamesHolder value notEmptyOrNil ifTrue:[
+"/            createdClass class instanceVariableNames: dialog classInstVarNamesHolder value
+"/        ].
+
+        builder := ClassBuilder new.
+        builder metaclass:(language metaClass).
+        builder 
+            name:(namespacePrefix,newClassName) asSymbol 
+            inEnvironment:namespace 
+            subclassOf:superclass 
+            instanceVariableNames:(dialog instVarNamesHolder value) 
+            variable:false 
+            words:false 
+            pointers:false 
+            classVariableNames:(dialog classVarNamesHolder value) 
+            poolDictionaries:'' 
+            category:category 
+            comment:nil 
+            changed:true 
+            classInstanceVariableNames:(dialog classInstVarNamesHolder value).
+        createdClass := builder buildClass.
+    ].
+
+    createdClass isNil ifTrue:[^ self ].
     self switchToClass:createdClass.
 
     Class packageQuerySignal answer:package
@@ -21248,6 +21276,8 @@
                 ].
             ].
     ].
+
+    "Modified: / 30-01-2011 / 10:46:01 / cg"
 !
 
 classMenuPrimitiveCode:aspect
@@ -22280,15 +22310,20 @@
 generateUndoableChange:nameOfOperation overClasses:classes via:aBlock
     "helper for code generators"
 
-    |generator count dict className|
+    |generator count dict className codeGeneratorClass|
 
     "/ remove this a.s.a.p
     (classes conform:[:cls | |lang| lang := cls programmingLanguage. lang isSmalltalk or:[lang isSTXJavaScript]]) ifFalse:[
         Dialog warn:('Sorry.\\For now, this works only for Smalltalk classes.' withCRs).
         ^ self.
     ].
-
-    generator := classes first programmingLanguage codeGeneratorToolClass "CodeGeneratorTool" new.
+    codeGeneratorClass := classes first programmingLanguage codeGeneratorToolClass.
+    codeGeneratorClass isNil ifTrue:[
+        Dialog warn:('Sorry.\\For now, there seems to be no codeGeneratorClass defined for this language.' withCRs).
+        ^ self.
+    ].
+
+    generator := codeGeneratorClass new.
     generator startCollectChanges.
 
     count := 0.
@@ -22326,6 +22361,8 @@
             generator executeCollectedChangesNamed:(nameOfOperation expandPlaceholdersWith:dict)
         ]
     ]
+
+    "Modified: / 30-01-2011 / 10:43:55 / cg"
 !
 
 generateUndoableChangeOverSelectedClasses:nameOfOperation via:aBlock
@@ -44800,11 +44837,11 @@
 !NewSystemBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1502 2011-01-28 09:29:50 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1503 2011-01-30 09:56:43 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1502 2011-01-28 09:29:50 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1503 2011-01-30 09:56:43 cg Exp $'
 ! !
 
 NewSystemBrowser initialize!