--- a/ProjectBrowser.st Wed Sep 22 20:11:59 1999 +0200
+++ b/ProjectBrowser.st Wed Sep 22 21:09:36 1999 +0200
@@ -358,34 +358,33 @@
<resource: #canvas>
- ^
-
- #(#FullSpec
- #window:
- #(#WindowSpec
- #name: 'NewApplication'
- #layout: #(#LayoutFrame 216 0 173 0 515 0 472 0)
- #label: 'NewApplication'
- #min: #(#Point 10 10)
- #max: #(#Point 1280 1024)
- #bounds: #(#Rectangle 216 173 516 473)
- #usePreferredExtent: false
- )
- #component:
- #(#SpecCollection
- #collection:
- #(
- #(#TextEditorSpec
- #name: 'TextEditor1'
- #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #model: #rightCanvasTextHolder
- #hasHorizontalScrollBar: true
- #hasVerticalScrollBar: true
- #miniScrollerHorizontal: true
- #isReadOnly: true
- )
- )
- )
+ ^
+ #(#FullSpec
+ #name: #emptyRightCanvasSpec
+ #window:
+ #(#WindowSpec
+ #label: 'NewApplication'
+ #name: 'NewApplication'
+ #min: #(#Point 10 10)
+ #max: #(#Point 1280 1024)
+ #bounds: #(#Rectangle 10 20 310 320)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#TextEditorSpec
+ #name: 'TextEditor1'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #initiallyInvisible: true
+ #model: #rightCanvasTextHolder
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #isReadOnly: true
+ )
+ )
+
+ )
)
!
@@ -695,40 +694,45 @@
the UIPainter may not be able to read the specification."
"
- UIPainter new openOnClass:ProjectBrowser andSelector:#emptyRightCanvasSpec
- ProjectBrowser new openInterface:#emptyRightCanvasSpec
+ UIPainter new openOnClass:ProjectBrowser andSelector:#rightCanvasSpecForEditableText
+ ProjectBrowser new openInterface:#rightCanvasSpecForEditableText
"
<resource: #canvas>
- ^
-
- #(#FullSpec
- #window:
- #(#WindowSpec
- #name: 'NewApplication'
- #layout: #(#LayoutFrame 216 0 173 0 515 0 472 0)
- #label: 'NewApplication'
- #min: #(#Point 10 10)
- #max: #(#Point 1280 1024)
- #bounds: #(#Rectangle 216 173 516 473)
- #usePreferredExtent: false
- )
- #component:
- #(#SpecCollection
- #collection:
- #(
- #(#TextEditorSpec
- #name: 'TextEditor1'
- #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #model: #rightCanvasTextHolder
- #hasHorizontalScrollBar: true
- #hasVerticalScrollBar: true
- #miniScrollerHorizontal: true
- #isReadOnly: false
- )
- )
- )
+ ^
+ #(#FullSpec
+ #name: #rightCanvasSpecForEditableText
+ #window:
+ #(#WindowSpec
+ #label: 'NewApplication'
+ #name: 'NewApplication'
+ #min: #(#Point 10 10)
+ #max: #(#Point 1280 1024)
+ #bounds: #(#Rectangle 216 173 516 473)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#TextEditorSpec
+ #name: 'TextEditor1'
+ #layout: #(#LayoutFrame 0 0.0 30 0.0 0 1.0 0 1.0)
+ #model: #rightCanvasTextHolder
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ )
+ #(#LabelSpec
+ #label: 'Label'
+ #name: 'Label1'
+ #layout: #(#LayoutFrame 0 0 0 0 0 1 30 0)
+ #translateLabel: true
+ #labelChannel: #textCanvasLabelHolder
+ #adjust: #left
+ )
+ )
+
+ )
)
!
@@ -1090,7 +1094,7 @@
#(#SpecCollection
#collection: #(
#(#LabelSpec
- #label: 'Known Projects'
+ #label: 'Known Packages'
#name: 'Label1'
#layout: #(#LayoutFrame 0 0 0 0 0 0.5 30 0)
#translateLabel: true
@@ -1419,40 +1423,46 @@
the UIPainter may not be able to read the specification."
"
- UIPainter new openOnClass:ProjectBrowser andSelector:#emptyRightCanvasSpec
- ProjectBrowser new openInterface:#emptyRightCanvasSpec
+ UIPainter new openOnClass:ProjectBrowser andSelector:#rightCanvasSpecForReadOnlyText
+ ProjectBrowser new openInterface:#rightCanvasSpecForReadOnlyText
"
<resource: #canvas>
- ^
-
- #(#FullSpec
- #window:
- #(#WindowSpec
- #name: 'NewApplication'
- #layout: #(#LayoutFrame 216 0 173 0 515 0 472 0)
- #label: 'NewApplication'
- #min: #(#Point 10 10)
- #max: #(#Point 1280 1024)
- #bounds: #(#Rectangle 216 173 516 473)
- #usePreferredExtent: false
- )
- #component:
- #(#SpecCollection
- #collection:
- #(
- #(#TextEditorSpec
- #name: 'TextEditor1'
- #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #model: #rightCanvasTextHolder
- #hasHorizontalScrollBar: true
- #hasVerticalScrollBar: true
- #miniScrollerHorizontal: true
- #isReadOnly: true
- )
- )
- )
+ ^
+ #(#FullSpec
+ #name: #rightCanvasSpecForReadOnlyText
+ #window:
+ #(#WindowSpec
+ #label: 'NewApplication'
+ #name: 'NewApplication'
+ #min: #(#Point 10 10)
+ #max: #(#Point 1280 1024)
+ #bounds: #(#Rectangle 216 173 516 473)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#TextEditorSpec
+ #name: 'TextEditor1'
+ #layout: #(#LayoutFrame 0 0.0 30 0.0 0 1.0 0 1.0)
+ #model: #rightCanvasTextHolder
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #isReadOnly: true
+ )
+ #(#LabelSpec
+ #label: 'Label'
+ #name: 'Label1'
+ #layout: #(#LayoutFrame 0 0 0 0 0 1 30 0)
+ #translateLabel: true
+ #labelChannel: #textCanvasLabelHolder
+ #adjust: #left
+ )
+ )
+
+ )
)
!
@@ -1480,7 +1490,7 @@
#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:
@@ -1606,7 +1616,7 @@
#(#MenuItem
#label: 'Add Classes found in image'
#translateLabel: true
- #value: #addClassesImage
+ #value: #addClassesFromImage
#enabled: #hasClassesSelectedHolder
)
#(#MenuItem
@@ -2914,6 +2924,17 @@
^ 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'!
@@ -3257,7 +3278,7 @@
].
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'.
@@ -3373,6 +3394,7 @@
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.
@@ -3421,6 +3443,7 @@
selectedNodeType := self selectedTreeNode contents.
selectedNodeType == #comment ifTrue:[
+self halt.
^ self rightCanvasTextHolder value ~= p comment
].
selectedNodeType == #deployment ifTrue:[
@@ -3451,8 +3474,13 @@
^ 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].
@@ -3516,8 +3544,11 @@
].
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.
@@ -3528,6 +3559,7 @@
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]).
@@ -3639,6 +3671,65 @@
"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
@@ -3671,6 +3762,84 @@
!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
!
@@ -3738,7 +3907,9 @@
]
!
-addClassesImage
+addClassesFromImage
+ "add classes with this packageId found in the image"
+
|project|
project := self currentProject.
@@ -3819,7 +3990,11 @@
].
(p propertyAt:#deliverSources) == true ifTrue:[
- p createLoadAllFile
+ p createSourceFiles
+ ].
+
+ (p propertyAt:#deliverMakefiles) == true ifTrue:[
+ self buildMakefiles
].
(p propertyAt:#deliverCompiledBinary) == true ifTrue:[
@@ -3833,14 +4008,16 @@
"/ 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
].
-
-
].
@@ -3848,7 +4025,7 @@
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:[
@@ -3856,31 +4033,19 @@
^ self
].
- "/ check for project directory ...
- dir := p directory asFilename.
- dir exists ifFalse:[
- (self confirm:'Project directory does not exist\\Create ?' withCRs) ifFalse:[
- ^ self
- ].
- dir recursiveMakeDirectory.
+ "/ check for directory ...
+ (self checkForProjectDirectoryFor:p) ifFalse:[
+ ^ self
].
"/ check for Make.proto ...
- f := dir construct:'Make.proto'.
- f exists ifFalse:[
- (self confirm:'''Make.proto'' does not exist in project directory\\Create ?' withCRs) ifFalse:[
- ^ self
- ].
- self buildMakefiles.
+ (self checkForMakeProtoFor:p) ifFalse:[
+ ^ self
].
"/ check for Makefile ...
- f := dir construct:'Makefile'.
- f exists ifFalse:[
- (self confirm:'''Makefile'' does not exist in project directory\\Create ?' withCRs) ifFalse:[
- ^ self
- ].
- p createMakefile.
+ (self checkForMakefileFor:p) ifFalse:[
+ ^ self
].
"/ now, execute the makefile found there ...
@@ -3895,7 +4060,7 @@
inputFrom:nil
outputTo:diagnostic
errorTo:diagnostic
- inDirectory:(dir pathName)
+ inDirectory:(p directory asFilename pathName)
onError:[error := true].
].
@@ -4035,6 +4200,11 @@
self withWaitCursorDo:[
self updateRightCanvas.
].
+ index isNil ifTrue:[
+ modifiedChannel value:false.
+ ^ self
+ ].
+
self readAspectsFromProject.
item := self projectTreeHolder value at:index.
@@ -4053,6 +4223,7 @@
self valueOfInfoLabel value:info.
self hasProjectSelectedHolder value:self hasProjectSelected.
+ modifiedChannel value:false.
"Modified: / 26.4.1999 / 22:49:20 / cg"
!
@@ -4343,7 +4514,7 @@
^ true
].
(modifiedChannel value
- and:[self reallyModified]) ifTrue:[
+ and:[true "self reallyModified"]) ifTrue:[
answer := Dialog confirmWithCancel:'Accept changes ?'.
answer isNil ifTrue:[
^ false
@@ -4400,6 +4571,7 @@
].
project := projectItem contents.
+ self textCanvasLabelHolder value:'Projects comment'.
self currentCanvasHolder value:(self class rightCanvasSpecForEditableText).
self rightCanvasTextHolder value:project comment.