hg/stx-libtool2: comparison ProjectBrowser.st

equal deleted inserted replaced

-:7d025840ea10
+:6c68d44a9151
 ProjectBrowser new openInterface:#emptyRightCanvasSpec
 "
 <resource: #canvas>
 ^
+#(#FullSpec
-#(#FullSpec
+#name: #emptyRightCanvasSpec
 #window:
 #(#WindowSpec
-#name: 'NewApplication'
+#label: 'NewApplication'
-#layout: #(#LayoutFrame 216 0 173 0 515 0 472 0)
+#name: 'NewApplication'
-#label: 'NewApplication'
+#min: #(#Point 10 10)
-#min: #(#Point 10 10)
+#max: #(#Point 1280 1024)
-#max: #(#Point 1280 1024)
+#bounds: #(#Rectangle 10 20 310 320)
-#bounds: #(#Rectangle 216 173 516 473)
+)
-#usePreferredExtent: false
+#component:
-)
+#(#SpecCollection
-#component:
+#collection: #(
-#(#SpecCollection
+#(#TextEditorSpec
-#collection:
+#name: 'TextEditor1'
-#(
+#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
-#(#TextEditorSpec
+#initiallyInvisible: true
-#name: 'TextEditor1'
+#model: #rightCanvasTextHolder
-#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+#hasHorizontalScrollBar: true
-#model: #rightCanvasTextHolder
+#hasVerticalScrollBar: true
-#hasHorizontalScrollBar: true
+#miniScrollerHorizontal: true
-#hasVerticalScrollBar: true
+#isReadOnly: true
-#miniScrollerHorizontal: true
+)
-#isReadOnly: true
+)
-)
 )
-)
 )
 !
 rightCanvasSpecForClassList
 "This resource specification was automatically generated
 "Do not manually edit this!! If it is corrupted,
 the UIPainter may not be able to read the specification."
 "
-UIPainter new openOnClass:ProjectBrowser andSelector:#emptyRightCanvasSpec
+UIPainter new openOnClass:ProjectBrowser andSelector:#rightCanvasSpecForEditableText
-ProjectBrowser new openInterface:#emptyRightCanvasSpec
+ProjectBrowser new openInterface:#rightCanvasSpecForEditableText
 "
 <resource: #canvas>
 ^
+#(#FullSpec
-#(#FullSpec
+#name: #rightCanvasSpecForEditableText
 #window:
 #(#WindowSpec
-#name: 'NewApplication'
+#label: 'NewApplication'
-#layout: #(#LayoutFrame 216 0 173 0 515 0 472 0)
+#name: 'NewApplication'
-#label: 'NewApplication'
+#min: #(#Point 10 10)
-#min: #(#Point 10 10)
+#max: #(#Point 1280 1024)
-#max: #(#Point 1280 1024)
+#bounds: #(#Rectangle 216 173 516 473)
-#bounds: #(#Rectangle 216 173 516 473)
+)
-#usePreferredExtent: false
+#component:
-)
+#(#SpecCollection
-#component:
+#collection: #(
-#(#SpecCollection
+#(#TextEditorSpec
-#collection:
+#name: 'TextEditor1'
-#(
+#layout: #(#LayoutFrame 0 0.0 30 0.0 0 1.0 0 1.0)
-#(#TextEditorSpec
+#model: #rightCanvasTextHolder
-#name: 'TextEditor1'
+#hasHorizontalScrollBar: true
-#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+#hasVerticalScrollBar: true
-#model: #rightCanvasTextHolder
+#miniScrollerHorizontal: true
-#hasHorizontalScrollBar: true
+)
-#hasVerticalScrollBar: true
+#(#LabelSpec
-#miniScrollerHorizontal: true
+#label: 'Label'
-#isReadOnly: false
+#name: 'Label1'
-)
+#layout: #(#LayoutFrame 0 0 0 0 0 1 30 0)
-)
+#translateLabel: true
-)
+#labelChannel: #textCanvasLabelHolder
+#adjust: #left
+)
+)
+)
 )
 !
 rightCanvasSpecForFiles
 "This resource specification was automatically generated
 )
 #component:
 #(#SpecCollection
 #collection: #(
 #(#LabelSpec
