added: #documentation
changed:
#doBrowseApplication
#doBrowseStartupClass
#updateListOfApplicationsInProject
"{ Package: 'stx:libtool2' }"
"{ NameSpace: Tools }"
AssistantApplication subclass:#ProjectBuilderAssistantApplication
instanceVariableNames:'packageToBuildHolder projectType projectTypeHolder
selectedProjectIndexHolder selectedProjectDefinition
listOfMatchingProjects selectedProjectsComment
hasProjectSelectedHolder newProjectsName hideSTXProjects
startMakeButtonEnabled stopMakeButtonVisible makeOutputHolder
newApplicationsName listOfApplicationsInProject
selectedApplicationIndexHolder selectedApplication
hasApplicationSelectedHolder listOfStartupClassesInProject
selectedStartupClassIndexHolder selectedStartupClass
hasStartupClassSelectedHolder selectedApplicationsComment
buildDirectoryHolder makeProcess listOfClassesInProject
makeOutputWindow projectBuilder newStartupClassName'
classVariableNames:''
poolDictionaries:''
category:'System-Support-Projects'
!
!ProjectBuilderAssistantApplication class methodsFor:'documentation'!
documentation
"
a user friendly interface to the build process.
Simply wraps up existing tools like the CodeGeneratorTool, the browsers
and the ProjetBuilder
[see also:]
CodeGeneratorTool
ProjectBuilder
ProjectDefinition
[author:]
Claus Gittinger
"
! !
!ProjectBuilderAssistantApplication class methodsFor:'interface specs'!
page1_projectTypeSelectionSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::ProjectBuilderAssistantApplication andSelector:#page1_projectTypeSelectionSpec
Tools::ProjectBuilderAssistantApplication new openInterface:#page1_projectTypeSelectionSpec
"
<resource: #canvas>
^
#(FullSpec
name: #'page1_projectTypeSelectionSpec'
window:
(WindowSpec
label: 'Project Selection'
name: 'Project Selection'
min: (Point 0 0)
bounds: (Rectangle 0 0 626 394)
)
component:
(SpecCollection
collection: (
(FramedBoxSpec
label: 'Project Type Filter'
name: 'FramedBox1'
layout: (LayoutFrame 0 0.0 0 0 4 1.0 105 0)
labelPosition: topLeft
translateLabel: true
component:
(SpecCollection
collection: (
(VerticalPanelViewSpec
name: 'VerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
horizontalLayout: leftSpace
verticalLayout: topSpace
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(ViewSpec
name: 'Box1'
extent: (Point 10 10)
)
(RadioButtonSpec
label: 'GUI Application'
name: 'RadioButton1'
translateLabel: true
model: projectTypeHolder
isTriggerOnDown: true
onCallBackSelector: projectTypeChanged
select: guiApplicationType
extent: (Point 136 22)
)
(RadioButtonSpec
label: 'Non-GUI Application'
name: 'RadioButton2'
translateLabel: true
model: projectTypeHolder
isTriggerOnDown: true
onCallBackSelector: projectTypeChanged
select: nonGuiApplicationType
extent: (Point 136 22)
)
(RadioButtonSpec
label: 'Class Library'
name: 'RadioButton3'
translateLabel: true
model: projectTypeHolder
isTriggerOnDown: true
onCallBackSelector: projectTypeChanged
select: libraryType
extent: (Point 136 22)
)
)
)
)
)
)
)
(FramedBoxSpec
label: 'Existing Projects'
name: 'FramedBox2'
layout: (LayoutFrame 0 0.0 105 0 4 1.0 0 1)
labelPosition: topLeft
translateLabel: true
component:
(SpecCollection
collection: (
(VariableHorizontalPanelSpec
name: 'VariableHorizontalPanel1'
layout: (LayoutFrame 0 0 4 0 0 1 -26 1)
component:
(SpecCollection
collection: (
(SequenceViewSpec
name: 'List1'
model: selectedProjectIndexHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
useIndex: true
sequenceList: listOfMatchingProjects
)
(TextEditorSpec
name: 'TextEditor1'
model: selectedProjectsComment
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
isReadOnly: true
hasKeyboardFocusInitially: false
)
)
)
handles: (Any 0.34560327198364 1.0)
)
(CheckBoxSpec
label: 'Hide ST/X Base Packages'
name: 'CheckBox1'
layout: (LayoutFrame -1 0 -18 1 0 1 4 1)
model: hideSTXProjects
translateLabel: true
)
)
)
)
)
)
)
!
page2_projectSelectionSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::ProjectBuilderAssistantApplication andSelector:#page2_projectSelectionSpec
Tools::ProjectBuilderAssistantApplication new openInterface:#page2_projectSelectionSpec
"
<resource: #canvas>
^
#(FullSpec
name: #'page2_projectSelectionSpec'
window:
(WindowSpec
label: 'Project Selection'
name: 'Project Selection'
min: (Point 0 0)
bounds: (Rectangle 0 0 521 453)
)
component:
(SpecCollection
collection: (
(FramedBoxSpec
label: 'New Project'
name: 'FramedBox3'
layout: (LayoutFrame 0 0.0 5 0 4 1.0 72 0)
labelPosition: topLeft
translateLabel: true
component:
(SpecCollection
collection: (
(InputFieldSpec
name: 'EntryField1'
layout: (LayoutFrame 1 0 6 0 -113 1 28 0)
model: newProjectsName
acceptOnReturn: true
acceptOnTab: true
acceptOnPointerLeave: true
emptyFieldReplacementText: 'module:directory'
)
(ActionButtonSpec
label: 'Create'
name: 'Button1'
layout: (LayoutFrame -100 1 6 0 2 1 28 0)
translateLabel: true
model: createNewProject
)
)
)
)
(FramedBoxSpec
label: 'Existing Projects'
name: 'FramedBox4'
layout: (LayoutFrame 0 0.0 70 0 4 1.0 -30 1)
labelPosition: topLeft
translateLabel: true
component:
(SpecCollection
collection: (
(VariableHorizontalPanelSpec
name: 'VariableHorizontalPanel2'
layout: (LayoutFrame 0 0 4 0 0 1 -26 1)
component:
(SpecCollection
collection: (
(SequenceViewSpec
name: 'List2'
model: selectedProjectIndexHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
useIndex: true
sequenceList: listOfMatchingProjects
)
(TextEditorSpec
name: 'TextEditor2'
model: selectedProjectsComment
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
isReadOnly: true
hasKeyboardFocusInitially: false
viewClassName: 'TextView'
)
)
)
handles: (Any 0.34560327198364 1.0)
)
(CheckBoxSpec
label: 'Hide ST/X Base Packages'
name: 'CheckBox1'
layout: (LayoutFrame -1 0 -17 1 0 1 5 1)
model: hideSTXProjects
translateLabel: true
)
)
)
)
(HorizontalPanelViewSpec
name: 'HorizontalPanel1'
layout: (LayoutFrame 0 0 -30 1 0 1 0 1)
horizontalLayout: leftSpace
verticalLayout: center
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(ActionButtonSpec
label: 'Browse Selected Project'
name: 'Button3'
translateLabel: true
model: doBrowseProject
enableChannel: hasProjectSelectedHolder
extent: (Point 180 22)
)
)
)
)
)
)
)
!
page3_applicationSelectionSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::ProjectBuilderAssistantApplication andSelector:#page3_applicationSelectionSpec
Tools::ProjectBuilderAssistantApplication new openInterface:#page3_applicationSelectionSpec
"
<resource: #canvas>
^
#(FullSpec
name: #'page3_applicationSelectionSpec'
window:
(WindowSpec
label: 'Application Selection'
name: 'Application Selection'
min: (Point 0 0)
bounds: (Rectangle 0 0 521 408)
)
component:
(SpecCollection
collection: (
(FramedBoxSpec
label: 'New Application'
name: 'FramedBox3'
layout: (LayoutFrame 0 0.0 5 0 4 1.0 105 0)
labelPosition: topLeft
translateLabel: true
component:
(SpecCollection
collection: (
(InputFieldSpec
name: 'EntryField1'
layout: (LayoutFrame 1 0 6 0 -113 1 28 0)
model: newApplicationsName
acceptOnReturn: true
acceptOnTab: true
acceptOnPointerLeave: true
emptyFieldReplacementText: 'MyApplication'
)
(ActionButtonSpec
label: 'Create'
name: 'Button1'
layout: (LayoutFrame -100 1 6 0 1 1 28 0)
translateLabel: true
model: createNewApplication
)
)
)
)
(FramedBoxSpec
label: 'Existing Applications'
name: 'FramedBox4'
layout: (LayoutFrame 0 0.0 105 0 4 1.0 -30 1)
labelPosition: topLeft
translateLabel: true
component:
(SpecCollection
collection: (
(VariableHorizontalPanelSpec
name: 'VariableHorizontalPanel2'
layout: (LayoutFrame 0 0 4 0 0 1 0 1)
component:
(SpecCollection
collection: (
(SequenceViewSpec
name: 'List2'
model: selectedApplicationIndexHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
useIndex: true
sequenceList: listOfApplicationsInProject
)
(TextEditorSpec
name: 'TextEditor2'
model: selectedApplicationsComment
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
isReadOnly: true
hasKeyboardFocusInitially: false
viewClassName: 'TextView'
)
)
)
handles: (Any 0.34560327198364 1.0)
)
)
)
)
(HorizontalPanelViewSpec
name: 'HorizontalPanel1'
layout: (LayoutFrame 0 0 -30 1 0 1 0 1)
horizontalLayout: leftSpace
verticalLayout: center
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(ActionButtonSpec
label: 'Browse Selected Application'
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)
)
)
)
)
)
)
)
!
page4_startupClassSelectionSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::ProjectBuilderAssistantApplication andSelector:#page4_startupClassSelectionSpec
Tools::ProjectBuilderAssistantApplication new openInterface:#page4_startupClassSelectionSpec
"
<resource: #canvas>
^
#(FullSpec
name: #'page4_startupClassSelectionSpec'
window:
(WindowSpec
label: 'Startup Class Selection'
name: 'Startup Class Selection'
min: (Point 0 0)
bounds: (Rectangle 0 0 521 408)
)
component:
(SpecCollection
collection: (
(FramedBoxSpec
label: 'New Application'
name: 'FramedBox3'
layout: (LayoutFrame 0 0.0 5 0 4 1.0 105 0)
labelPosition: topLeft
translateLabel: true
component:
(SpecCollection
collection: (
(InputFieldSpec
name: 'EntryField1'
layout: (LayoutFrame 1 0 6 0 -113 1 28 0)
model: newStartupClassName
acceptOnReturn: true
acceptOnTab: true
acceptOnPointerLeave: true
emptyFieldReplacementText: 'MyStandAloneStartup'
)
(ActionButtonSpec
label: 'Create'
name: 'Button1'
layout: (LayoutFrame -100 1 6 0 1 1 28 0)
translateLabel: true
model: createNewStartupClass
)
)
)
)
(FramedBoxSpec
label: 'Existing StartupClasses'
name: 'FramedBox4'
layout: (LayoutFrame 0 0.0 105 0 4 1.0 -30 1)
labelPosition: topLeft
translateLabel: true
component:
(SpecCollection
collection: (
(VariableHorizontalPanelSpec
name: 'VariableHorizontalPanel2'
layout: (LayoutFrame 0 0 4 0 0 1 0 1)
component:
(SpecCollection
collection: (
(SequenceViewSpec
name: 'List2'
model: selectedStartupClassIndexHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
useIndex: true
sequenceList: listOfStartupClassesInProject
)
(TextEditorSpec
name: 'TextEditor2'
model: selectedStartupClassesComment
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
isReadOnly: true
hasKeyboardFocusInitially: false
viewClassName: 'TextView'
)
)
)
handles: (Any 0.34560327198364 1.0)
)
)
)
)
(HorizontalPanelViewSpec
name: 'HorizontalPanel1'
layout: (LayoutFrame 0 0 -30 1 0 1 0 1)
horizontalLayout: leftSpace
verticalLayout: center
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(ActionButtonSpec
label: 'Browse Selected StartupClass'
name: 'Button3'
translateLabel: true
model: doBrowseStartupClass
enableChannel: hasStartupClassSelectedHolder
extent: (Point 180 22)
)
)
)
)
)
)
)
!
page5_specifyIncludedClasses
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::ProjectBuilderAssistantApplication andSelector:#page5_specifyIncludedClasses
Tools::ProjectBuilderAssistantApplication new openInterface:#page5_specifyIncludedClasses
"
<resource: #canvas>
^
#(FullSpec
name: #'page5_specifyIncludedClasses'
window:
(WindowSpec
label: 'Project Selection'
name: 'Project Selection'
min: (Point 0 0)
bounds: (Rectangle 0 0 521 400)
)
component:
(SpecCollection
collection: (
(FramedBoxSpec
label: 'Project Contents'
name: 'FramedBox3'
layout: (LayoutFrame 0 0.0 5 0 4 1.0 -30 1)
labelPosition: topLeft
translateLabel: true
component:
(SpecCollection
collection: (
(SequenceViewSpec
name: 'List1'
layout: (LayoutFrame 0 0 0 0 0 1 0 1)
initiallyDisabled: true
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
useIndex: false
sequenceList: listOfClassesInProject
)
)
)
)
(HorizontalPanelViewSpec
name: 'HorizontalPanel1'
layout: (LayoutFrame 0 0 -30 1 0 1 0 1)
horizontalLayout: center
verticalLayout: center
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(ActionButtonSpec
label: 'Browse Project Definition'
name: 'Button3'
translateLabel: true
model: doBrowseProjectDefinitionClass
extent: (Point 180 22)
)
(ActionButtonSpec
label: 'Update Contents (Scan)'
name: 'Button4'
translateLabel: true
model: doGenerateProjectContentsDefinition
extent: (Point 180 22)
)
)
)
)
)
)
)
!
page6_specifyBuildDirectorySpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:ProjectBuilderAssistantApplication andSelector:#page6_specifyBuildDirectorySpec
ProjectBuilderAssistantApplication new openInterface:#page6_specifyBuildDirectorySpec
"
<resource: #canvas>
^
#(FullSpec
name: #'page6_specifyBuildDirectorySpec'
window:
(WindowSpec
label: 'Project Selection'
name: 'Project Selection'
min: (Point 0 0)
bounds: (Rectangle 0 0 521 104)
)
component:
(SpecCollection
collection: (
(FramedBoxSpec
label: 'Build Directory'
name: 'FramedBox3'
layout: (LayoutFrame 0 0.0 5 0 4 1.0 79 0)
labelPosition: topLeft
translateLabel: true
component:
(SpecCollection
collection: (
(FilenameInputFieldSpec
name: 'FilenameEntryField1'
layout: (LayoutFrame 0 0.0 10 0 0 1.0 32 0)
model: buildDirectoryHolder
acceptOnPointerLeave: true
viewClassName: FilenameWidgetWithHistory
)
)
)
)
)
)
)
!
page7_buildSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::ProjectBuilderAssistantApplication andSelector:#page7_buildSpec
Tools::ProjectBuilderAssistantApplication new openInterface:#page7_buildSpec
"
<resource: #canvas>
^
#(FullSpec
name: #'page7_buildSpec'
window:
(WindowSpec
label: 'Project Selection'
name: 'Project Selection'
min: (Point 0 0)
bounds: (Rectangle 0 0 521 472)
)
component:
(SpecCollection
collection: (
(FramedBoxSpec
label: 'Make Output'
name: 'FramedBox3'
layout: (LayoutFrame 0 0.0 5 0 4 1.0 -30 1)
labelPosition: topLeft
translateLabel: true
component:
(SpecCollection
collection: (
(TextEditorSpec
name: 'MakeOutputWindow'
layout: (LayoutFrame 0 0 0 0 0 1 0 1)
model: makeOutputHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
hasKeyboardFocusInitially: false
viewClassName: 'TextCollector'
postBuildCallback: postBuildMakeOutputWindow:
)
)
)
)
(HorizontalPanelViewSpec
name: 'HorizontalPanel1'
layout: (LayoutFrame 0 0 -30 1 0 1 0 1)
horizontalLayout: leftSpace
verticalLayout: center
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(ActionButtonSpec
label: 'Start Make'
name: 'Button3'
translateLabel: true
model: doStartMake
enableChannel: startMakeButtonEnabled
extent: (Point 107 22)
)
(ActionButtonSpec
label: 'Stop Make'
name: 'Button4'
visibilityChannel: stopMakeButtonVisible
translateLabel: true
model: doStopMake
extent: (Point 107 22)
)
)
)
)
)
)
)
!
page8_deploySpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::ProjectBuilderAssistantApplication andSelector:#page8_deploySpec
Tools::ProjectBuilderAssistantApplication new openInterface:#page8_deploySpec
"
<resource: #canvas>
^
#(FullSpec
name: #'page8_deploySpec'
window:
(WindowSpec
label: 'Project Selection'
name: 'Project Selection'
min: (Point 0 0)
bounds: (Rectangle 0 0 521 472)
)
component:
(SpecCollection
collection: (
(FramedBoxSpec
label: 'Files for Deployment'
name: 'FramedBox3'
layout: (LayoutFrame 0 0.0 5 0 4 1.0 0 1)
labelPosition: topLeft
translateLabel: true
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'SubCanvas1'
layout: (LayoutFrame 0 0 0 0 0 1 -30 1)
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientHolder: fileBrowserInstance
createNewApplication: true
createNewBuilder: true
)
(HorizontalPanelViewSpec
name: 'HorizontalPanel1'
layout: (LayoutFrame 0 0 -30 1 0 1 0 1)
horizontalLayout: center
verticalLayout: center
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(ActionButtonSpec
label: 'Open Windows Explorer'
name: 'Button1'
translateLabel: true
resizeForLabel: true
model: doOpenExplorer
extent: (Point 172 22)
)
)
)
)
)
)
)
)
)
)
! !
!ProjectBuilderAssistantApplication methodsFor:'actions'!
buildDirectoryChanged
self updateButtonEnableState.
!
createNewApplication
<resource: #uiCallback>
|newAppName newAppClass|
newAppName := self newApplicationsName value.
newAppName isEmptyOrNil ifTrue:[
Dialog warn:'Please enter the name of the Application-Class first.'.
^ self
].
self withWaitCursorDo:[
Class packageQuerySignal answer:(selectedProjectDefinition package)
do:[
newAppClass := ApplicationModel
subclass:newAppName asSymbol
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'Applications'.
CodeGeneratorTool createApplicationCodeFor:newAppClass.
].
self updateListOfApplicationsInProject
].
!
createNewProject
<resource: #uiCallback>
|newProjectID projectDefinitionType projectDefinitionClass projectClasses|
newProjectID := self newProjectsName value.
newProjectID isEmptyOrNil ifTrue:[
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 projectTypeHolder value).
projectDefinitionClass := ProjectDefinition
definitionClassForPackage:newProjectID
projectType: projectDefinitionType
createIfAbsent:true.
projectDefinitionClass compileDescriptionMethods.
self updateListOfMatchingProjects.
self selectedProjectIndexHolder value:( self listOfMatchingProjects value indexOf:projectDefinitionClass).
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 isLibrary ifFalse:[
"/ "/ see if it has a Startup class
"/ (projectClasses contains:[:cls | cls isStartable]) ifFalse:[
"/ ].
"/ ].
!
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>
Transcript showCR:self class name, ': action for doAddClassToProject ...'.
self halt.
!
doBrowseApplication
<resource: #uiCallback>
|appClass|
self hasApplicationSelected ifTrue:[
appClass := self listOfApplicationsInProject value at:(self selectedApplicationIndexHolder value).
UserPreferences systemBrowserClass
openInClass:appClass class selector:#windowSpec.
].
!
doBrowseProject
<resource: #uiCallback>
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 class selector:#main:.
].
!
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.
!
doStartMake
<resource: #uiCallback>
self stopMakeButtonVisible value:true.
self startMakeButtonEnabled value:false.
makeOutputWindow clear.
makeProcess :=
[
[
self runBuildProcess
] ensure:[
self stopMakeButtonVisible value:false.
self startMakeButtonEnabled value:true.
makeProcess := nil.
self updateButtonEnableState.
].
] newProcess.
makeProcess priority:4.
makeProcess priorityRange:(4 to:8).
makeProcess resume.
!
doStopMake
<resource: #uiCallback>
|p|
(p := makeProcess) notNil ifTrue:[
makeProcess := nil.
p terminate.
p waitUntilTerminated.
makeOutputWindow endEntry.
makeOutputWindow cr.
makeOutputWindow nextPutLine:('Make Cancelled' colorizeAllWith:Color white on:Color red).
makeOutputWindow endEntry.
].
!
projectTypeChanged
<resource: #uiCallback>
self updateListOfMatchingProjects
!
runBuildProcess
<resource: #uiCallback>
self assert:makeOutputWindow notNil.
self assert:makeOutputWindow model == self makeOutputHolder.
ActivityNotification handle:[:ex |
ex messageText notNil ifTrue:[
makeOutputWindow endEntry.
makeOutputWindow cr.
makeOutputWindow nextPutLine:(ex messageText colorizeAllWith:Color white on:Color blue).
makeOutputWindow endEntry.
].
ex proceed.
] do:[
projectBuilder := ProjectBuilder new.
projectBuilder package:(selectedProjectDefinition package).
projectBuilder buildWithColorizedOutputTo:makeOutputWindow.
].
!
selectedApplicationChanged
self selectedApplicationIndexHolder value isNil ifTrue:[
selectedApplication := nil.
] ifFalse:[
selectedApplication := self listOfApplicationsInProject value at:(self selectedApplicationIndexHolder value).
].
self hasApplicationSelectedHolder value:(selectedApplication notNil).
"/ selectedApplication notNil ifTrue:[
"/ "/ generate startupClass code
"/ CodeGeneratorTool
"/ compile:(selectedProjectDefinition startupClassName_codeFor:(selectedApplication name))
"/ forClass:selectedProjectDefinition theMetaclass
"/ inCategory:'description - startup'.
"/ ].
self updateApplicationComment.
self updateButtonEnableState.
!
selectedProjectChanged
self selectedProjectIndexHolder value isNil ifTrue:[
selectedProjectDefinition := nil.
] ifFalse:[
selectedProjectDefinition := self listOfMatchingProjects value at:(self selectedProjectIndexHolder value).
].
self hasProjectSelectedHolder value:(selectedProjectDefinition notNil).
self updateComment.
self updateListOfApplicationsInProject.
self updateButtonEnableState.
!
selectedStartupClassChanged
self selectedStartupClassIndexHolder value isNil ifTrue:[
selectedStartupClass := nil.
] ifFalse:[
selectedStartupClass := self listOfStartupClassesInProject value at:(self selectedStartupClassIndexHolder value).
].
self hasStartupClassSelectedHolder value:(selectedStartupClass notNil).
selectedStartupClass notNil ifTrue:[
"/ generate startupClass code
CodeGeneratorTool
compile:(selectedProjectDefinition startupClassName_codeFor:(selectedStartupClass name))
forClass:selectedProjectDefinition theMetaclass
inCategory:'description - startup'.
].
self updateButtonEnableState.
! !
!ProjectBuilderAssistantApplication methodsFor:'aspects'!
buildDirectoryHolder
<resource: #uiAspect>
|buildDirectory|
buildDirectoryHolder isNil ifTrue:[
buildDirectoryHolder := nil asValue.
buildDirectoryHolder onChangeSend:#buildDirectoryChanged to:self.
].
buildDirectoryHolder value isEmptyOrNil ifTrue:[
buildDirectory := Tools::ProjectBuilder previousBuildDirectory.
buildDirectory isNil ifTrue:[
buildDirectory := UserPreferences current buildDirectory.
buildDirectory isNil ifTrue:[
buildDirectory := Filename tempDirectory construct:'stx_build'.
].
].
buildDirectoryHolder value: buildDirectory.
].
^ buildDirectoryHolder.
!
fileBrowserInstance
|targetDirectory browser|
targetDirectory := projectBuilder packageBuildDirectory.
browser := FileBrowserV2 new.
browser onDirectory:targetDirectory.
browser filter:'*setup*'.
^ browser.
!
hasApplicationSelectedHolder
<resource: #uiAspect>
hasApplicationSelectedHolder isNil ifTrue:[
hasApplicationSelectedHolder := nil asValue.
].
^ hasApplicationSelectedHolder.
!
hasProjectSelectedHolder
<resource: #uiAspect>
hasProjectSelectedHolder isNil ifTrue:[
hasProjectSelectedHolder := nil asValue.
].
^ hasProjectSelectedHolder.
!
hasStartupClassSelectedHolder
<resource: #uiAspect>
hasStartupClassSelectedHolder isNil ifTrue:[
hasStartupClassSelectedHolder := nil asValue.
].
^ hasStartupClassSelectedHolder.
!
hideSTXProjects
<resource: #uiAspect>
hideSTXProjects isNil ifTrue:[
hideSTXProjects := true asValue.
hideSTXProjects onChangeSend:#updateListOfMatchingProjects to:self.
].
^ hideSTXProjects.
!
listOfApplicationsInProject
<resource: #uiAspect>
listOfApplicationsInProject isNil ifTrue:[
listOfApplicationsInProject := ValueHolder new.
].
^ listOfApplicationsInProject.
!
listOfClassesInProject
<resource: #uiAspect>
listOfClassesInProject isNil ifTrue:[
listOfClassesInProject := ValueHolder new.
].
^ listOfClassesInProject.
!
listOfMatchingProjects
<resource: #uiAspect>
listOfMatchingProjects isNil ifTrue:[
listOfMatchingProjects := ValueHolder new.
].
^ listOfMatchingProjects.
!
listOfStartupClassesInProject
<resource: #uiAspect>
listOfStartupClassesInProject isNil ifTrue:[
listOfStartupClassesInProject := ValueHolder new.
].
^ listOfStartupClassesInProject.
!
makeOutputHolder
<resource: #uiAspect>
makeOutputHolder isNil ifTrue:[
makeOutputHolder := ValueHolder new.
].
^ makeOutputHolder.
!
newApplicationsName
<resource: #uiAspect>
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
newApplicationsName isNil ifTrue:[
newApplicationsName := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ newApplicationsName addDependent:self.
"/ newApplicationsName onChangeSend:#newApplicationsNameChanged to:self.
].
^ newApplicationsName.
!
newProjectsName
<resource: #uiAspect>
newProjectsName isNil ifTrue:[
newProjectsName := nil asValue.
].
^ newProjectsName.
!
newStartupClassName
<resource: #uiAspect>
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
].
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 projectTypeHolder value ~~ #libraryType
!
selectedApplicationIndexHolder
<resource: #uiAspect>
selectedApplicationIndexHolder isNil ifTrue:[
selectedApplicationIndexHolder := ValueHolder new.
selectedApplicationIndexHolder onChangeSend:#selectedApplicationChanged to:self.
].
^ selectedApplicationIndexHolder.
!
selectedApplicationsComment
<resource: #uiAspect>
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
selectedApplicationsComment isNil ifTrue:[
selectedApplicationsComment := '' asValue.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ selectedApplicationsComment addDependent:self.
"/ selectedApplicationsComment onChangeSend:#selectedApplicationsCommentChanged to:self.
].
^ selectedApplicationsComment.
!
selectedProjectDefinition
<resource: #uiAspect>
^ selectedProjectDefinition.
!
selectedProjectIndexHolder
<resource: #uiAspect>
selectedProjectIndexHolder isNil ifTrue:[
selectedProjectIndexHolder := ValueHolder new.
selectedProjectIndexHolder onChangeSend:#selectedProjectChanged to:self.
].
^ selectedProjectIndexHolder.
!
selectedProjectsComment
<resource: #uiAspect>
selectedProjectsComment isNil ifTrue:[
selectedProjectsComment := '' asValue.
].
^ selectedProjectsComment.
!
selectedStartupClassIndexHolder
<resource: #uiAspect>
selectedStartupClassIndexHolder isNil ifTrue:[
selectedStartupClassIndexHolder := ValueHolder new.
selectedStartupClassIndexHolder onChangeSend:#selectedStartupClassChanged to:self.
].
^ selectedStartupClassIndexHolder.
!
startMakeButtonEnabled
<resource: #uiAspect>
startMakeButtonEnabled isNil ifTrue:[
startMakeButtonEnabled := true asValue.
].
^ startMakeButtonEnabled.
!
stopMakeButtonVisible
<resource: #uiAspect>
stopMakeButtonVisible isNil ifTrue:[
stopMakeButtonVisible := false asValue.
].
^ stopMakeButtonVisible.
! !
!ProjectBuilderAssistantApplication methodsFor:'initialization & release'!
postBuildMakeOutputWindow:aView
makeOutputWindow := aView
!
postBuildWith:aBuilder
super postBuildWith:aBuilder.
self updateListOfMatchingProjects.
Smalltalk addDependent:self.
!
release
Smalltalk removeDependent:self.
super release
! !
!ProjectBuilderAssistantApplication methodsFor:'menu actions'!
openDocumentation
self openHTMLDocument:'tools/misc/TOP.html#PACKAGER'.
! !
!ProjectBuilderAssistantApplication methodsFor:'private'!
commentFromClass:aClass
|docMethod comment indents minIndent maxLineLength|
docMethod := aClass class compiledMethodAt:#documentation.
docMethod notNil ifTrue:[
comment := docMethod comment.
comment := comment asStringCollection
collect:[:line | line withoutTrailingSeparators].
[comment notEmpty and:[comment first isBlank]] whileTrue:[ comment removeFirst ].
maxLineLength := (comment collect:[:line | line size]) max.
indents := comment collect:[:line |
line isEmptyOrNil
ifTrue:[maxLineLength]
ifFalse:[ line findFirst:[:ch | ch isSeparator not]]].
(minIndent := indents min) > 1 ifTrue:[
comment := comment collect:[:line | line copyFrom:minIndent].
].
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'!
canEnterApplicationSelection
^ self hasProjectSelected
!
canEnterBuild
^ self hasBuildDirectorySpecified
!
canEnterContentsSelection
^ self hasProjectSelected
and:[ self hasApplicationSelected
and:[ self hasStartupClassSelected ]]
!
canEnterDeploy
^ self hasProjectBuilder
!
canEnterStartupClassSelection
^ self hasProjectSelected and:[ self hasApplicationSelected ]
! !
!ProjectBuilderAssistantApplication methodsFor:'specs'!
assistantSpec
^ #(Array
( AssistantPageSpec
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
pageTitle: 'Application Selection'
windowSpecSelector: page3_applicationSelectionSpec
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
pageTitle: 'Startup Class Selection'
windowSpecSelector: page4_startupClassSelectionSpec
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
pageTitle: 'Build'
windowSpecSelector: page7_buildSpec
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.
! !
!ProjectBuilderAssistantApplication methodsFor:'update'!
rememberMakeOutputsContents
makeOutputHolder value:(makeOutputWindow contents)
!
restoreMakeOutputsContents
makeOutputWindow contents:makeOutputHolder value
!
update:something with:anArgument from:changedObject
changedObject == Smalltalk ifTrue:[
(something == #newClass
or:[something == #classRemove
or:[something == #projectOrganization]]) ifTrue:[
self updateListOfMatchingProjects.
^ self.
].
^ self.
].
super update:something with:anArgument from:changedObject
!
updateApplicationComment
|comment|
self selectedApplicationIndexHolder value notNil ifTrue:[
comment := self commentFromClass:selectedApplication.
comment isNil ifTrue:[
comment := 'Application has no comment' allItalic colorizeAllWith:Color lightGrey.
].
] ifFalse:[
comment := 'Please select an Application' allItalic colorizeAllWith:Color lightGrey.
].
self selectedApplicationsComment value:comment.
!
updateComment
|comment|
self selectedProjectIndexHolder value notNil ifTrue:[
comment := self commentFromClass:selectedProjectDefinition.
comment isNil ifTrue:[
comment := 'Project has no comment' allItalic colorizeAllWith:Color lightGrey.
].
] ifFalse:[
comment := 'Please select a Project' allItalic colorizeAllWith:Color lightGrey.
].
self selectedProjectsComment value:comment.
!
updateListOfApplicationsInProject
|oldList applicationClasses package startUpClassName startUpClass
appClass appClassIndex|
appClassIndex := nil.
selectedProjectDefinition isNil ifTrue:[
applicationClasses := #()
] ifFalse:[
package := selectedProjectDefinition package.
applicationClasses := Smalltalk allClasses
select:[:cls |
(cls package = package
and:[ cls isSubclassOf:ApplicationModel ])
].
applicationClasses := applicationClasses asOrderedCollection.
applicationClasses sort:[:a :b | a name < b name].
"/ startUpClassName := [ selectedProjectDefinition startupClassName ] ifError:[ nil ].
"/ startUpClassName notNil ifTrue:[
"/ startUpClass := Smalltalk classNamed:startUpClassName.
"/ startUpClass notNil ifTrue:[
"/ appClassIndex := applicationClasses indexOf:startUpClass.
"/ appClassIndex == 0 ifTrue:[ appClassIndex := nil ].
"/ ].
"/ ].
].
oldList := self listOfApplicationsInProject value.
oldList = applicationClasses ifFalse:[
appClass := selectedApplication.
appClassIndex := applicationClasses indexOf:appClass.
appClassIndex == 0 ifTrue:[ appClassIndex := nil ].
self listOfApplicationsInProject value:applicationClasses.
self selectedApplicationIndexHolder value:appClassIndex.
].
!
updateListOfClassesInProject
self listOfClassesInProject value:(selectedProjectDefinition classNames).
!
updateListOfMatchingProjects
|matching projectType idx|
projectType := self projectType.
matching := ProjectDefinition allSubclasses
select:[:defClass |
|match|
match := false.
defClass isAbstract ifFalse:[
(self hideSTXProjects value not
or:[ defClass package asPackageId module ~= 'stx' ])
ifTrue:[
projectType == ProjectDefinition libraryType ifTrue:[
match := defClass isLibraryDefinition
] ifFalse:[
projectType == ProjectDefinition guiApplicationType ifTrue:[
match := defClass isGUIApplication
] ifFalse:[
projectType == ProjectDefinition nonGuiApplicationType ifTrue:[
match := defClass isConsoleApplication
] ifFalse:[
self error.
].
].
].
].
].
].
matching sort:[:a :b | a name < b name].
self listOfMatchingProjects value:matching.
idx := matching indexOf:selectedProjectDefinition.
idx == 0 ifTrue:[
self selectedProjectIndexHolder value:nil.
] 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'!
version_CVS
^ '$Header$'
! !