ProjectBrowser.st
changeset 1231 7d025840ea10
parent 1229 49777692d309
child 1232 6c68d44a9151
--- a/ProjectBrowser.st	Wed Sep 22 20:11:46 1999 +0200
+++ b/ProjectBrowser.st	Wed Sep 22 20:11:59 1999 +0200
@@ -103,16 +103,16 @@
 #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
@@ -121,9 +121,12 @@
 #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.'
 
@@ -454,15 +457,15 @@
           #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'
-              #name: 'FramedBox1'
-              #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 197 0)
+              #label: 'Deliver'
+              #name: 'DeliverBox'
+              #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 172 0)
               #labelPosition: #topLeft
               #translateLabel: true
               #component: 
@@ -471,55 +474,46 @@
                  #(#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)'
-                    #name: 'CheckBox1'
-                    #layout: #(#LayoutFrame 0 0.0 39 0 0 1.0 61 0)
-                    #activeHelpKey: #deliverBinary
+                    #label: 'Sources'
+                    #name: 'CheckBox4'
+                    #layout: #(#LayoutFrame 0 0.0 90 0 0 1.0 112 0)
+                    #activeHelpKey: #deliverSources
                     #tabable: true
-                    #model: #deliverCompiledBinary
+                    #model: #deliverSources
                     #translateLabel: true
                   )
                  #(#CheckBoxSpec
-                    #label: 'Zip Archive'
-                    #name: 'CheckBox2'
-                    #layout: #(#LayoutFrame 0 0.0 68 0 0 1.0 90 0)
-                    #activeHelpKey: #deliverAsZIP
+                    #label: 'Makefiles'
+                    #name: 'CheckBox8'
+                    #layout: #(#LayoutFrame 0 0.0 113 0 0 1.0 135 0)
+                    #activeHelpKey: #deliverMakefiles
                     #tabable: true
-                    #model: #deliverZipArchive
-                    #translateLabel: true
-                  )
-                 #(#CheckBoxSpec
-                    #label: 'GZip Archive (self extracting)'
-                    #name: 'CheckBox3'
-                    #layout: #(#LayoutFrame 0 0.0 97 0 0 1.0 119 0)
-                    #activeHelpKey: #deliverAsGZIP
-                    #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
+                    #model: #deliverMakefiles
                     #translateLabel: true
                   )
                  )
@@ -527,9 +521,49 @@
               )
             )
            #(#FramedBoxSpec
-              #label: 'Install Directory'
-              #name: 'FramedBox2'
-              #layout: #(#LayoutFrame 0 0.0 209 0 0 1.0 362 0)
+              #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 10 0 0 1.0 32 0)
+                    #activeHelpKey: #deliverZipArchive
+                    #tabable: true
+                    #model: #deliverZipArchive
+                    #translateLabel: true
+                  )
+                 #(#CheckBoxSpec
+                    #label: 'GZip Archive (self extracting for unix)'
+                    #name: 'CheckBox3'
+                    #layout: #(#LayoutFrame 0 0.0 58 0 0 1.0 80 0)
+                    #activeHelpKey: #deliverGZipArchive
+                    #tabable: true
+                    #model: #deliverGZipArchive
+                    #translateLabel: true
+                  )
+                 )
+               
+              )
+            )
+           #(#FramedBoxSpec
+              #label: 'Target Install Directory'
+              #name: 'DestinationBox'
+              #layout: #(#LayoutFrame 0 0.0 295 0 0 1.0 448 0)
               #labelPosition: #topLeft
               #translateLabel: true
               #component: 
@@ -721,13 +755,13 @@
           #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
@@ -1186,14 +1220,9 @@
        #(#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)
-          #usePreferredExtent: false
-          #returnIsOKInDialog: true
-          #escapeIsCancelInDialog: true
+          #bounds: #(#Rectangle 216 173 577 536)
         )
         #component: 
        #(#SpecCollection
@@ -1232,7 +1261,7 @@
               )
             )
            #(#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
