hg/stx-libtool2: comparison ProjectBrowser.st

equal deleted inserted replaced

-:23e5d0c133e8
+:7d025840ea10
 'Undo modifications made here.'
 #defaultNamespace
 'Namespace for new classes when created in the Browser.'
-#deliverAsGZIP
+#deliverGZipArchive
 'Package delivery into a gzip archive (for unix)'
-#deliverAsTar
+#deliverTarArchive
 'Package delivery into a tar archive (for unix)'
-#deliverAsZIP
+#deliverZipArchive
 'Package delivery into a zip archive (for win32)'
-#deliverBinary
+#deliverCompiledBinary
 'Create and deliver as compiled binary (classLibrary) - will only execute on the running systems architecture.'
 #deliverByteCode
 'Create and deliver as bytecode - portable across architectures.'
 #deliverLoadAll
 'Deliver a loadAll script file, which files-In the other files.'
-#deliverSource
+#deliverSources
 'Include smalltalk sourceCode in the delivery.'
+#deliverMakefiles
+'Include makefiles in the delivery.'
 #includeSource
 'Include smalltalk sourceCode in the delivery.'
 #installDirMacOS
 #(#WindowSpec
 #label: 'NewApplication'
 #name: 'NewApplication'
 #min: #(#Point 10 10)
 #max: #(#Point 1280 1024)
-#bounds: #(#Rectangle 216 173 569 569)
+#bounds: #(#Rectangle 40 127 393 626)
 )
 #component:
 #(#SpecCollection
 #collection: #(
 #(#FramedBoxSpec
-#label: 'Delivery'
+#label: 'Deliver'
-#name: 'FramedBox1'
+#name: 'DeliverBox'
-#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 197 0)
+#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 172 0)
 #labelPosition: #topLeft
 #translateLabel: true
 #component:
 #(#SpecCollection
 #collection: #(
 #(#CheckBoxSpec
 #label: '''loadAll''-File'
 #name: 'CheckBox5'
-#layout: #(#LayoutFrame 0 0.0 10 0 0 1.0 32 0)
+#layout: #(#LayoutFrame 0 0.0 67 0 0 1.0 89 0)
 #activeHelpKey: #deliverLoadAll
 #tabable: true
 #model: #deliverLoadAllFile
 #translateLabel: true
 )
 #(#CheckBoxSpec
-#label: 'Bytecode Binary'
+#label: 'Compiled Binary (non-portable .dll / .so)'
+#name: 'CheckBox6'
+#layout: #(#LayoutFrame 0 0.0 32 0 0 1.0 54 0)
+#activeHelpKey: #deliverCompiledBinary
+#tabable: true
+#model: #deliverCompiledBinary
+#translateLabel: true
+)
+#(#CheckBoxSpec
+#label: 'Bytecode Binary (portable)'
 #name: 'CheckBox1'
-#layout: #(#LayoutFrame 0 0.0 39 0 0 1.0 61 0)
+#layout: #(#LayoutFrame 0 0.0 8 0 0 1.0 30 0)
 #activeHelpKey: #deliverByteCode
 #tabable: true
 #model: #deliverByteCode
 #translateLabel: true
 )
 #(#CheckBoxSpec
-#label: 'Compiled Binary (.dll / .so)'
+#label: 'Sources'
-#name: 'CheckBox1'
+#name: 'CheckBox4'
-#layout: #(#LayoutFrame 0 0.0 39 0 0 1.0 61 0)
+#layout: #(#LayoutFrame 0 0.0 90 0 0 1.0 112 0)
-#activeHelpKey: #deliverBinary
+#activeHelpKey: #deliverSources
 #tabable: true
-#model: #deliverCompiledBinary
+#model: #deliverSources
 #translateLabel: true
 )
 #(#CheckBoxSpec
