diff -r 7d025840ea10 -r 6c68d44a9151 ProjectBrowser.st --- 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 @@ - ^ - - #(#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 " - ^ - - #(#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 " - ^ - - #(#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.