-#label: 'Known Projects'
+#label: 'Known Packages'
 #name: 'Label1'
 #layout: #(#LayoutFrame 0 0 0 0 0 0.5 30 0)
 #translateLabel: true
 )
 #(#SequenceViewSpec
 "Do not manually edit this!! If it is corrupted,
 the UIPainter may not be able to read the specification."
 "
-UIPainter new openOnClass:ProjectBrowser andSelector:#emptyRightCanvasSpec
+UIPainter new openOnClass:ProjectBrowser andSelector:#rightCanvasSpecForReadOnlyText
-ProjectBrowser new openInterface:#emptyRightCanvasSpec
+ProjectBrowser new openInterface:#rightCanvasSpecForReadOnlyText
 "
 <resource: #canvas>
 ^
+#(#FullSpec
-#(#FullSpec
+#name: #rightCanvasSpecForReadOnlyText
 #window:
 #(#WindowSpec
-#name: 'NewApplication'
+#label: 'NewApplication'
-#layout: #(#LayoutFrame 216 0 173 0 515 0 472 0)
+#name: 'NewApplication'
-#label: 'NewApplication'
+#min: #(#Point 10 10)
-#min: #(#Point 10 10)
+#max: #(#Point 1280 1024)
-#max: #(#Point 1280 1024)
+#bounds: #(#Rectangle 216 173 516 473)
-#bounds: #(#Rectangle 216 173 516 473)
+)
-#usePreferredExtent: false
+#component:
-)
+#(#SpecCollection
-#component:
+#collection: #(
-#(#SpecCollection
+#(#TextEditorSpec
-#collection:
+#name: 'TextEditor1'
-#(
+#layout: #(#LayoutFrame 0 0.0 30 0.0 0 1.0 0 1.0)
-#(#TextEditorSpec
+#model: #rightCanvasTextHolder
-#name: 'TextEditor1'
+#hasHorizontalScrollBar: true
-#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+#hasVerticalScrollBar: true
-#model: #rightCanvasTextHolder
+#miniScrollerHorizontal: true
-#hasHorizontalScrollBar: true
+#isReadOnly: true
-#hasVerticalScrollBar: true
+)
-#miniScrollerHorizontal: true
+#(#LabelSpec
-#isReadOnly: true
+#label: 'Label'
-)
+#name: 'Label1'
-)
+#layout: #(#LayoutFrame 0 0 0 0 0 1 30 0)
-)
+#translateLabel: true
+#labelChannel: #textCanvasLabelHolder
+#adjust: #left
+)
+)
+)
 )
 !
 windowSpec
 "This resource specification was automatically generated
 #(#WindowSpec
 #label: 'ProjectBrowser'
 #name: 'ProjectBrowser'
 #min: #(#Point 10 10)
 #max: #(#Point 1024 768)
-#bounds: #(#Rectangle 13 33 616 535)
+#bounds: #(#Rectangle 30 377 633 928)
 #menu: #mainMenu
 )
 #component:
 #(#SpecCollection
 #collection: #(
 #enabled: #hasClassesSelectedHolder
 )
 #(#MenuItem
 #label: 'Add Classes found in image'
 #translateLabel: true
-#value: #addClassesImage
+#value: #addClassesFromImage
 #enabled: #hasClassesSelectedHolder
 )
 #(#MenuItem
 #label: 'Add Classes from files found in directory'
 #translateLabel: true
 holder onChangeSend:#projectFilterChanged to:self.
 ].
 ^ holder.
 "Created: / 23.3.1999 / 14:18:05 / cg"
