ProjectBrowser.st
changeset 1206 25053439af63
parent 1149 00b17864e6ef
child 1207 9a14f97ee279
--- a/ProjectBrowser.st	Wed Sep 01 12:10:22 1999 +0200
+++ b/ProjectBrowser.st	Thu Sep 02 23:14:04 1999 +0200
@@ -675,36 +675,35 @@
 
     <resource: #canvas>
 
-    ^
-     
-       #(#FullSpec
-          #window: 
-           #(#WindowSpec
-              #name: 'NewApplication'
-              #layout: #(#LayoutFrame 216 0 173 0 515 0 472 0)
-              #level: 0
-              #label: 'NewApplication'
-              #min: #(#Point 10 10)
-              #max: #(#Point 1280 1024)
-              #bounds: #(#Rectangle 216 173 516 473)
-              #usePreferredExtent: false
-          )
-          #component: 
-           #(#SpecCollection
-              #collection: 
-               #(
-                 #(#DataSetSpec
-                    #name: 'patchesTable'
-                    #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
-                    #hasHorizontalScrollBar: true
-                    #hasVerticalScrollBar: true
-                    #dataList: #patchesList
-                    #has3Dsepartors: false
-                    #columnHolder: #patchesTableColumns
-                    #columnAdaptor: #classTableAdaptor
-                )
-              )
-          )
+    ^ 
+     #(#FullSpec
+        #name: #rightCanvasSpecForPatchesList
+        #window: 
+       #(#WindowSpec
+          #label: 'NewApplication'
+          #name: 'NewApplication'
+          #min: #(#Point 10 10)
+          #max: #(#Point 1280 1024)
+          #bounds: #(#Rectangle 16 49 316 349)
+        )
+        #component: 
+       #(#SpecCollection
+          #collection: #(
+           #(#DataSetSpec
+              #name: 'patchesTable'
+              #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+              #model: #selectedPatch
+              #menu: #menu
+              #hasHorizontalScrollBar: true
+              #hasVerticalScrollBar: true
+              #dataList: #patchesList
+              #has3Dsepartors: false
+              #columnHolder: #patchesTableColumns
+              #columnAdaptor: #classTableAdaptor
+            )
+           )
+         
+        )
       )
 !
 
@@ -1502,6 +1501,43 @@
             )
           )
          #(#MenuItem
+            #label: 'View'
+            #translateLabel: true
+            #submenu: 
+           #(#Menu
+              #(
+               #(#MenuItem
+                  #label: 'Current Project'
+                  #translateLabel: true
+                  #choice: #showWhat
+                  #choiceValue: #current
+                )
+               #(#MenuItem
+                  #label: 'Non BaseSystem Projects'
+                  #translateLabel: true
+                  #choice: #showWhat
+                  #choiceValue: #userProjects
+                )
+               #(#MenuItem
+                  #label: 'All Projects'
+                  #translateLabel: true
+                  #choice: #showWhat
+                  #choiceValue: #all
+                )
+               #(#MenuItem
+                  #label: '-'
+                )
+               #(#MenuItem
+                  #label: 'Update'
+                  #translateLabel: true
+                  #value: #updateListOfProjects
+                )
+               )
+              nil
+              nil
+            )
+          )
+         #(#MenuItem
             #label: 'Project'
             #translateLabel: true
             #submenuChannel: #projectItemMenu
@@ -1579,33 +1615,19 @@
      #(#Menu
         #(
          #(#MenuItem
-            #label: 'New...'
+            #label: 'Browse'
             #translateLabel: true
-            #isButton: true
-            #value: #newProject
-            #labelImage: #(#ResourceRetriever #Icon #newIcon)
+            #value: #browseMethod
           )
          #(#MenuItem
-            #label: 'Open...'
+            #label: 'Browse Full'
             #translateLabel: true
-            #isButton: true
-            #value: #openProject
-            #labelImage: #(#ResourceRetriever #Icon #loadIcon)
-          )
-         #(#MenuItem
-            #label: 'SaveAs...'
-            #translateLabel: true
-            #isButton: true
-            #value: #saveProject
-            #enabled: #hasProjectSelectedHolder
-            #labelImage: #(#ResourceRetriever #Icon #saveIcon)
+            #value: #browseMethodFull
           )
          )
         nil
         nil
       )
-
-    "Modified: / 26.4.1999 / 22:45:25 / cg"
 !
 
 noItemMenu
@@ -1829,21 +1851,25 @@
 
     <resource: #tableColumns>
 
-
-    ^ #(
-        #(#DataSetColumnSpec
-           #label: 'Class'
-           #id: 'classColumn'
-           #labelAlignment: #left
-           #model: #classNameFromPatchesInfo:
+    ^#(
+      #(#DataSetColumnSpec
+         #label: 'Class'
+         #id: 'classColumn'
+         #labelAlignment: #left
+         #menu: #patchesMethodMenu
+         #model: #classNameFromPatchesInfo:
+         #doubleClickedSelector: #methodPatchDoubleClick:
+         #canSelect: false
        )
