--- a/Tools__ProjectBuilderAssistantApplication.st Mon Oct 26 13:54:58 2009 +0100
+++ b/Tools__ProjectBuilderAssistantApplication.st Tue Oct 27 14:51:43 2009 +0100
@@ -16,7 +16,7 @@
selectedStartupClass hasStartupClassSelectedHolder
selectedApplicationsComment buildDirectoryHolder makeProcess
listOfClassesInProject makeOutputWindow projectBuilder
- newStartupClassName usedCompilerHolder'
+ newStartupClassName usedCompilerHolder listOfNewProjectsName'
classVariableNames:''
poolDictionaries:''
category:'System-Support-Projects'
@@ -229,16 +229,6 @@
component:
(SpecCollection
collection: (
- (InputFieldSpec
- name: 'EntryField1'
- layout: (LayoutFrame 1 0 6 0 -113 1 28 0)
- model: newProjectsName
- acceptOnReturn: true
- acceptOnTab: true
- acceptOnLostFocus: true
- acceptOnPointerLeave: true
- emptyFieldReplacementText: 'module:directory'
- )
(ActionButtonSpec
label: 'Create'
name: 'Button1'
@@ -246,6 +236,14 @@
translateLabel: true
model: createNewProject
)
+ (ExtendedComboBoxSpec
+ name: 'NewProjectsNameListExtendedComboBox'
+ layout: (LayoutFrame 1 0 6 0 -113 1 28 0)
+ model: newProjectsName
+ readOnly: false
+ miniScrollerHorizontal: true
+ postBuildCallback: postBuildNewProjectsNameListExtendedComboBox:
+ )
)
)
@@ -940,6 +938,52 @@
)
! !
+!ProjectBuilderAssistantApplication class methodsFor:'misc specs'!
+
+newProjectsNameListSpec
+ "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:#newProjectsNameListSpec
+ Tools::ProjectBuilderAssistantApplication new openInterface:#newProjectsNameListSpec
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(FullSpec
+ name: newProjectsNameListSpec
+ window:
+ (WindowSpec
+ label: 'NewApplication'
+ name: 'NewApplication'
+ min: (Point 0 0)
+ bounds: (Rectangle 0 0 131 207)
+ )
+ component:
+ (SpecCollection
+ collection: (
+ (SequenceViewSpec
+ name: 'ReferencePoint2'
+ layout: (LayoutFrame 0 0 0 0 0 1 0 1)
+ model: newProjectsName
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ miniScrollerHorizontal: true
+ miniScrollerVertical: false
+ useIndex: false
+ sequenceList: listOfNewProjectsName
+ )
+ )
+
+ )
+ )
+! !
+
!ProjectBuilderAssistantApplication methodsFor:'actions'!
buildDirectoryChanged
@@ -994,7 +1038,6 @@
projectDefinitionType := ProjectDefinition perform:(self projectTypeHolder value).
-
projectDefinitionClass := ProjectDefinition
definitionClassForPackage:newProjectID
projectType: projectDefinitionType
@@ -1002,6 +1045,7 @@
projectDefinitionClass compileDescriptionMethods.
self updateListOfMatchingProjects.
+ self updateListOfNewProjectsName.
self selectedProjectIndexHolder value:( self listOfMatchingProjects value indexOf:projectDefinitionClass).
@@ -1413,6 +1457,16 @@
^ listOfMatchingProjects.
!
+listOfNewProjectsName
+
+ <resource: #uiAspect>
+
+ listOfNewProjectsName isNil ifTrue:[
+ listOfNewProjectsName := ValueHolder new.
+ ].
+ ^ listOfNewProjectsName.
+!
+
listOfPossibleCompilers
OperatingSystem isMSWINDOWSlike ifTrue:[
^ #('bcc' 'vc' 'lcc')
@@ -1629,9 +1683,27 @@
makeOutputWindow := aView
!
+postBuildNewProjectsNameListExtendedComboBox:aBox
+
+ |menu|
+
+ menu := SubCanvas new.
+ menu client:self spec:#newProjectsNameListSpec builder:nil.
+ aBox menuWidget:menu.
+
+ aBox editor
+ immediateAccept:true;
+ acceptOnLeave:true;
+ acceptOnLostFocus:true;
+ acceptOnPointerLeave:true;
+ acceptOnReturn:true;
+ acceptOnTab:true.
+!
+
postBuildWith:aBuilder
super postBuildWith:aBuilder.
self updateListOfMatchingProjects.
+ self updateListOfNewProjectsName.
Smalltalk addDependent:self.
!
@@ -1871,6 +1943,7 @@
or:[something == #classRemove
or:[something == #projectOrganization]]) ifTrue:[
self updateListOfMatchingProjects.
+ self updateListOfNewProjectsName.
^ self.
].
^ self.
@@ -1991,6 +2064,18 @@
].
!
+updateListOfNewProjectsName
+
+ |loadedProjectIDsWithoutProjectDefinition|
+
+ loadedProjectIDsWithoutProjectDefinition := Smalltalk allLoadedProjectIDs
+ select:[:eachProjectID |
+ eachProjectID ~= PackageId noProjectID
+ and:[ (ProjectDefinition definitionClassForPackage: eachProjectID) isNil ].
+ ].
+ self listOfNewProjectsName value:loadedProjectIDsWithoutProjectDefinition.
+!
+
updateListOfStartupClassesInProject
|startupClasses package startUpClassName startUpClass startupClassIndex|