+!
+textCanvasLabelHolder
+"automatically generated by UIPainter ..."
+|holder|
+(holder := builder bindingAt:#textCanvasLabelHolder) isNil ifTrue:[
+builder aspectAt:#textCanvasLabelHolder put:(holder :='' asValue).
+].
+^ holder.
 ! !
 !ProjectBrowser methodsFor:'change & update'!
 update:something with:aParameter from:changedObject
 docNode add:(userDocNode := ProjectTreeItem name:'Error Reports').
 docNode add:(userDocNode := ProjectTreeItem name:'Other').
 ].
 prerequisitesNode icon:(self class prerequisitesIcon).
-prerequisitesNode add:(prerequisiteProjectsNode := ProjectTreeItem name:'Projects').
+prerequisitesNode add:(prerequisiteProjectsNode := 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).
 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 deliverTarArchive value:(p propertyAt:#deliverTarArchive) ? false.
 self deliverLoadAllFile value:(p propertyAt:#deliverLoadAllFile) ? false.
 self deliverSources value:(p propertyAt:#deliverSources) ? false.
 self deliverMakefiles value:(p propertyAt:#deliverMakefiles) ? false.
 self installDirectoryUnix
 p := self currentProject.
 selectedNodeType := self selectedTreeNode contents.
 selectedNodeType == #comment ifTrue:[
+self halt.
 ^ self rightCanvasTextHolder value ~= p comment
 ].
 selectedNodeType == #deployment ifTrue:[
 (self deliverByteCode value ~= (p propertyAt:#deliverByteCode)) ifTrue:[^ true].
 (self deliverCompiledBinary value ~= (p propertyAt:#deliverCompiledBinary)) ifTrue:[^ true].
 ((p propertyAt:#installDirectory) ?
 'SYS$SMALLTALKX:[PACKAGES]')) ifTrue:[^ true].
 ^ false
 ].
+selectedNodeType == #files ifTrue:[
+^ true.
+(self methodsFile value ~= (p propertyAt:#methodsFile)) ifTrue:[^ true].
+^ false
+].
 self halt.
-(self methodsFile value ~~ (p propertyAt:#methodsFile)) ifTrue:[^ true].
 (self projectType value ~~ p type) ifTrue:[^ true].
 (self projectDirectory value ~= p directory) ifTrue:[^ true].
 (self projectPackage value ~= p package) ifTrue:[^ true].
 (self projectNamespace value ~= (p defaultNameSpace ? Smalltalk) name) ifTrue:[^ true].
 ] ifFalse:[
 ns := Namespace name:s
 ].
 p defaultNameSpace:ns.
+p propertyAt:#methodsFile put:self methodsFile value.
 p propertyAt:#deliverCompiledBinary put:self deliverCompiledBinary value.
 p propertyAt:#deliverByteCode put:self deliverByteCode value.
+p propertyAt:#deliverTarArchive put:self deliverTarArchive value.
 p propertyAt:#deliverZipArchive put:self deliverZipArchive value.
 p propertyAt:#deliverGZipArchive put:self deliverGZipArchive value.
 p propertyAt:#deliverLoadAllFile put:self deliverLoadAllFile value.
 p propertyAt:#deliverSources put:self deliverSources value.
 p propertyAt:#deliverMakefiles put:self deliverMakefiles value.
 p propertyAt:#installDirectoryUnix put:self installDirectoryUnix value.
 p propertyAt:#installDirectoryWin32 put:self installDirectoryWin32 value.
 p propertyAt:#installDirectoryVMS put:self installDirectoryVMS value.
 p propertyAt:#installDirectoryMacOS put:self installDirectoryMacOS value.
 p prerequisiteClasses:(self listOfRequiredClassesInPrerequisites value
 collect:[:entry | entry string asSymbol]).
 p addDependent:self.
 ].
 self rightCanvasTextHolder value:''.
 "Modified: / 23.3.1999 / 14:16:02 / cg"
 ! !
+!ProjectBrowser methodsFor:'private - building'!
+checkForMakeProtoFor:aProject
+|f|
+"/ check for project directory ...
+(self checkForProjectDirectoryFor:aProject) ifFalse:[
+^ false
+].
+"/ check for Make.proto ...
+f := aProject directory asFilename construct:'Make.proto'.
+f exists ifFalse:[
+(self confirm:'''Make.proto'' does not exist in project directory\\Create ?' withCRs) ifFalse:[
+^ false
+].
+self buildMakefiles.
+].
+^ true
+!
+checkForMakefileFor:aProject
+|f|
+"/ check for project directory ...
+(self checkForProjectDirectoryFor:aProject) ifFalse:[
+^ false
+].
+"/ check for Makefile ...
+f := aProject directory asFilename construct:'Makefile'.
+f exists ifFalse:[
+(self confirm:'''Makefile'' does not exist in project directory\\Create ?' withCRs) ifFalse:[
+^ false
+].
+(self checkForMakeProtoFor:aProject) ifFalse:[
+^ false
+].
+self buildMakefiles.
+].
+^ true
+!
+checkForProjectDirectoryFor:aProject
+|dir|
+"/ check for project directory ...
+dir := aProject directory asFilename.
+dir exists ifFalse:[
+(self confirm:'Project directory does not exist\\Create ?' withCRs) ifFalse:[
+^ false
+].
+dir recursiveMakeDirectory.
+].
+^ true
+! !
 !ProjectBrowser methodsFor:'private - table col access'!
 classFilenameFromClassInfo:cInfo
 ^ cInfo classFileName
 !
 selectorFromPatchesInfo:pInfo
 ^ pInfo methodSelector
 ! !
 !ProjectBrowser methodsFor:'user actions'!
+addClass
+"ask fo, and add a single class"
+|p className cls|
+p := self currentProject.
+className := Dialog request:'Class to add:'.
+className size == 0 ifTrue:[^ self].
+cls := Smalltalk classNamed:className.
+cls isNil ifTrue:[
+"/ a new one
+(self confirm:'This is a new class. Add ?') ifFalse:[
+^ self
+].
+p
+addClass:className
+classFileName:((Smalltalk fileNameForClass:className) , '.st').
+] ifFalse:[
+cls package ~= p package ifTrue:[
+"/ a new one
+(self confirm:'Change the classes package from ' , cls package , ' to ' , p package , ' ?') ifFalse:[
+^ self
+].
+cls package:p package.
+].
+p
+addClass:cls name
+classFileName:(cls classFilename
+? ((Smalltalk fileNameForClass:cls) , '.st')).
+].
+self updateClassListForProject:p
+!
+addClasses
+"ask fo, and add a single class"
+|p className cls oldPackage|
+p := self currentProject.
+className := Dialog request:'Class to add:'.
+className size == 0 ifTrue:[^ self].
+cls := Smalltalk classNamed:className.
+cls isNil ifTrue:[
+"/ a new one
+(self confirm:'This is a new class. Add ?') ifFalse:[
+^ self
+].
+p
+addClass:className
+classFileName:((Smalltalk fileNameForClass:className) , '.st').
+] ifFalse:[
+(oldPackage := cls package) ~= p package ifTrue:[
+"/ a new one
+(self confirm:'Change the classes package from ' , oldPackage , ' to ' , p package , ' ?') ifFalse:[
+^ self
+].
+cls package:p package.
+].
+"/ find the other package ..
+oldPackage := Project projectWithId:oldPackage.
+oldPackage notNil ifTrue:[
+oldPackage removeClass:cls
+].
+p
+addClass:cls name
+classFileName:(cls classFilename
+? ((Smalltalk fileNameForClass:cls) , '.st')).
+].
+self updateClassListForProject:p
+!
 addClassesFromFilesInDirectory
 self addClassesFromFilesInDirectoryWithFilter:nil
 !
 self information:'No st-sourcefiles found in ' , prjDirectory pathName.
 ]
 ]
 !
-addClassesImage
+addClassesFromImage
+"add classes with this packageId found in the image"
 |project|
 project := self currentProject.
 Smalltalk allClassesDo:[:aClass |
 aClass isMeta ifFalse:[
 (p propertyAt:#deliverLoadAllFile) == true ifTrue:[
 p createLoadAllFile
 ].
 (p propertyAt:#deliverSources) == true ifTrue:[
-p createLoadAllFile
+p createSourceFiles
+].
+(p propertyAt:#deliverMakefiles) == true ifTrue:[
+self buildMakefiles
 ].
 (p propertyAt:#deliverCompiledBinary) == true ifTrue:[
 self buildCompiledClassLibrary
 ].
 ].
 "/ now, deploy ...
 (p propertyAt:#deliverZipArchive) == true ifTrue:[
-p createLoadAllFile
+p buildZipArchive
 ].
+(p propertyAt:#deliverTarArchive) == true ifTrue:[
+p buildTarArchive
+].
 (p propertyAt:#deliverGZipArchive) == true ifTrue:[
-p createLoadAllFile
+p buildGZipArchive
 ].
 ].
 !
 buildCompiledClassLibrary
 "compile a binary class library in the projects directory"
-|p dir f diagnosticFile diagnostic error textBox|
+|p diagnosticFile diagnostic error textBox|
 p := self currentProject.
 p isNil ifTrue:[
 self information:'No project selected'.
 ^ self
 ].
-"/ check for project directory ...
+"/ check for directory ...
-dir := p directory asFilename.
+(self checkForProjectDirectoryFor:p) ifFalse:[
-dir exists ifFalse:[
+^ self
-(self confirm:'Project directory does not exist\\Create ?' withCRs) ifFalse:[
-^ self
-].
-dir recursiveMakeDirectory.
 ].
 "/ check for Make.proto ...
-f := dir construct:'Make.proto'.
+(self checkForMakeProtoFor:p) ifFalse:[
-f exists ifFalse:[
+^ self
-(self confirm:'''Make.proto'' does not exist in project directory\\Create ?' withCRs) ifFalse:[
-^ self
-].
-self buildMakefiles.
 ].
 "/ check for Makefile ...
-f := dir construct:'Makefile'.
+(self checkForMakefileFor:p) ifFalse:[
-f exists ifFalse:[
+^ self
-(self confirm:'''Makefile'' does not exist in project directory\\Create ?' withCRs) ifFalse:[
-^ self
-].
-p createMakefile.
 ].
 "/ now, execute the makefile found there ...
 diagnosticFile := Filename newTemporary.
 diagnostic := diagnosticFile writeStream.
 OperatingSystem
 executeCommand:'make'
 inputFrom:nil
 outputTo:diagnostic
 errorTo:diagnostic
-inDirectory:(dir pathName)
+inDirectory:(p directory asFilename pathName)
 onError:[error := true].
 ].
 diagnostic close.
 |item action info p|
 self withWaitCursorDo:[
 self updateRightCanvas.
 ].
+index isNil ifTrue:[
+modifiedChannel value:false.
+^ self
+].
 self readAspectsFromProject.
 item := self projectTreeHolder value at:index.
 action := item action.
 action notNil ifTrue:[
 ].
 ].
 self valueOfInfoLabel value:info.
 self hasProjectSelectedHolder value:self hasProjectSelected.
+modifiedChannel value:false.
 "Modified: / 26.4.1999 / 22:49:20 / cg"
 !
 loadClassesFromDirectory
 newNode == self selectedTreeNode ifTrue:[
 ^ true
 ].
 (modifiedChannel value
-and:[self reallyModified]) ifTrue:[
+and:[true "self reallyModified"]) ifTrue:[
 answer := Dialog confirmWithCancel:'Accept changes ?'.
 answer isNil ifTrue:[
 ^ false
 ].
 answer == true ifTrue:[
 ] ifFalse:[
 projectItem := anItem
 ].
 project := projectItem contents.
+self textCanvasLabelHolder value:'Projects comment'.
 self currentCanvasHolder value:(self class rightCanvasSpecForEditableText).
 self rightCanvasTextHolder value:project comment.
 !

changeset 1232	6c68d44a9151
parent 1231	7d025840ea10
child 1234	97ec3bf7d991