-#label: 'Zip Archive'
+#label: 'Makefiles'
+#name: 'CheckBox8'
+#layout: #(#LayoutFrame 0 0.0 113 0 0 1.0 135 0)
+#activeHelpKey: #deliverMakefiles
+#tabable: true
+#model: #deliverMakefiles
+#translateLabel: true
+)
+)
+)
+)
+#(#FramedBoxSpec
+#label: 'Format'
+#name: 'DeliverAsBox'
+#layout: #(#LayoutFrame 0 0.0 172 0 0 1.0 290 0)
+#labelPosition: #topLeft
+#translateLabel: true
+#component:
+#(#SpecCollection
+#collection: #(
+#(#CheckBoxSpec
+#label: 'Tar Archive (.tar - for unix)'
+#name: 'CheckBox7'
+#layout: #(#LayoutFrame 0 0.0 34 0 0 1.0 56 0)
+#activeHelpKey: #deliverTarArchive
+#tabable: true
+#model: #deliverTarArchive
+#translateLabel: true
+)
+#(#CheckBoxSpec
+#label: 'Zip Archive (.zip - for windows)'
 #name: 'CheckBox2'
-#layout: #(#LayoutFrame 0 0.0 68 0 0 1.0 90 0)
+#layout: #(#LayoutFrame 0 0.0 10 0 0 1.0 32 0)
-#activeHelpKey: #deliverAsZIP
+#activeHelpKey: #deliverZipArchive
 #tabable: true
 #model: #deliverZipArchive
 #translateLabel: true
 )
 #(#CheckBoxSpec
-#label: 'GZip Archive (self extracting)'
+#label: 'GZip Archive (self extracting for unix)'
 #name: 'CheckBox3'
-#layout: #(#LayoutFrame 0 0.0 97 0 0 1.0 119 0)
+#layout: #(#LayoutFrame 0 0.0 58 0 0 1.0 80 0)
-#activeHelpKey: #deliverAsGZIP
+#activeHelpKey: #deliverGZipArchive
 #tabable: true
 #model: #deliverGZipArchive
-#translateLabel: true
-)
-#(#CheckBoxSpec
-#label: 'Include Sources'
-#name: 'CheckBox4'
-#layout: #(#LayoutFrame 0 0.0 138 0 0 1.0 160 0)
-#activeHelpKey: #deliverSource
-#tabable: true
-#model: #deliverSources
 #translateLabel: true
 )
 )
 )
 )
 #(#FramedBoxSpec
-#label: 'Install Directory'
+#label: 'Target Install Directory'
-#name: 'FramedBox2'
+#name: 'DestinationBox'
-#layout: #(#LayoutFrame 0 0.0 209 0 0 1.0 362 0)
+#layout: #(#LayoutFrame 0 0.0 295 0 0 1.0 448 0)
 #labelPosition: #topLeft
 #translateLabel: true
 #component:
 #(#SpecCollection
 #collection: #(
 #(#WindowSpec
 #label: 'NewApplication'
 #name: 'NewApplication'
 #min: #(#Point 10 10)
 #max: #(#Point 1280 1024)
-#bounds: #(#Rectangle 240 31 601 394)
+#bounds: #(#Rectangle 216 173 577 536)
 )
 #component:
 #(#SpecCollection
 #collection: #(
 #(#FramedBoxSpec
-#label: 'File for system extensions & patches'
+#label: 'File for extensions & patches'
 #name: 'FramedBox2'
 #layout: #(#LayoutFrame 0 0.0 62 0.0 0 1.0 122 0)
 #labelPosition: #topLeft
 #translateLabel: true
 #component:
 #name: #rightCanvasSpecForProperties
 #window:
 #(#WindowSpec
 #label: 'NewApplication'
 #name: 'NewApplication'
-#layout: #(#LayoutFrame 119 0 158 0 479 0 520 0)
-#level: 0
 #min: #(#Point 10 10)
 #max: #(#Point 1280 1024)
-#bounds: #(#Rectangle 119 158 480 521)
+#bounds: #(#Rectangle 216 173 577 536)
-#usePreferredExtent: false
-#returnIsOKInDialog: true
-#escapeIsCancelInDialog: true
 )
 #component:
 #(#SpecCollection
 #collection: #(
 #(#FramedBoxSpec
 )
 )
 )
 #(#FramedBoxSpec