@@ -1248,6 +1277,7 @@
                     #model: #projectDirectory
                     #acceptChannel: #acceptChannel
                     #modifiedChannel: #modifiedChannel
+                    #acceptOnPointerLeave: false
                   )
                  )
                
@@ -1269,6 +1299,7 @@
                     #model: #projectPackage
                     #acceptChannel: #acceptChannel
                     #modifiedChannel: #modifiedChannel
+                    #acceptOnPointerLeave: false
                   )
                  )
                
@@ -1297,6 +1328,7 @@
                     #model: #repositoryModule
                     #acceptChannel: #acceptChannel
                     #modifiedChannel: #modifiedChannel
+                    #acceptOnPointerLeave: false
                   )
                  #(#LabelSpec
                     #label: 'Directory:'
@@ -1312,6 +1344,7 @@
                     #model: #repositoryDirectory
                     #acceptChannel: #acceptChannel
                     #modifiedChannel: #modifiedChannel
+                    #acceptOnPointerLeave: false
                   )
                  )
                
@@ -1333,6 +1366,7 @@
                     #model: #projectNamespace
                     #acceptChannel: #acceptChannel
                     #modifiedChannel: #modifiedChannel
+                    #acceptOnPointerLeave: false
                   )
                  )
                
@@ -2379,6 +2413,20 @@
     "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 ..."
 
@@ -2393,6 +2441,20 @@
     "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"
+!
+
 deliverZipArchive
     "automatically generated by UIPainter ..."
 
@@ -2847,7 +2909,7 @@
     (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.
 
@@ -3261,6 +3323,7 @@
     deploymentNode icon:(self class deploymentIcon).
     deploymentNode spec:[self class rightCanvasSpecForDeployment].
     deploymentNode info:'Deployment & packaging specification.'.
+    deploymentNode contents:#deployment.
 
     ^ pNode
 
@@ -3310,8 +3373,9 @@
         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) ? 
@@ -3350,6 +3414,77 @@
     "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|
 
@@ -3383,10 +3518,11 @@
 
         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.
@@ -3405,50 +3541,52 @@
 updateProjectTree
     |tree moduleRoots root showWhat|
 
-    showWhat := self showWhat value.
-
-    moduleRoots := Dictionary new.
-
-    tree := SelectionInTree new.
-    tree root:(root := ProjectTreeItem name:'invisibleRoot').
-    root hide:false.
-
-    showWhat notNil ifTrue:[
-        showWhat == #current ifTrue:[
-            root add:(self nodeFor:Project current).
-        ] ifFalse:[
-            (Project knownProjects asOrderedCollection
-                sort:[:a :b | a package < b package]) 
-            do:[:aProject |
-                |newNode nodeToAdd doShow childNode path|
-
-                (doShow := showWhat == #all) ifFalse:[
-                    doShow := (aProject package startsWith:'stx:') not
+    self withCursor:Cursor execute do:[
+        showWhat := self showWhat value.
+
+        moduleRoots := Dictionary new.
+
+        tree := SelectionInTree new.
+        tree root:(root := ProjectTreeItem name:'invisibleRoot').
+        root hide:false.
+
+        showWhat notNil ifTrue:[
+            showWhat == #current ifTrue:[
+                root add:(self nodeFor:Project current).
+            ] ifFalse:[
+                (Project knownProjects asOrderedCollection
+                    sort:[:a :b | a package < b package]) 
+                do:[:aProject |
+                    |newNode nodeToAdd doShow childNode path|
+
+                    (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.
+
+        self projectTreeHolder root:projectTree.
     ].
-    projectTree := root.
-
-    self projectTreeHolder root:projectTree.
     ^ projectTree
 !
 
@@ -4119,6 +4257,23 @@
     ]
 !
 
+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|
 
@@ -4187,7 +4342,8 @@
     newNode == self selectedTreeNode ifTrue:[
         ^ true 
     ].
-    modifiedChannel value ifTrue:[
+    (modifiedChannel value 
+    and:[self reallyModified]) ifTrue:[
         answer := Dialog confirmWithCancel:'Accept changes ?'.
         answer isNil ifTrue:[
             ^ false