diff -r c284507a1279 -r bec4c94bc628 Tools__ProjectBuilderAssistantApplication.st --- a/Tools__ProjectBuilderAssistantApplication.st Thu Oct 22 19:34:21 2009 +0200 +++ b/Tools__ProjectBuilderAssistantApplication.st Thu Oct 22 21:07:18 2009 +0200 @@ -3,16 +3,18 @@ "{ NameSpace: Tools }" AssistantApplication subclass:#ProjectBuilderAssistantApplication - instanceVariableNames:'packageToBuildHolder projectType selectedProjectIndexHolder - selectedProjectDefinition listOfMatchingProjects - selectedProjectsComment newProjectsName hideSTXProjects + instanceVariableNames:'packageToBuildHolder projectType projectTypeHolder + selectedProjectIndexHolder selectedProjectDefinition + listOfMatchingProjects selectedProjectsComment + hasProjectSelectedHolder newProjectsName hideSTXProjects startMakeButtonEnabled stopMakeButtonVisible makeOutputHolder newApplicationsName listOfApplicationsInProject selectedApplicationIndexHolder selectedApplication - listOfStartupClassesInProject selectedStartupClassIndexHolder - selectedStartupClass selectedApplicationsComment + hasApplicationSelectedHolder listOfStartupClassesInProject + selectedStartupClassIndexHolder selectedStartupClass + hasStartupClassSelectedHolder selectedApplicationsComment buildDirectoryHolder makeProcess listOfClassesInProject - makeOutputWindow projectBuilder' + makeOutputWindow projectBuilder newStartupClassName' classVariableNames:'' poolDictionaries:'' category:'System-Support-Projects' @@ -75,7 +77,7 @@ label: 'GUI Application' name: 'RadioButton1' translateLabel: true - model: projectType + model: projectTypeHolder isTriggerOnDown: true onCallBackSelector: projectTypeChanged select: guiApplicationType @@ -85,7 +87,7 @@ label: 'Non-GUI Application' name: 'RadioButton2' translateLabel: true - model: projectType + model: projectTypeHolder isTriggerOnDown: true onCallBackSelector: projectTypeChanged select: nonGuiApplicationType @@ -95,7 +97,7 @@ label: 'Class Library' name: 'RadioButton3' translateLabel: true - model: projectType + model: projectTypeHolder isTriggerOnDown: true onCallBackSelector: projectTypeChanged select: libraryType @@ -148,7 +150,7 @@ (CheckBoxSpec label: 'Hide ST/X Base Packages' name: 'CheckBox1' - layout: (LayoutFrame -1 0 -18 1 275 0 4 1) + layout: (LayoutFrame -1 0 -18 1 0 1 4 1) model: hideSTXProjects translateLabel: true ) @@ -200,7 +202,7 @@ collection: ( (InputFieldSpec name: 'EntryField1' - layout: (LayoutFrame 1 0 6 0 210 0 28 0) + layout: (LayoutFrame 1 0 6 0 -113 1 28 0) model: newProjectsName acceptOnReturn: true acceptOnTab: true @@ -210,7 +212,7 @@ (ActionButtonSpec label: 'Create' name: 'Button1' - layout: (LayoutFrame 216 0 6 0 341 0 28 0) + layout: (LayoutFrame -100 1 6 0 2 1 28 0) translateLabel: true model: createNewProject ) @@ -258,7 +260,7 @@ (CheckBoxSpec label: 'Hide ST/X Base Packages' name: 'CheckBox1' - layout: (LayoutFrame -1 0 -17 1 275 0 5 1) + layout: (LayoutFrame -1 0 -17 1 0 1 5 1) model: hideSTXProjects translateLabel: true ) @@ -281,6 +283,7 @@ name: 'Button3' translateLabel: true model: doBrowseProject + enableChannel: hasProjectSelectedHolder extent: (Point 180 22) ) ) @@ -331,7 +334,7 @@ collection: ( (InputFieldSpec name: 'EntryField1' - layout: (LayoutFrame 1 0 6 0 210 0 28 0) + layout: (LayoutFrame 1 0 6 0 -113 1 28 0) model: newApplicationsName acceptOnReturn: true acceptOnTab: true @@ -341,7 +344,7 @@ (ActionButtonSpec label: 'Create' name: 'Button1' - layout: (LayoutFrame 216 0 6 0 341 0 28 0) + layout: (LayoutFrame -100 1 6 0 1 1 28 0) translateLabel: true model: createNewApplication ) @@ -405,6 +408,15 @@ name: 'Button3' translateLabel: true model: doBrowseApplication + enableChannel: hasApplicationSelectedHolder + extent: (Point 180 22) + ) + (ActionButtonSpec + label: 'Launch Selected Application' + name: 'Button4' + translateLabel: true + model: doLaunchApplication + enableChannel: hasApplicationSelectedHolder extent: (Point 180 22) ) ) @@ -455,7 +467,7 @@ collection: ( (InputFieldSpec name: 'EntryField1' - layout: (LayoutFrame 1 0 6 0 210 0 28 0) + layout: (LayoutFrame 1 0 6 0 -113 1 28 0) model: newStartupClassName acceptOnReturn: true acceptOnTab: true @@ -465,7 +477,7 @@ (ActionButtonSpec label: 'Create' name: 'Button1' - layout: (LayoutFrame 216 0 6 0 341 0 28 0) + layout: (LayoutFrame -100 1 6 0 1 1 28 0) translateLabel: true model: createNewStartupClass ) @@ -529,6 +541,7 @@ name: 'Button3' translateLabel: true model: doBrowseStartupClass + enableChannel: hasStartupClassSelectedHolder extent: (Point 180 22) ) ) @@ -604,7 +617,7 @@ label: 'Browse Project Definition' name: 'Button3' translateLabel: true - model: doBrowseProject + model: doBrowseProjectDefinitionClass extent: (Point 180 22) ) (ActionButtonSpec @@ -857,17 +870,19 @@ ^ self ]. - Class packageQuerySignal answer:(selectedProjectDefinition package) - do:[ - newAppClass := ApplicationModel - subclass:newAppName asSymbol - instanceVariableNames:'' - classVariableNames:'' - poolDictionaries:'' - category:'Applications'. - CodeGeneratorTool createApplicationCodeFor:newAppClass. + self withWaitCursorDo:[ + Class packageQuerySignal answer:(selectedProjectDefinition package) + do:[ + newAppClass := ApplicationModel + subclass:newAppName asSymbol + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'Applications'. + CodeGeneratorTool createApplicationCodeFor:newAppClass. + ]. + self updateListOfApplicationsInProject ]. - self updateListOfApplicationsInProject ! createNewProject @@ -880,8 +895,12 @@ Dialog warn:'Please enter a packageID first.'. ^ self ]. + newProjectID asPackageId isModuleId ifTrue:[ + Dialog warn:'Please enter a corrent packageID (module:directory).'. + ^ self + ]. - projectDefinitionType := ProjectDefinition perform:(self projectType value). + projectDefinitionType := ProjectDefinition perform:(self projectTypeHolder value). projectDefinitionClass := ProjectDefinition @@ -897,14 +916,14 @@ projectClasses := projectDefinitionClass allClassNames collect:[:nm |Smalltalk classNamed:nm]. - projectDefinitionClass isGUIApplication ifTrue:[ - "/ see if it has an AppModel class - (projectClasses contains:[:cls | cls isVisualStartable]) ifFalse:[ - (Dialog confirm:'Create an Application Class ?') ifTrue:[ -self halt. - ]. - ]. - ]. +"/ projectDefinitionClass isGUIApplication ifTrue:[ +"/ "/ see if it has an AppModel class +"/ (projectClasses contains:[:cls | cls isVisualStartable]) ifFalse:[ +"/ (Dialog confirm:'Create an Application Class ?') ifTrue:[ +"/ self halt. +"/ ]. +"/ ]. +"/ ]. "/ projectDefinitionClass isLibrary ifFalse:[ "/ "/ see if it has a Startup class @@ -913,6 +932,32 @@ "/ ]. ! +createNewStartupClass + + + |newClassName newStartupClass| + + newClassName := self newStartupClassName value. + newClassName isEmptyOrNil ifTrue:[ + Dialog warn:'Please enter the name of the Startup-Class first.'. + ^ self + ]. + + self withWaitCursorDo:[ + Class packageQuerySignal answer:(selectedProjectDefinition package) + do:[ + newStartupClass := StandaloneStartup + subclass:newClassName asSymbol + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'Applications'. + CodeGeneratorTool createStartupCodeFor:newStartupClass forStartOf:selectedApplication. + ]. + self updateListOfStartupClassesInProject + ]. +! + doAddClassToProject @@ -925,8 +970,11 @@ |appClass| - appClass := self listOfApplicationsInProject value at:(self selectedApplicationIndexHolder value). - UserPreferences systemBrowserClass openInClass:appClass. + self hasApplicationSelected ifTrue:[ + appClass := self listOfApplicationsInProject value at:(self selectedApplicationIndexHolder value). + UserPreferences systemBrowserClass + openInClass:appClass. + ]. ! doBrowseProject @@ -935,10 +983,45 @@ UserPreferences systemBrowserClass openOnPackage:selectedProjectDefinition package. ! +doBrowseProjectDefinitionClass + + + |defClass| + + self hasProjectSelected ifTrue:[ + defClass := self selectedProjectDefinition. + UserPreferences systemBrowserClass + openInClass:defClass class selector:#classNamesAndAttributes. + ]. +! + +doBrowseStartupClass + + + |startupClass| + + self hasStartupClassSelected ifTrue:[ + startupClass := self listOfStartupClassesInProject value at:(self selectedStartupClassIndexHolder value). + UserPreferences systemBrowserClass + openInClass:startupClass. + ]. +! + doGenerateProjectContentsDefinition self generatePackageContentsMethods ! +doLaunchApplication + + + |appClass| + + self hasApplicationSelected ifTrue:[ + appClass := self listOfApplicationsInProject value at:(self selectedApplicationIndexHolder value). + appClass open. + ]. +! + doOpenExplorer OperatingSystem openApplicationForDocument:(projectBuilder packageBuildDirectory) operation:#explore. @@ -981,28 +1064,11 @@ makeOutputWindow endEntry. makeOutputWindow cr. - makeOutputWindow nextPutLine:('Make Cancelled' emphasizeAllWith:{#backgroundColor->Color red. #color->Color white.}). + makeOutputWindow nextPutLine:('Make Cancelled' colorizeAllWith:Color white on:Color red). makeOutputWindow endEntry. ]. ! -generatePackageContentsMethods - - - Class packageQuerySignal answer:(selectedProjectDefinition package) - do:[ - selectedProjectDefinition - forEachContentsMethodsCodeToCompileDo:[:code :category | - CodeGeneratorTool - compile:code - forClass:selectedProjectDefinition theMetaclass - inCategory:category. - ] - ignoreOldDefinition:true - ]. - self updateListOfClassesInProject -! - projectTypeChanged @@ -1019,7 +1085,7 @@ ex messageText notNil ifTrue:[ makeOutputWindow endEntry. makeOutputWindow cr. - makeOutputWindow nextPutLine:(ex messageText emphasizeAllWith:{#backgroundColor->Color blue. #color->Color white.}). + makeOutputWindow nextPutLine:(ex messageText colorizeAllWith:Color white on:Color blue). makeOutputWindow endEntry. ]. ex proceed. @@ -1036,6 +1102,8 @@ ] ifFalse:[ selectedApplication := self listOfApplicationsInProject value at:(self selectedApplicationIndexHolder value). ]. + self hasApplicationSelectedHolder value:(selectedApplication notNil). + "/ selectedApplication notNil ifTrue:[ "/ "/ generate startupClass code "/ CodeGeneratorTool @@ -1053,6 +1121,8 @@ ] ifFalse:[ selectedProjectDefinition := self listOfMatchingProjects value at:(self selectedProjectIndexHolder value). ]. + self hasProjectSelectedHolder value:(selectedProjectDefinition notNil). + self updateComment. self updateListOfApplicationsInProject. self updateButtonEnableState. @@ -1064,6 +1134,8 @@ ] ifFalse:[ selectedStartupClass := self listOfStartupClassesInProject value at:(self selectedStartupClassIndexHolder value). ]. + self hasStartupClassSelectedHolder value:(selectedStartupClass notNil). + selectedStartupClass notNil ifTrue:[ "/ generate startupClass code CodeGeneratorTool @@ -1109,16 +1181,31 @@ ^ browser. ! -hasBuildDirectorySpecified - ^ self buildDirectoryHolder value notEmptyOrNil +hasApplicationSelectedHolder + + + hasApplicationSelectedHolder isNil ifTrue:[ + hasApplicationSelectedHolder := nil asValue. + ]. + ^ hasApplicationSelectedHolder. ! -hasProjectBuilder - ^ projectBuilder notNil +hasProjectSelectedHolder + + + hasProjectSelectedHolder isNil ifTrue:[ + hasProjectSelectedHolder := nil asValue. + ]. + ^ hasProjectSelectedHolder. ! -hasProjectSelected - ^ self selectedProjectIndexHolder value notNil +hasStartupClassSelectedHolder + + + hasStartupClassSelectedHolder isNil ifTrue:[ + hasStartupClassSelectedHolder := nil asValue. + ]. + ^ hasStartupClassSelectedHolder. ! hideSTXProjects @@ -1204,18 +1291,60 @@ ^ newProjectsName. ! -projectType +newStartupClassName - projectType isNil ifTrue:[ - projectType := RadioButtonGroup new. - projectType value:#guiApplicationType. + newStartupClassName isNil ifTrue:[ + newStartupClassName := ValueHolder new. + ]. + ^ newStartupClassName. +! + +projectType + self projectTypeHolder value == #libraryType ifTrue:[ + ^ ProjectDefinition libraryType + ]. + self projectTypeHolder value == #guiApplicationType ifTrue:[ + ^ ProjectDefinition guiApplicationType + ]. + self projectTypeHolder value == #nonGuiApplicationType ifTrue:[ + ^ ProjectDefinition nonGuiApplicationType ]. - ^ projectType. + self error. +! + +projectType:aProjectTypeSymbol + |pType| + + self assert:(ProjectDefinition projectTypes includes:aProjectTypeSymbol). + aProjectTypeSymbol == ProjectDefinition libraryType ifTrue:[ + pType := #libraryType + ] ifFalse:[ + aProjectTypeSymbol == ProjectDefinition guiApplicationType ifTrue:[ + pType := #guiApplicationType + ] ifFalse:[ + aProjectTypeSymbol == ProjectDefinition nonGuiApplicationType ifTrue:[ + pType := #nonGuiApplicationType + ] ifFalse:[ + self error. + ]. + ] + ]. + self projectTypeHolder value:aProjectTypeSymbol +! + +projectTypeHolder + + + projectTypeHolder isNil ifTrue:[ + projectTypeHolder := RadioButtonGroup new. + projectTypeHolder value:#guiApplicationType. + ]. + ^ projectTypeHolder. ! projectTypeIsNotLibrary - ^ self projectType value ~~ #libraryType + ^ self projectTypeHolder value ~~ #libraryType ! selectedApplicationIndexHolder @@ -1318,6 +1447,12 @@ super release ! ! +!ProjectBuilderAssistantApplication methodsFor:'menu actions'! + +openDocumentation + self openHTMLDocument:'tools/misc/TOP.html#PACKAGER'. +! ! + !ProjectBuilderAssistantApplication methodsFor:'private'! commentFromClass:aClass @@ -1340,6 +1475,43 @@ comment := comment asString. ]. ^ comment +! + +generatePackageContentsMethods + + + Class packageQuerySignal answer:(selectedProjectDefinition package) + do:[ + selectedProjectDefinition + forEachContentsMethodsCodeToCompileDo:[:code :category | + CodeGeneratorTool + compile:code + forClass:selectedProjectDefinition theMetaclass + inCategory:category. + ] + ignoreOldDefinition:true + ]. + self updateListOfClassesInProject +! + +hasApplicationSelected + ^ self selectedApplicationIndexHolder value notNil +! + +hasBuildDirectorySpecified + ^ self buildDirectoryHolder value notEmptyOrNil +! + +hasProjectBuilder + ^ projectBuilder notNil +! + +hasProjectSelected + ^ self selectedProjectIndexHolder value notNil +! + +hasStartupClassSelected + ^ self selectedStartupClassIndexHolder value notNil ! ! !ProjectBuilderAssistantApplication methodsFor:'queries'! @@ -1352,12 +1524,18 @@ ^ self hasBuildDirectorySpecified ! +canEnterContentsSelection + ^ self hasProjectSelected + and:[ self hasApplicationSelected + and:[ self hasStartupClassSelected ]] +! + canEnterDeploy ^ self hasProjectBuilder ! canEnterStartupClassSelection - ^ self hasProjectSelected + ^ self hasProjectSelected and:[ self hasApplicationSelected ] ! ! !ProjectBuilderAssistantApplication methodsFor:'specs'! @@ -1368,12 +1546,16 @@ pageTitle: 'Project Type Selection' windowSpecSelector: page1_projectTypeSelectionSpec enterCallbackSelector: updateListOfMatchingProjects + infoText: 'Choose the type of project you are about to build.' ) (AssistantPageSpec pageTitle: 'Project Selection' windowSpecSelector: page2_projectSelectionSpec enterCallbackSelector: updateListOfMatchingProjects + infoText: 'Choose an existing project or create a new one. + These are subclasses of ProjectDefinition and define the + type and contents of a project.' ) (AssistantPageSpec @@ -1382,6 +1564,9 @@ isEnabledQuerySelector: #projectTypeIsNotLibrary canEnterQuerySelector: #canEnterApplicationSelection enterCallbackSelector: updateListOfApplicationsInProject + infoText: 'Choose an existing application or create a new one. + These are subclasses of ApplicationModel and define + the GUI and control flow inside the application.' ) (AssistantPageSpec @@ -1390,17 +1575,29 @@ isEnabledQuerySelector: #projectTypeIsNotLibrary canEnterQuerySelector: #canEnterStartupClassSelection enterCallbackSelector: updateListOfStartupClassesInProject + infoText: 'Choose an existing startup-class or create a new one. + These are subclasses of StandaloneStartup and + start the application. Command line arguments can be + interpreted there.' ) (AssistantPageSpec pageTitle: 'Specify Contents' windowSpecSelector: page5_specifyIncludedClasses enterCallbackSelector: updateListOfClassesInProject + canEnterQuerySelector: #canEnterContentsSelection + infoText: 'Define which (other) classes are to be included. + Press "Scan" to include all classes of the package; + browse to edit the contents manually.' ) (AssistantPageSpec pageTitle: 'Specify Build Directory' windowSpecSelector: page6_specifyBuildDirectorySpec + infoText: 'Define where the build-process is to be performed. + All generated files are created below that directory. + After deployment, the build directory is no longer needed + (but you can keep it for a faster compile the next time).' ) (AssistantPageSpec @@ -1409,12 +1606,20 @@ canEnterQuerySelector: #canEnterBuild enterCallbackSelector: #restoreMakeOutputsContents leaveCallbackSelector: #rememberMakeOutputsContents + infoText: 'Start the build-process. This will run make/bcc to compile + all required classes and nsis to generate a self-installable + executable. You must have the borland-cc and NullSoft NSIS + packages installed for this to work.' ) (AssistantPageSpec pageTitle: 'Deploy' windowSpecSelector: page8_deploySpec canEnterQuerySelector: #canEnterDeploy + infoText: 'Find the installer to be deployed (or test-run the binary). + You can open a WindowsExplorer there to copy the files for + deployment. After that, the build directory is no longer needed + (but you can keep it for a faster compile the next time).' ) ) decodeAsLiteralArray. ! ! @@ -1489,7 +1694,7 @@ applicationClasses := applicationClasses asOrderedCollection. applicationClasses sort:[:a :b | a name < b name]. - startUpClassName := selectedProjectDefinition startupClassName. + startUpClassName := [ selectedProjectDefinition startupClassName ] ifError:[ nil ]. startUpClassName notNil ifTrue:[ startUpClass := Smalltalk classNamed:startUpClassName. startUpClass notNil ifTrue:[ @@ -1510,7 +1715,7 @@ updateListOfMatchingProjects |matching projectType idx| - projectType := self projectType value. + projectType := self projectType. matching := ProjectDefinition allSubclasses select:[:defClass | |match| @@ -1520,13 +1725,13 @@ (self hideSTXProjects value not or:[ defClass package asPackageId module ~= 'stx' ]) ifTrue:[ - projectType == #libraryType ifTrue:[ + projectType == ProjectDefinition libraryType ifTrue:[ match := defClass isLibraryDefinition ] ifFalse:[ - projectType == #guiApplicationType ifTrue:[ + projectType == ProjectDefinition guiApplicationType ifTrue:[ match := defClass isGUIApplication ] ifFalse:[ - projectType == #nonGuiApplicationType ifTrue:[ + projectType == ProjectDefinition nonGuiApplicationType ifTrue:[ match := defClass isConsoleApplication ] ifFalse:[ self error. @@ -1545,6 +1750,39 @@ ] ifFalse:[ self selectedProjectIndexHolder value:idx. ]. +! + +updateListOfStartupClassesInProject + |startupClasses package startUpClassName startUpClass startupClassIndex| + + startupClassIndex := nil. + self selectedStartupClassIndexHolder value:nil. + + selectedProjectDefinition isNil ifTrue:[ + startupClasses := #() + ] ifFalse:[ + package := selectedProjectDefinition package. + + startupClasses := Smalltalk allClasses + select:[:cls | + (cls package = package + and:[ cls isSubclassOf:StandaloneStartup ]) + ]. + startupClasses := startupClasses asOrderedCollection. + startupClasses sort:[:a :b | a name < b name]. + + startUpClassName := [ selectedProjectDefinition startupClassName ] ifError:[ nil ]. + startUpClassName notNil ifTrue:[ + startUpClass := Smalltalk classNamed:startUpClassName. + startUpClass notNil ifTrue:[ + startupClassIndex := startupClasses indexOf:startUpClass. + startupClassIndex == 0 ifTrue:[ startupClassIndex := nil ]. + ]. + ]. + ]. + self listOfStartupClassesInProject value:startupClasses. + + self selectedStartupClassIndexHolder value:startupClassIndex. ! ! !ProjectBuilderAssistantApplication class methodsFor:'documentation'!