-#label: 'Project Directory'
+#label: 'Project Working Directory'
 #name: 'FramedBox2'
 #layout: #(#LayoutFrame 0 0.0 62 0.0 0 1.0 122 0)
 #labelPosition: #topLeft
 #translateLabel: true
 #component:
 #activeHelpKey: #projectDir
 #enableChannel: #currentProjectWasNotLoadedFromFile
 #model: #projectDirectory
 #acceptChannel: #acceptChannel
 #modifiedChannel: #modifiedChannel
+#acceptOnPointerLeave: false
 )
 )
 )
 )
 #layout: #(#LayoutFrame 0 0.0 1 0 0 1.0 23 0)
 #activeHelpKey: #packageID
 #model: #projectPackage
 #acceptChannel: #acceptChannel
 #modifiedChannel: #modifiedChannel
+#acceptOnPointerLeave: false
 )
 )
 )
 )
 #layout: #(#LayoutFrame 92 0.0 0 0 0 1.0 22 0)
 #activeHelpKey: #repositoryModule
 #model: #repositoryModule
 #acceptChannel: #acceptChannel
 #modifiedChannel: #modifiedChannel
+#acceptOnPointerLeave: false
 )
 #(#LabelSpec
 #label: 'Directory:'
 #name: 'Label2'
 #layout: #(#LayoutFrame 0 0 25 0 86 0 47 0)
 #layout: #(#LayoutFrame 92 0.0 25 0 0 1.0 47 0)
 #activeHelpKey: #repositoryDirectory
 #model: #repositoryDirectory
 #acceptChannel: #acceptChannel
 #modifiedChannel: #modifiedChannel
+#acceptOnPointerLeave: false
 )
 )
 )
 )
 #name: 'EntryField4'
 #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 22 0)
 #model: #projectNamespace
 #acceptChannel: #acceptChannel
 #modifiedChannel: #modifiedChannel
+#acceptOnPointerLeave: false
 )
 )
 )
 )
 ^ holder.
 "Created: / 23.3.1999 / 14:18:05 / cg"
 !
+deliverMakefiles
+"automatically generated by UIPainter ..."
+|holder|
+(holder := builder bindingAt:#deliverMakefiles) isNil ifTrue:[
+builder aspectAt:#deliverMakefiles put:(holder :=  ValueHolder new).
+holder onChangeSend:#value to:[modifiedChannel value:true].
+].
+^ holder.
+"Created: / 23.3.1999 / 14:18:05 / cg"
+!
 deliverSources
 "automatically generated by UIPainter ..."
 |holder|
 (holder := builder bindingAt:#deliverSources) isNil ifTrue:[
 builder aspectAt:#deliverSources put:(holder :=  ValueHolder new).
+holder onChangeSend:#value to:[modifiedChannel value:true].
+].
+^ holder.
+"Created: / 23.3.1999 / 14:18:05 / cg"
+!
+deliverTarArchive
+"automatically generated by UIPainter ..."
+|holder|
+(holder := builder bindingAt:#deliverTarArchive) isNil ifTrue:[
+builder aspectAt:#deliverTarArchive put:(holder :=  ValueHolder new).
 holder onChangeSend:#value to:[modifiedChannel value:true].
 ].
 ^ holder.
 "Created: / 23.3.1999 / 14:18:05 / cg"
 |holder|
 (holder := builder bindingAt:#showWhat) isNil ifTrue:[
 holder := ValueHolder new.
 builder aspectAt:#showWhat put:holder.
-holder onChangeSend:#updateProjectTree to:self.
+holder onChangeSend:#projectFilterChanged to:self.
 ].
 ^ holder.
 "Created: / 23.3.1999 / 14:18:05 / cg"
 ! !
 ].
 deploymentNode icon:(self class deploymentIcon).
 deploymentNode spec:[self class rightCanvasSpecForDeployment].
 deploymentNode info:'Deployment & packaging specification.'.
