--- a/ProjectBrowser.st Mon Jan 10 17:08:08 2000 +0100
+++ b/ProjectBrowser.st Thu Jan 13 19:27:49 2000 +0100
@@ -404,7 +404,7 @@
^ self classesIcon
!
-prerequisiteProjectsIcon
+prerequisitePackagesIcon
<resource: #programImage>
^ self projectsIcon
@@ -1591,7 +1591,7 @@
)
!
-rightCanvasSpecForPrerequisiteProjects
+rightCanvasSpecForPrerequisitePackages
"This resource specification was automatically generated
by the UIPainter of ST/X."
@@ -1599,15 +1599,15 @@
the UIPainter may not be able to read the specification."
"
- UIPainter new openOnClass:ProjectBrowser andSelector:#rightCanvasSpecForPrerequisiteProjects
- ProjectBrowser new openInterface:#rightCanvasSpecForPrerequisiteProjects
+ UIPainter new openOnClass:ProjectBrowser andSelector:#rightCanvasSpecForPrerequisitePackages
+ ProjectBrowser new openInterface:#rightCanvasSpecForPrerequisitePackages
"
<resource: #canvas>
^
#(#FullSpec
- #name: #rightCanvasSpecForPrerequisiteProjects
+ #name: #rightCanvasSpecForPrerequisitePackages
#window:
#(#WindowSpec
#label: 'NewApplication'
@@ -1757,7 +1757,7 @@
#name: 'NewApplication'
#min: #(#Point 10 10)
#max: #(#Point 1280 1024)
- #bounds: #(#Rectangle 12 22 373 385)
+ #bounds: #(#Rectangle 12 22 373 346)
)
#component:
#(#SpecCollection
@@ -1798,7 +1798,7 @@
#(#FramedBoxSpec
#label: 'Project Working Directory'
#name: 'FramedBox2'
- #layout: #(#LayoutFrame 0 0.0 62 0.0 0 1.0 122 0)
+ #layout: #(#LayoutFrame 0 0.0 67 0.0 0 1.0 127 0)
#labelPosition: #topLeft
#translateLabel: true
#component:
@@ -1819,31 +1819,9 @@
)
)
#(#FramedBoxSpec
- #label: 'Projects Package ID'
- #name: 'FramedBox5'
- #layout: #(#LayoutFrame 0 0.0 127 0.0 0 1.0 187 0)
- #labelPosition: #topLeft
- #translateLabel: true
- #component:
- #(#SpecCollection
- #collection: #(
- #(#InputFieldSpec
- #name: 'EntryField5'
- #layout: #(#LayoutFrame 0 0.0 1 0 0 1.0 23 0)
- #activeHelpKey: #packageID
- #model: #projectPackage
- #acceptChannel: #acceptChannel
- #modifiedChannel: #modifiedChannel
- #acceptOnPointerLeave: false
- )
- )
-
- )
- )
- #(#FramedBoxSpec
#label: 'Repository'
#name: 'FramedBox3'
- #layout: #(#LayoutFrame 0 0.0 191 0.0 0 1.0 274 0)
+ #layout: #(#LayoutFrame 0 0.0 137 0.0 0 1.0 220 0)
#labelPosition: #topLeft
#translateLabel: true
#component:
@@ -1890,7 +1868,7 @@
#(#FramedBoxSpec
#label: 'Default Namespace'
#name: 'FramedBox4'
- #layout: #(#LayoutFrame 0 0.0 279 0 0 1.0 337 0)
+ #layout: #(#LayoutFrame 0 0.0 226 0 0 1.0 284 0)
#activeHelpKey: #defaultNamespace
#labelPosition: #topLeft
#translateLabel: true
@@ -2616,6 +2594,34 @@
)
!
+prerequisitePackagesItemMenu
+ "This resource specification was automatically generated
+ by the MenuEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the MenuEditor may not be able to read the specification."
+
+ "
+ MenuEditor new openOnClass:ProjectBrowser andSelector:#prerequisiteClassesItemMenu
+ (Menu new fromLiteralArrayEncoding:(ProjectBrowser prerequisiteClassesItemMenu)) startUp
+ "
+
+ <resource: #menu>
+
+ ^
+ #(#Menu
+ #(
+ #(#MenuItem
+ #label: 'Add package...'
+ #translateLabel: true
+ #value: #addPrerequisitePackage
+ )
+ )
+ nil
+ nil
+ )
+!
+
projectItemMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
@@ -2636,6 +2642,21 @@
#(
#(#MenuItem
+ #label: 'Load Project'
+ #translateLabel: true
+ #value: #loadProject
+ #enabled: #canLoadCurrentProjectHolder
+ )
+ #(#MenuItem
+ #label: 'Unload Project'
+ #translateLabel: true
+ #value: #unloadProject
+ #enabled: #canUnloadCurrentProjectHolder
+ )
+ #(#MenuItem
+ #label: '-'
+ )
+ #(#MenuItem
#label: 'Make Current'
#translateLabel: true
#value: #makeCurrentProject
@@ -2942,6 +2963,18 @@
^ holder.
!
+canLoadCurrentProjectHolder
+ |holder|
+
+ (holder := builder bindingAt:#canLoadCurrentProjectHolder) isNil ifTrue:[
+ holder := false asValue.
+ builder aspectAt:#canLoadCurrentProjectHolder put:holder.
+ ].
+ ^ holder.
+
+ "Modified: / 26.4.1999 / 22:47:33 / cg"
+!
+
canRemoveSelectedClassFromPrerequisites
|holder|
@@ -2966,6 +2999,18 @@
"Created: / 23.3.1999 / 14:18:05 / cg"
!
+canUnloadCurrentProjectHolder
+ |holder|
+
+ (holder := builder bindingAt:#canUnloadCurrentProjectHolder) isNil ifTrue:[
+ holder := false asValue.
+ builder aspectAt:#canUnloadCurrentProjectHolder put:holder.
+ ].
+ ^ holder.
+
+ "Modified: / 26.4.1999 / 22:47:33 / cg"
+!
+
classList
"automatically generated by UIPainter ..."
@@ -3771,6 +3816,9 @@
self hasPrerequisiteClassesNodeSelected ifTrue:[
^ self class prerequisiteClassesItemMenu
].
+ self hasPrerequisitePackagesNodeSelected ifTrue:[
+ ^ self class prerequisitePackagesItemMenu
+ ].
^ nil
!
@@ -3866,6 +3914,24 @@
^ true
!
+canLoadCurrentProject
+ |prj|
+
+ self hasProjectSelected ifFalse:[^ false].
+ (prj := self currentProject) isNil ifTrue:[^ self].
+ ^ prj isLoaded not
+
+!
+
+canUnloadCurrentProject
+ |prj|
+
+ self hasProjectSelected ifFalse:[^ false].
+ (prj := self currentProject) isNil ifTrue:[^ self].
+ ^ prj isLoaded
+
+!
+
checkInClasses:aCollectionOfClasses
|logMessage|
@@ -3979,6 +4045,10 @@
^ self hasNodeSelected:#prerequisiteClasses.
!
+hasPrerequisitePackagesNodeSelected
+ ^ self hasNodeSelected:#prerequisitePackages.
+!
+
hasProjectNodeSelected
|selectedNode|
@@ -4030,7 +4100,7 @@
commentNode prerequisitesNode analysisNode designNode codeNode
userDocNode userOverViewNode userGuideNode userRefManNode
deploymentNode classIcon methodIcon buildOptionsNode
- prerequisiteProjectsNode prerequisiteClassesNode|
+ prerequisitePackagesNode prerequisiteClassesNode|
projectName := aProject name.
pNode := ProjectNode name:projectName.
@@ -4075,14 +4145,14 @@
].
prerequisitesNode icon:(self class prerequisitesIcon).
- prerequisitesNode add:(prerequisiteProjectsNode := ProjectTreeItem name:'Packages').
+ prerequisitesNode add:(prerequisitePackagesNode := ProjectTreeItem name:'Packages').
prerequisitesNode add:(prerequisiteClassesNode := ProjectTreeItem name:'Classes').
prerequisitesNode info:'Other projects and classes required by the project'.
- prerequisiteProjectsNode contents:#prerequisiteProjects.
- prerequisiteProjectsNode icon:(self class prerequisiteProjectsIcon).
- prerequisiteProjectsNode spec:[self class rightCanvasSpecForPrerequisiteProjects].
- prerequisiteProjectsNode info:'Other projects required by the project'.
+ prerequisitePackagesNode contents:#prerequisitePackages.
+ prerequisitePackagesNode icon:(self class prerequisitePackagesIcon).
+ prerequisitePackagesNode spec:[self class rightCanvasSpecForPrerequisitePackages].
+ prerequisitePackagesNode info:'Other projects required by the project'.
prerequisiteClassesNode contents:#prerequisiteClasses.
prerequisiteClassesNode icon:(self class prerequisiteClassesIcon).
@@ -4164,7 +4234,7 @@
!
readAspectsFromProject
- |p type l ns|
+ |p type l ns mMod mDir mPkg pkg|
p := self currentProject.
p notNil ifTrue:[
@@ -4184,15 +4254,37 @@
].
self projectType value:type.
self projectDirectory value:(p directory).
- self projectPackage value:(p package).
ns := p defaultNameSpace ? Smalltalk.
ns isSymbol ifFalse:[
ns := ns name
].
self projectNamespace value:ns.
- self repositoryModule value:(p repositoryModule).
- self repositoryDirectory value:(p repositoryDirectory).
+ pkg := p package ? Project current package.
+ mMod := p repositoryModule ? '?'.
+ mDir := p repositoryDirectory ? '?'.
+ mPkg := mMod , ':' , mDir.
+
+ mPkg ~= pkg ifTrue:[
+ (pkg includes:$:) ifTrue:[
+ mMod := pkg upTo:$:.
+ mDir := pkg copyFrom:mMod size + 2.
+ self warn:('package id: ''' , pkg , ''' different from moduleId: ''' , mPkg ,
+ '\\Assume module:''' , mMod , ''' directory:''' , mDir , '''') withCRs.
+ ] ifFalse:[
+ ((mMod ~= '?') and:[mDir ~= '?']) ifTrue:[
+ self warn:('package id: ''' , pkg , ''' different from moduleId: ''' , mPkg ,
+ '\\Assume package:''' , mMod , ':' , mDir , '''') withCRs.
+ pkg := mMod , ':' , mDir
+ ] ifFalse:[
+ self warn:('package id: ''' , pkg , ''' different from moduleId: ''' , mPkg ,
+ '\\Please care for the module and directory settings.') withCRs.
+ ]
+ ]
+ ].
+ self projectPackage value:pkg.
+ self repositoryModule value:mMod.
+ self repositoryDirectory value:mDir.
self deliverCompiledBinary value:(p propertyAt:#deliverCompiledBinary) ? false.
self deliverByteCode value:(p propertyAt:#deliverByteCode) ? false.
@@ -4327,7 +4419,7 @@
!
saveAspectsIntoProject
- |p s ns dir|
+ |p s ns dir pkg|
p := self currentProject.
p notNil ifTrue:[
@@ -4344,7 +4436,8 @@
].
p directory:self projectDirectory value.
- p packageName:(self projectPackage value) asSymbol.
+ pkg := self repositoryModule value , ':' , self repositoryDirectory value.
+ p packageName:pkg asSymbol.
p repositoryModule:self repositoryModule value.
p repositoryDirectory:self repositoryDirectory value.
@@ -4413,6 +4506,13 @@
^ self builder componentAt:#commandOutputView
!
+updateFlagValueHolders
+ self hasProjectSelectedHolder value:(self hasProjectSelected).
+ self canLoadCurrentProjectHolder value:(self canLoadCurrentProject).
+ self canUnloadCurrentProjectHolder value:(self canUnloadCurrentProject).
+
+!
+
updateProjectTree
|tree moduleRoots root showWhat|
@@ -4709,7 +4809,7 @@
].
self valueOfInfoLabel value:info.
- self hasProjectSelectedHolder value:self hasProjectSelected.
+ self updateFlagValueHolders.
modifiedChannel value:false.
"Modified: / 26.4.1999 / 22:49:20 / cg"
@@ -4740,6 +4840,14 @@
^ newProject
!
+loadProject
+ |project|
+
+ project := self currentProject.
+self halt.
+ Smalltalk loadPackage:(project name)
+!
+
loadProjectCode
|project filesToLoad methodsFile ns anyPatchClassMissing anyPatches
nMissingSuper prevNMissingSuper|
@@ -5006,6 +5114,14 @@
!
+unloadProject
+ |project filesToLoad methodsFile ns anyPatchClassMissing anyPatches
+ nMissingSuper prevNMissingSuper|
+
+ project := self currentProject.
+self halt.
+!
+
updateClassListForProject:aProject
|classInfo l|
@@ -5431,6 +5547,29 @@
!
+addPrerequisitePackage
+ "ask for, and add a single class"
+
+ |p packageName cls|
+
+ p := self currentProject.
+
+ packageName := Dialog request:'Package to add:'.
+ packageName size == 0 ifTrue:[^ self].
+
+ p addPrerequisitePackage:packageName.
+ self updatePrerequisitePackageListForProject:p.
+
+ self listOfRequiredProjectsInPrerequisites value add:packageName.
+ self listOfAllProjectsInPrerequisites value remove:packageName ifAbsent:nil.
+ self selectedProjectInPrerequisites value:nil.
+
+ self listOfRequiredProjectsInPrerequisites changed.
+ self listOfAllProjectsInPrerequisites changed.
+ self accept
+
+!
+
browseClasses
"browse the projects classes"