NewSystemBrowser.st
changeset 6050 300b21c10c71
parent 6049 52a035d239a6
child 6053 d6802f302d78
--- a/NewSystemBrowser.st	Wed Sep 29 13:29:55 2004 +0200
+++ b/NewSystemBrowser.st	Thu Sep 30 12:31:18 2004 +0200
@@ -5399,6 +5399,11 @@
                   translateLabel: true
                 )
                (MenuItem
+                  label: 'WebApplication'
+                  itemValue: classMenuNewWebApplication
+                  translateLabel: true
+                )
+               (MenuItem
                   label: 'Dialog'
                   itemValue: classMenuNewDialog
                   translateLabel: true
@@ -5692,7 +5697,7 @@
                   translateLabel: true
                 )
                (MenuItem
-                  enabled: hasApplicationClassSelectedHolder
+                  enabled: hasApplicationOrHTTPServiceClassSelectedHolder
                   label: 'Application Code'
                   itemValue: classMenuGenerateApplicationCode
                   translateLabel: true
@@ -11270,6 +11275,13 @@
     "Created: / 4.2.2000 / 22:02:53 / cg"
 !
 
+hasApplicationOrHTTPServiceClassSelectedHolder
+    ^ [ self hasApplicationClassSelected 
+        | self hasWebApplicationClassSelected]
+
+    "Created: / 4.2.2000 / 22:02:53 / cg"
+!
+
 hasAtMostOneClassesSelected
     ^ self selectedClasses value size <= 1
 !
@@ -12482,6 +12494,14 @@
 
 !
 
+hasWebApplicationClassSelected
+    |selectedClasses|
+
+    selectedClasses := self selectedClasses value.
+    selectedClasses size == 0 ifTrue:[^ false].
+    ^ selectedClasses conform:[:each | each theNonMetaclass isSubclassOf:HTTPService].
+!
+
 haskellModulePresent
     ^ HaskellModule notNil and:[HaskellParser notNil]
 !
@@ -16813,7 +16833,14 @@
     self 
         generateUndoableChangeOverSelectedClasses:'Generate ApplicationCode in %(singleClassNameOrNumberOfClasses)' 
         via:[:generator :eachClass |
-            generator createApplicationCodeFor:eachClass theNonMetaclass 
+            |cls|
+
+            cls := eachClass theNonMetaclass.
+            (cls isSubclassOf:HTTPService) ifTrue:[
+                generator createWebApplicationCodeFor:cls.
+            ] ifFalse:[
+                generator createApplicationCodeFor:cls 
+            ]
         ]
 !
 
@@ -17467,6 +17494,18 @@
     self codeAspect:#newTestCase.
 !
 
+classMenuNewWebApplication
+    "create a class-definition prototype for a web application"
+
+    self 
+        classClassDefinitionTemplateFor:HTTPActionService 
+        in:(self theSingleSelectedCategory ? 'WebApplications') 
+        asNamespace:false 
+        private:false.
+
+    self codeAspect:#newWebApplication.
+!
+
 classMenuPrimitiveCode:aspect
     "show the classes primitiveFunction in the codeView.
      Also, set accept action to change it."
@@ -35531,6 +35570,41 @@
     ^ returnValue.
 !
 
+askForInitialApplicationCodeFor:aClass
+    |cls mcls codeAspect msg|
+
+    cls := aClass theNonMetaclass.
+    mcls := aClass theMetaclass.
+
+    codeAspect := self codeAspect.
+    codeAspect == #newApplication
+    ifTrue:[ msg := 'Generate initial application code ?' ].
+
+    codeAspect == #newDialog
+    ifTrue:[ msg := 'Generate initial dialog code ?' ].
+
+    codeAspect == #newWebApplication
+    ifTrue:[ msg := 'Generate initial webApplication code ?' ].
+
+    (msg notNil and:[self confirm:(resources string:msg)])
+    ifTrue:[
+        CodeGeneratorTool createDocumentationMethodsFor:mcls.
+        (codeAspect == #newWebApplication) ifTrue:[
+            CodeGeneratorTool createWebApplicationCodeFor:cls.
+        ] ifFalse:[
+            CodeGeneratorTool createExamplesMethodFor:mcls.
+            CodeGeneratorTool createApplicationCodeFor:cls.
+        ].
+        ^ self.
+    ].
+
+    (codeAspect == #newTestCase) ifTrue:[
+        CodeGeneratorTool createDocumentationMethodsFor:mcls.
+        CodeGeneratorTool createTestCaseSampleCodeFor:cls.
+        ^ self.
+    ]
+!
+
 checkCodeQuality:code
     |col|
 
@@ -35734,18 +35808,7 @@
                             returnValue ifTrue:[
                                 cls := rslt theNonMetaclass.
                                 mcls := rslt theMetaclass.
-                                (((self codeAspect == #newApplication) and:[self confirm:'Generate initial application code ?'])
-                                or:[ (self codeAspect == #newDialog) and:[self confirm:'Generate initial dialog code ?']]) 
-                                ifTrue:[
-                                    CodeGeneratorTool createDocumentationMethodsFor:mcls.
-                                    CodeGeneratorTool createExamplesMethodFor:mcls.
-                                    CodeGeneratorTool createApplicationCodeFor:cls.
-                                ].
-
-                                (self codeAspect == #newTestCase) ifTrue:[
-                                    CodeGeneratorTool createDocumentationMethodsFor:mcls.
-                                    CodeGeneratorTool createTestCaseSampleCodeFor:cls.
-                                ]
+                                self askForInitialApplicationCodeFor:mcls.
                             ].
                         ]
                     ]
@@ -36291,7 +36354,7 @@
 !NewSystemBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.784 2004-09-29 11:29:55 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.785 2004-09-30 10:31:10 ca Exp $'
 ! !
 
 NewSystemBrowser initialize!