+deploymentNode contents:#deployment.
 ^ pNode
 "Modified: / 23.3.1999 / 14:27:30 / cg"
 !
 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 deliverLoadAllFile value:(p propertyAt:#deliverLoadAllFile) ? false.
 self deliverSources value:(p propertyAt:#deliverSources) ? false.
-self deliverLoadAllFile value:(p propertyAt:#deliverLoadAllFile) ? false.
+self deliverMakefiles value:(p propertyAt:#deliverMakefiles) ? false.
 self installDirectoryUnix
 value:(p propertyAt:#installDirectoryUnix) ?
 ((p propertyAt:#installDirectory) ? '/opt/smalltalk/packages').
 self installDirectoryWin32
 "Created: / 23.3.1999 / 14:16:12 / cg"
 "Modified: / 26.4.1999 / 23:38:14 / cg"
 !
+reallyModified
+|p l selectedNodeType|
+p := self currentProject.
+selectedNodeType := self selectedTreeNode contents.
+selectedNodeType == #comment ifTrue:[
+^ self rightCanvasTextHolder value ~= p comment
+].
+selectedNodeType == #deployment ifTrue:[
+(self deliverByteCode value ~= (p propertyAt:#deliverByteCode)) ifTrue:[^ true].
+(self deliverCompiledBinary value ~= (p propertyAt:#deliverCompiledBinary)) ifTrue:[^ true].
+(self deliverLoadAllFile value ~= (p propertyAt:#deliverLoadAllFile)) ifTrue:[^ true].
+(self deliverSources value ~= (p propertyAt:#deliverSources)) ifTrue:[^ true].
+(self deliverMakefiles value ~= (p propertyAt:#deliverMakefiles)) ifTrue:[^ true].
+(self deliverZipArchive value ~= (p propertyAt:#deliverZipArchive)) ifTrue:[^ true].
+(self deliverTarArchive value ~= (p propertyAt:#deliverTarArchive)) ifTrue:[^ true].
+(self deliverGZipArchive value ~= (p propertyAt:#deliverGZipArchive)) ifTrue:[^ true].
+self installDirectoryUnix value ~=
+((p propertyAt:#installDirectoryUnix) ?
+((p propertyAt:#installDirectory) ?
+'/opt/smalltalk/packages')) ifTrue:[^ true].
+self installDirectoryWin32 value ~=
+((p propertyAt:#installDirectoryWin32) ?
+((p propertyAt:#installDirectory) ?
+'\Programme\SmalltalkX\packages')) ifTrue:[^ true].
+self installDirectoryVMS value ~=
+((p propertyAt:#installDirectoryVMS) ?
+((p propertyAt:#installDirectory) ?
+'SYS$SMALLTALKX:[PACKAGES]')) 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].
+(self repositoryModule value ~= p repositoryModule) ifTrue:[^ true].
+(self repositoryDirectory value ~= p repositoryDirectory) ifTrue:[^ true].
+"/        self installDirectoryMacOS value ~=
+"/                ((p propertyAt:#installDirectoryMacOS) ?
+"/                    ((p propertyAt:#installDirectory) ?
+"/                        '\Programme\SmalltalkX')) ifTrue:[^ true].
+l := p prerequisitePackages collect:[:entry |
+|pName|
+entry isString ifTrue:[
+pName := entry
+] ifFalse:[
+entry isArray ifTrue:[
+pName := entry at:1
+] ifFalse:[
+pName := entry name
+]
+]
+].
+self listOfRequiredProjectsInPrerequisites value ~= (l sort) ifTrue:[^ true].
+self listOfRequiredClassesInPrerequisites value ~= (p prerequisiteClasses copy sort)  ifTrue:[^ true].
+self halt.
+!
 saveAspectsIntoProject
 |p s ns dir|
 p := self currentProject.
 p notNil ifTrue:[
 ].
 p defaultNameSpace:ns.
 p propertyAt:#deliverCompiledBinary put:self deliverCompiledBinary value.
 p propertyAt:#deliverByteCode put:self deliverByteCode value.
-p propertyAt:#deliverSources put:self deliverSources 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.
 !
 updateProjectTree
 |tree moduleRoots root showWhat|
-showWhat := self showWhat value.
+self withCursor:Cursor execute do:[
+showWhat := self showWhat value.
-moduleRoots := Dictionary new.
+moduleRoots := Dictionary new.
-tree := SelectionInTree new.
-tree root:(root := ProjectTreeItem name:'invisibleRoot').
+tree := SelectionInTree new.
-root hide:false.
+tree root:(root := ProjectTreeItem name:'invisibleRoot').
+root hide:false.
-showWhat notNil ifTrue:[
-showWhat == #current ifTrue:[
+showWhat notNil ifTrue:[
-root add:(self nodeFor:Project current).
+showWhat == #current ifTrue:[
-] ifFalse:[
+root add:(self nodeFor:Project current).
-(Project knownProjects asOrderedCollection
+] ifFalse:[
-sort:[:a :b | a package < b package])
+(Project knownProjects asOrderedCollection
-do:[:aProject |
+sort:[:a :b | a package < b package])
-|newNode nodeToAdd doShow childNode path|
+do:[:aProject |
+|newNode nodeToAdd doShow childNode path|
-(doShow := showWhat == #all) ifFalse:[
-doShow := (aProject package startsWith:'stx:') not
+(doShow := showWhat == #all) ifFalse:[
+doShow := (aProject package startsWith:'stx:') not
+].
+doShow ifTrue:[
+newNode := self nodeFor:aProject.
+"/ insert into tree ...
+nodeToAdd := root.
+path := aProject package asCollectionOfSubstringsSeparatedByAny:'/\:'.
+path from:1 to:path size-1 do:[:part |
+childNode := nodeToAdd children detect:[:child | child name = part] ifNone:nil.
+childNode isNil ifTrue:[
+nodeToAdd add:(childNode := ProjectTreeItem new name:part).
+].
+nodeToAdd := childNode.
+].
+newNode name:(path last).
+nodeToAdd add:newNode.
+]
 ].
-doShow ifTrue:[
-newNode := self nodeFor:aProject.
-"/ insert into tree ...
-nodeToAdd := root.
-path := aProject package asCollectionOfSubstringsSeparatedByAny:'/\:'.
-path from:1 to:path size-1 do:[:part |
-childNode := nodeToAdd children detect:[:child | child name = part] ifNone:nil.
-childNode isNil ifTrue:[
-nodeToAdd add:(childNode := ProjectTreeItem new name:part).
-].
-nodeToAdd := childNode.
-].
-newNode name:(path last).
-nodeToAdd add:newNode.
-]
 ].
 ].
-].
+projectTree := root.
-projectTree := root.
+self projectTreeHolder root:projectTree.
-self projectTreeHolder root:projectTree.
+].
 ^ projectTree
 !
 updateRightCanvas
 |selectedNode nodeContents spec|
 fn notNil ifTrue:[
 self loadFromProjectFile:fn.
 ]
 !
+projectFilterChanged
+|theNode|
+self updateProjectTree.
+self updateRightCanvas.
+self showWhat value == #current ifTrue:[
+theNode := self projectTreeHolder
+detectFirstItem:[:item | item contents == Project current].
+[theNode notNil] whileTrue:[
+self projectTreeHolder expand:theNode.
+theNode := theNode parent.
+].
+].
+!
 removeProject
 |projectToRemove selectedNode subNode newNode parentNode parentProject newProject|
 self hasProjectNodeSelected ifTrue:[
 selectedNode := self selectedTreeNode.
 |answer|
 newNode == self selectedTreeNode ifTrue:[
 ^ true
 ].
-modifiedChannel value ifTrue:[
+(modifiedChannel value
+and:[self reallyModified]) ifTrue:[
 answer := Dialog confirmWithCancel:'Accept changes ?'.
 answer isNil ifTrue:[
 ^ false
 ].
 answer == true ifTrue:[

changeset 1231	7d025840ea10
parent 1229	49777692d309
child 1232	6c68d44a9151