hg/stx-libtool2: comparison ProjectBrowser.st

equal deleted inserted replaced

-:57d613905108
+:2beb244c45df
 <resource: #programImage>
 ^ self classesIcon
 !
-prerequisiteProjectsIcon
+prerequisitePackagesIcon
 <resource: #programImage>
 ^ self projectsIcon
 !
 )
 )
 !
-rightCanvasSpecForPrerequisiteProjects
+rightCanvasSpecForPrerequisitePackages
 "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:ProjectBrowser andSelector:#rightCanvasSpecForPrerequisiteProjects
+UIPainter new openOnClass:ProjectBrowser andSelector:#rightCanvasSpecForPrerequisitePackages
-ProjectBrowser new openInterface:#rightCanvasSpecForPrerequisiteProjects
+ProjectBrowser new openInterface:#rightCanvasSpecForPrerequisitePackages
 "
 <resource: #canvas>
 ^
 #(#FullSpec
-#name: #rightCanvasSpecForPrerequisiteProjects
+#name: #rightCanvasSpecForPrerequisitePackages
 #window:
 #(#WindowSpec
 #label: 'NewApplication'
 #name: 'NewApplication'
 #layout: #(#LayoutFrame 220 0 200 0 519 0 499 0)
 #(#WindowSpec
 #label: 'NewApplication'
 #name: 'NewApplication'
 #min: #(#Point 10 10)
 #max: #(#Point 1280 1024)
-#bounds: #(#Rectangle 12 22 373 385)
+#bounds: #(#Rectangle 12 22 373 346)
 )
 #component:
 #(#SpecCollection
 #collection: #(
 #(#FramedBoxSpec
 )
 )
 #(#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:
 #(#SpecCollection
 #collection: #(
 )
 )
 )
 #(#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:
 #(#SpecCollection
 #collection: #(
 )
 )
 #(#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
 #component:
 #(#SpecCollection
 nil
 nil
 )
 !
+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."
 "Do not manually edit this!! If it is corrupted,
 ^
 #(#Menu
 #(
+#(#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
 #enabled: #hasProjectSelectedHolder
 builder aspectAt:#canDeliverForWin32 put:holder.
 ].
 ^ 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|
 (holder := builder bindingAt:#canRemoveSelectedClassFromPrerequisites) isNil ifTrue:[
 holder := BlockValue with:[:m | m notNil] argument:(self selectedRequiredClassInPrerequisites).
 builder aspectAt:#canRemoveSelectedProjectFromPrerequisites put:holder.
 ].
 ^ holder.
 "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 ..."
 ^ self class methodsItemMenu
 ].
 self hasPrerequisiteClassesNodeSelected ifTrue:[
 ^ self class prerequisiteClassesItemMenu
 ].
+self hasPrerequisitePackagesNodeSelected ifTrue:[
+^ self class prerequisitePackagesItemMenu
+].
 ^ nil
 !
 itemMenuHolder
 ^ [ self itemMenu]
 (manager checkForExistingModule:moduleDir package:packageDir) ifFalse:[^ false].
 AlreadCheckedExistingModulesAndPackages add:(Array with:moduleDir with:packageDir).
 ^ 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|
 hasPrerequisiteClassesNodeSelected
 ^ self hasNodeSelected:#prerequisiteClasses.
 !
+hasPrerequisitePackagesNodeSelected
+^ self hasNodeSelected:#prerequisitePackages.
+!
 hasProjectNodeSelected
 |selectedNode|
 selectedNode := self selectedTreeNode.
 selectedNode isNil ifTrue:[^ false].
 |projectName pNode
 propertiesNode docNode classesNode patchesNode subprojectsNode filesNode
 commentNode prerequisitesNode analysisNode designNode codeNode
 userDocNode userOverViewNode userGuideNode userRefManNode
 deploymentNode classIcon methodIcon buildOptionsNode
-prerequisiteProjectsNode prerequisiteClassesNode|
+prerequisitePackagesNode prerequisiteClassesNode|
 projectName := aProject name.
 pNode := ProjectNode name:projectName.
 pNode contents:aProject.
 docNode add:(userDocNode := ProjectTreeItem name:'Error Reports').
 docNode add:(userDocNode := ProjectTreeItem name:'Other').
 ].
 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.
+prerequisitePackagesNode contents:#prerequisitePackages.
-prerequisiteProjectsNode icon:(self class prerequisiteProjectsIcon).
+prerequisitePackagesNode icon:(self class prerequisitePackagesIcon).
-prerequisiteProjectsNode spec:[self class rightCanvasSpecForPrerequisiteProjects].
+prerequisitePackagesNode spec:[self class rightCanvasSpecForPrerequisitePackages].
-prerequisiteProjectsNode info:'Other projects required by the project'.
+prerequisitePackagesNode info:'Other projects required by the project'.
 prerequisiteClassesNode contents:#prerequisiteClasses.
 prerequisiteClassesNode icon:(self class prerequisiteClassesIcon).
 prerequisiteClassesNode spec:[self class rightCanvasSpecForPrerequisiteClasses].
 prerequisiteClassesNode info:'Other (autoloaded-) classes required by the project'.
 ^ projectTree
 !
 readAspectsFromProject
-|p type l ns|
+|p type l ns mMod mDir mPkg pkg|
 p := self currentProject.
 p notNil ifTrue:[
 self selectedTreeNode contents == #comment ifTrue:[
 self rightCanvasTextHolder value:p comment.
 (type := p type) == #classLibrary ifTrue:[
 type := #library
 ].
 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).
+pkg := p package ? Project current package.
-self repositoryDirectory value:(p repositoryDirectory).
+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.
 self deliverGZipArchive value:(p propertyAt:#deliverGZipArchive) ? false.
 self deliverZipArchive value:(p propertyAt:#deliverZipArchive) ? false.
 self halt.
 !
 saveAspectsIntoProject
-|p s ns dir|
+|p s ns dir pkg|
 p := self currentProject.
 p notNil ifTrue:[
 p removeDependent:self.
 (dir exists and:[dir isDirectory]) ifFalse:[
 self warn:'Invalid project directory: ' , dir pathName
 ].
 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.
 s := self projectNamespace value.
 ^ mthd
 !
 transcript
 ^ 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|
 info := 'Projects code is not loaded.'
 ].
 ].
 self valueOfInfoLabel value:info.
-self hasProjectSelectedHolder value:self hasProjectSelected.
+self updateFlagValueHolders.
 modifiedChannel value:false.
 "Modified: / 26.4.1999 / 22:49:20 / cg"
 !
 ].
 self expandPathToNodeFor:newProject.
 ].
 ^ newProject
+!
+loadProject
+|project|
+project := self currentProject.
+self halt.
+Smalltalk loadPackage:(project name)
 !
 loadProjectCode
 |project filesToLoad methodsFile ns anyPatchClassMissing anyPatches
 nMissingSuper prevNMissingSuper|
 self currentCanvasHolder value:(self class rightCanvasSpecForReadOnlyText).
 self rightCanvasTextHolder value:someText.
 !
+unloadProject
+|project filesToLoad methodsFile ns anyPatchClassMissing anyPatches
+nMissingSuper prevNMissingSuper|
+project := self currentProject.
+self halt.
+!
 updateClassListForProject:aProject
 |classInfo l|
 classInfo := aProject classInfo copy asOrderedCollection.
 classInfo sort:[:a :b | a className < b className].
 self updateClassListForProject:project
 !
+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"
 |ns p classes nBad uniqueClasses|

changeset 1291	2beb244c45df
parent 1290	57d613905108
child 1292	f5fcf9ef07ab