-        #(#DataSetColumnSpec
-           #label: 'Selector'
-           #id: 'selectorColumn'
-           #labelAlignment: #left
-           #model: #selectorFromPatchesInfo:
+      #(#DataSetColumnSpec
+         #label: 'Selector'
+         #id: 'selectorColumn'
+         #labelAlignment: #left
+         #model: #selectorFromPatchesInfo:
+         #canSelect: false
        )
-     )
+      )
+    
 ! !
 
 !ProjectBrowser methodsFor:'accessing'!
@@ -1869,17 +1895,24 @@
 !
 
 browseClass
-    |node className cls|
+    |node classOrClassName cls|
 
     self hasClassNodeSelected ifFalse:[^ self].
 
     node := self selectedTreeNode.
-    className := node contents value.
-    cls := Smalltalk at:className.
+    classOrClassName := node contents value.
+    classOrClassName isBehavior ifTrue:[
+        cls := classOrClassName.
+    ] ifFalse:[
+        cls := Smalltalk at:classOrClassName.
+    ].
     cls isNil ifTrue:[
         self information:'The class is not (yet) loaded'.
         ^ self.
     ].
+    cls isLoaded ifFalse:[
+        self information:'The class is an autoloaded class.'.
+    ].
     SystemBrowser openInClass:cls selector:nil.
 
 !
@@ -2454,6 +2487,17 @@
     "Created: / 23.3.1999 / 14:18:05 / cg"
 !
 
+selectedPatch
+    "automatically generated by UIPainter ..."
+
+    |holder|
+
+    (holder := builder bindingAt:#selectedPatch) isNil ifTrue:[
+        builder aspectAt:#selectedPatch put:(holder :=  ValueHolder new).
+    ].
+    ^ holder.
+!
+
 selectedProjectInPrerequisites
     "automatically generated by UIPainter ..."
 
@@ -2502,6 +2546,19 @@
         builder aspectAt:#selectedTreeNodeHolder put:(holder :=  ValueHolder new).
     ].
     ^ holder.
+!
+
+showWhat
+    |holder|
+
+    (holder := builder bindingAt:#showWhat) isNil ifTrue:[
+        holder := ValueHolder with:#current.
+        builder aspectAt:#showWhat put:holder.
+        holder onChangeSend:#updateProjectTree to:self.
+    ].
+    ^ holder.
+
+    "Created: / 23.3.1999 / 14:18:05 / cg"
 ! !
 
 !ProjectBrowser methodsFor:'change & update'!
