--- 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
+ <resource: #uiCallback>
+
+ |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
<resource: #uiCallback>
@@ -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
+ <resource: #uiCallback>
+
+ |defClass|
+
+ self hasProjectSelected ifTrue:[
+ defClass := self selectedProjectDefinition.
+ UserPreferences systemBrowserClass
+ openInClass:defClass class selector:#classNamesAndAttributes.
+ ].
+!
+
+doBrowseStartupClass
+ <resource: #uiCallback>
+
+ |startupClass|
+
+ self hasStartupClassSelected ifTrue:[
+ startupClass := self listOfStartupClassesInProject value at:(self selectedStartupClassIndexHolder value).
+ UserPreferences systemBrowserClass
+ openInClass:startupClass.
+ ].
+!
+
doGenerateProjectContentsDefinition
self generatePackageContentsMethods
!
+doLaunchApplication
+ <resource: #uiCallback>
+
+ |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
- <resource: #uiCallback>
-
- Class packageQuerySignal answer:(selectedProjectDefinition package)
- do:[
- selectedProjectDefinition
- forEachContentsMethodsCodeToCompileDo:[:code :category |
- CodeGeneratorTool
- compile:code
- forClass:selectedProjectDefinition theMetaclass
- inCategory:category.
- ]
- ignoreOldDefinition:true
- ].
- self updateListOfClassesInProject
-!
-
projectTypeChanged
<resource: #uiCallback>
@@ -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
+ <resource: #uiAspect>
+
+ hasApplicationSelectedHolder isNil ifTrue:[
+ hasApplicationSelectedHolder := nil asValue.
+ ].
+ ^ hasApplicationSelectedHolder.
!
-hasProjectBuilder
- ^ projectBuilder notNil
+hasProjectSelectedHolder
+ <resource: #uiAspect>
+
+ hasProjectSelectedHolder isNil ifTrue:[
+ hasProjectSelectedHolder := nil asValue.
+ ].
+ ^ hasProjectSelectedHolder.
!
-hasProjectSelected
- ^ self selectedProjectIndexHolder value notNil
+hasStartupClassSelectedHolder
+ <resource: #uiAspect>
+
+ hasStartupClassSelectedHolder isNil ifTrue:[
+ hasStartupClassSelectedHolder := nil asValue.
+ ].
+ ^ hasStartupClassSelectedHolder.
!
hideSTXProjects
@@ -1204,18 +1291,60 @@
^ newProjectsName.
!
-projectType
+newStartupClassName
<resource: #uiAspect>
- 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
+ <resource: #uiAspect>
+
+ 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
+ <resource: #uiCallback>
+
+ 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 <I>ProjectDefinition</I> 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 <I>ApplicationModel</I> 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 <I>StandaloneStartup</I> 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 "<I>Scan</I>" 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'!