@@ -2659,10 +2716,12 @@
 
     p := self currentProject.
     ^ (p classes ? #()) 
-        collect:[:classOrSymbol | 
-                    classOrSymbol isSymbol 
-                        ifTrue:[classOrSymbol] 
-                        ifFalse:[Smalltalk at:classOrSymbol asSymbol ifAbsent:[classOrSymbol]]
+        collect:[:classOrSymbol |
+                    classOrSymbol isBehavior ifTrue:[
+                        classOrSymbol name
+                    ] ifFalse:[
+                        classOrSymbol
+                    ]
                 ]
 
 !
@@ -2797,14 +2856,14 @@
     ((aProject classes ? #()) copy sort:[:a :b | 
                                                 |nmA nmB|
 
-                                                nmA := a isSymbol ifTrue:[a] ifFalse:[a name].
-                                                nmB := b isSymbol ifTrue:[b] ifFalse:[b name].
+                                                nmA := a isBehavior ifTrue:[a name] ifFalse:[a].
+                                                nmB := b isBehavior ifTrue:[b name] ifFalse:[b].
                                                 nmA < nmB
                                         ]) 
     do:[:aClass |
         |cNode cName|
 
-        cName := aClass isSymbol ifTrue:[aClass] ifFalse:[aClass name].
+        cName := aClass isBehavior ifTrue:[aClass name] ifFalse:[aClass].
         cNode := ProjectTreeItem name:cName.
         cNode contents:(#class -> aClass).
         cNode icon:classIcon.
@@ -2834,16 +2893,8 @@
 !
 
 projectTree
-    |tree root|
-
     projectTree isNil ifTrue:[
-        tree := SelectionInTree new.
-        tree root:(root := TreeItem name:'invisibleRoot').
-
-        Project knownProjects do:[:aProject |
-            root add:(self nodeFor:aProject).
-        ].
-        projectTree := root.
+        self updateProjectTree
     ].
 
     ^ projectTree
@@ -2961,6 +3012,33 @@
     "Modified: / 23.3.1999 / 14:18:38 / cg"
 !
 
+updateProjectTree
+    |tree root showWhat|
+
+    showWhat := self showWhat value.
+
+    tree := SelectionInTree new.
+    tree root:(root := TreeItem name:'invisibleRoot').
+    root hide:false.
+
+    (Project knownProjects asOrderedCollection
+        sort:[:a :b | a packageName < b packageName]) 
+    do:[:aProject |
+        |doShow|
+
+        (doShow := showWhat == #all) ifFalse:[
+            doShow := (aProject package startsWith:'stx:') not
+        ].
+        doShow ifTrue:[
+            root add:(self nodeFor:aProject).
+        ]
+    ].
+    projectTree := root.
+
+    self projectTreeHolder root:projectTree.
+    ^ projectTree
+!
+
 updateRightCanvas
     |selectedNode nodeContents spec|
 
@@ -3168,12 +3246,16 @@
 !
 
 itemDoubleClicked:index
-    |node className cls|
+    |node classOrClassName cls|
 
     self hasClassNodeSelected ifTrue:[
         node := self selectedTreeNode.
-        className := node contents value.
-        cls := Smalltalk at:className.
+        classOrClassName := node contents value.
+        classOrClassName isBehavior ifTrue:[
+            cls := classOrClassName.
+        ] ifFalse:[
+            cls := Smalltalk at:classOrClassName.
+        ].
         cls isNil ifTrue:[
             self information:'The class is not (yet) loaded'.
             ^ self
@@ -3185,8 +3267,9 @@
 itemSelected:index
     |item action|
 
-    self updateRightCanvas.
-
+    self withWaitCursorDo:[
+        self updateRightCanvas.
+    ].
     self readAspectsFromProject.
 
     item := self projectTreeHolder value at:index.
@@ -3235,6 +3318,10 @@
     ]
 !
 
+methodPatchDoubleClick:arg
+self halt.
+!
+
 newProject
     self newProject:Project new.
 
@@ -3378,15 +3465,19 @@
 !
 
 showClassDefinitionOf:anItem
-    |node className cls text|
+    |node classOrClassName cls text|
 
     self hasClassNodeSelected ifFalse:[^ self].
 
     self currentCanvasHolder value:(self class rightCanvasSpecForEditableText).
 
     node := self selectedTreeNode.
-    className := node contents value.
-    cls := Smalltalk at:className.
+    classOrClassName := node contents value.
+    classOrClassName isBehavior ifTrue:[
+        cls := classOrClassName.
+    ] ifFalse:[
+        cls := Smalltalk at:classOrClassName.
+    ].
     cls isNil ifTrue:[
         text := 'The class is not (yet) loaded'.
     ] ifFalse:[
@@ -3486,14 +3577,24 @@
 
 !
 
+updateListOfProjects
+    "scan all classes/methods for new projects"
+
+    self withWaitCursorDo:[
+        Project initKnownProjects.
+        self updateProjectTree
+    ].
+!
+
 updateListOfRequiredPrerequisiteClasses
     "all autoloaded superclasses of my classes are definitely required"
 
-    |p anyChange allInPre requiredInPre nMissing|
+    |p anyChange allInPre requiredInPre nTotal nMissing msg|
 
     p := self currentProject.
     p isNil ifTrue:[^ self].
     anyChange := false.
+    nTotal := 0.
     nMissing := 0.
     allInPre := self listOfAllClassesInPrerequisites value.
     requiredInPre := self listOfRequiredClassesInPrerequisites value.
@@ -3522,7 +3623,8 @@
             ]
         ] ifFalse:[
             nMissing := nMissing + 1.
-        ]
+        ].
+        nTotal := nTotal + 1.
     ].
 
     anyChange ifTrue:[
@@ -3530,10 +3632,16 @@
         self listOfAllClassesInPrerequisites changed.
     ].
     nMissing ~~ 0 ifTrue:[
-        self information:'Update not complete - ' , nMissing printString
-                        , ' of the projects classes are not loaded'.
+        nMissing == nTotal ifTrue:[
+            msg := 'Project is not loaded (' , nMissing printString
+                            , ' unloaded classes)'.
+        ] ifFalse:[
+            msg := 'Project is not loaded completely - ' , nMissing printString
+                            , ' of the projects ' , nTotal printString , ' classes are not loaded'.
+        ].
+        self notify:msg.
     ].
-    self accept.
+    modifiedChannel value:false.
 ! !
 
 !ProjectBrowser methodsFor:'user actions - canvas'!
@@ -3593,6 +3701,28 @@
 
 !
 
+browseMethod
+    "browse the selected table-rows method (from patches canvas)"
+
+    |patchWho patchIndex|
+
+    patchIndex := self selectedPatch value.
+    patchWho := self patchesList at:patchIndex.
+    SystemBrowser browseClass:patchWho methodClass selector:patchWho methodSelector.
+
+!
+
+browseMethodFull
+    "browse the selected table-rows method (from patches canvas)"
+
+    |patchWho patchIndex|
+
+    patchIndex := self selectedPatch value.
+    patchWho := self patchesList at:patchIndex.
+    SystemBrowser openInClass:patchWho methodClass selector:patchWho methodSelector.
+
+!
+
 cancel
     "reload aspects from the project"