hg/stx-libtool2: comparison ProjectBrowser.st

equal deleted inserted replaced

-:71fe2a968b1d
+:25053439af63
 ProjectBrowser new openInterface:#rightCanvasSpecForPatchesList
 "
 <resource: #canvas>
 ^
+#(#FullSpec
-#(#FullSpec
+#name: #rightCanvasSpecForPatchesList
 #window:
 #(#WindowSpec
-#name: 'NewApplication'
+#label: 'NewApplication'
-#layout: #(#LayoutFrame 216 0 173 0 515 0 472 0)
+#name: 'NewApplication'
-#level: 0
+#min: #(#Point 10 10)
-#label: 'NewApplication'
+#max: #(#Point 1280 1024)
-#min: #(#Point 10 10)
+#bounds: #(#Rectangle 16 49 316 349)
-#max: #(#Point 1280 1024)
+)
-#bounds: #(#Rectangle 216 173 516 473)
+#component:
-#usePreferredExtent: false
+#(#SpecCollection
-)
+#collection: #(
-#component:
+#(#DataSetSpec
-#(#SpecCollection
+#name: 'patchesTable'
-#collection:
+#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
-#(
+#model: #selectedPatch
-#(#DataSetSpec
+#menu: #menu
-#name: 'patchesTable'
+#hasHorizontalScrollBar: true
-#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+#hasVerticalScrollBar: true
-#hasHorizontalScrollBar: true
+#dataList: #patchesList
-#hasVerticalScrollBar: true
+#has3Dsepartors: false
-#dataList: #patchesList
+#columnHolder: #patchesTableColumns
-#has3Dsepartors: false
+#columnAdaptor: #classTableAdaptor
-#columnHolder: #patchesTableColumns
+)
-#columnAdaptor: #classTableAdaptor
+)
-)
 )
-)
 )
 !
 rightCanvasSpecForPrerequisiteClasses
 "This resource specification was automatically generated
 nil
 nil
 )
 )
 #(#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
 )
 #(#MenuItem
 ^
 #(#Menu
 #(
 #(#MenuItem
-#label: 'New...'
+#label: 'Browse'
 #translateLabel: true
-#isButton: true
+#value: #browseMethod
-#value: #newProject
-#labelImage: #(#ResourceRetriever #Icon #newIcon)
 )
 #(#MenuItem
-#label: 'Open...'
+#label: 'Browse Full'
 #translateLabel: true
-#isButton: true
+#value: #browseMethodFull
-#value: #openProject
-#labelImage: #(#ResourceRetriever #Icon #loadIcon)
-)
-#(#MenuItem
-#label: 'SaveAs...'
-#translateLabel: true
-#isButton: true
-#value: #saveProject
-#enabled: #hasProjectSelectedHolder
-#labelImage: #(#ResourceRetriever #Icon #saveIcon)
 )
 )
 nil
 nil
 )
-"Modified: / 26.4.1999 / 22:45:25 / cg"
 !
 noItemMenu
 "This resource specification was automatically generated
 by the MenuEditor of ST/X."
 DataSetBuilder new openOnClass:ProjectBrowser andSelector:#patchesTableColumns
 "
 <resource: #tableColumns>
+^#(
-^ #(
+#(#DataSetColumnSpec
-#(#DataSetColumnSpec
+#label: 'Class'
-#label: 'Class'
+#id: 'classColumn'
-#id: 'classColumn'
+#labelAlignment: #left
-#labelAlignment: #left
+#menu: #patchesMethodMenu
 #model: #classNameFromPatchesInfo:
+#doubleClickedSelector: #methodPatchDoubleClick:
+#canSelect: false
 )
 #(#DataSetColumnSpec
 #label: 'Selector'
 #id: 'selectorColumn'
 #labelAlignment: #left
 #model: #selectorFromPatchesInfo:
+#canSelect: false
 )
 )
 ! !
 !ProjectBrowser methodsFor:'accessing'!
 selectedTreeNode
 "Created: / 23.3.1999 / 14:18:05 / cg"
 !
 browseClass
-|node className cls|
+|node classOrClassName cls|
 self hasClassNodeSelected ifFalse:[^ self].
 node := self selectedTreeNode.
-className := node contents value.
+classOrClassName := node contents value.
-cls := Smalltalk at:className.
+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.
 !
 ^ holder.
 "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 ..."
 |holder|
 (holder := builder bindingAt:#selectedTreeNodeHolder) isNil ifTrue:[
 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'!
 update:something with:aParameter from:changedObject
 currentProjectsClassNames
 |p|
 p := self currentProject.
 ^ (p classes ? #())
 collect:[:classOrSymbol |
-classOrSymbol isSymbol
+classOrSymbol isBehavior ifTrue:[
-ifTrue:[classOrSymbol]
+classOrSymbol name
-ifFalse:[Smalltalk at:classOrSymbol asSymbol ifAbsent:[classOrSymbol]]
+] ifFalse:[
+classOrSymbol
+]
 ]
 !
 hasClassNodeSelected
 classesNode icon:(self class classesIcon).
 classesNode info:'Classes contained in the project'.
 ((aProject classes ? #()) copy sort:[:a :b |
 |nmA nmB|
-nmA := a isSymbol ifTrue:[a] ifFalse:[a name].
+nmA := a isBehavior ifTrue:[a name] ifFalse:[a].
-nmB := b isSymbol ifTrue:[b] ifFalse:[b name].
+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.
 classesNode add:cNode.
 ].
 "Modified: / 23.3.1999 / 14:27:30 / cg"
 !
 projectTree
-|tree root|
 projectTree isNil ifTrue:[
-tree := SelectionInTree new.
+self updateProjectTree
-tree root:(root := TreeItem name:'invisibleRoot').
-Project knownProjects do:[:aProject |
-root add:(self nodeFor:aProject).
-].
-projectTree := root.
 ].
 ^ projectTree
 !
 p addDependent:self.
 ].
 "Created: / 23.3.1999 / 14:16:12 / cg"
 "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|
 project inspect.
 ]
 !
 itemDoubleClicked:index
-|node className cls|
+|node classOrClassName cls|
 self hasClassNodeSelected ifTrue:[
 node := self selectedTreeNode.
-className := node contents value.
+classOrClassName := node contents value.
-cls := Smalltalk at:className.
+classOrClassName isBehavior ifTrue:[
+cls := classOrClassName.
+] ifFalse:[
+cls := Smalltalk at:classOrClassName.
+].
 cls isNil ifTrue:[
 self information:'The class is not (yet) loaded'.
 ^ self
 ].
 SystemBrowser browseClass:cls.
 !
 itemSelected:index
 |item action|
-self updateRightCanvas.
+self withWaitCursorDo:[
+self updateRightCanvas.
+].
 self readAspectsFromProject.
 item := self projectTreeHolder value at:index.
 action := item action.
 action notNil ifTrue:[
 selectedNode := self selectedTreeNode.
 project := selectedNode contents.
 Project current:project.
 ]
+!
+methodPatchDoubleClick:arg
+self halt.
 !
 newProject
 self newProject:Project new.
 ^ true
 !
 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.
+classOrClassName := node contents value.
-cls := Smalltalk at:className.
+classOrClassName isBehavior ifTrue:[
+cls := classOrClassName.
+] ifFalse:[
+cls := Smalltalk at:classOrClassName.
+].
 cls isNil ifTrue:[
 text := 'The class is not (yet) loaded'.
 ] ifFalse:[
 text := cls definition
 ].
 l addAll:classInfo.
 !
+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.
 self currentProjectsClassNames do:[:aClassName |
 ]
 ]
 ]
 ] ifFalse:[
 nMissing := nMissing + 1.
-]
+].
+nTotal := nTotal + 1.
 ].
 anyChange ifTrue:[
 self listOfRequiredClassesInPrerequisites changed.
 self listOfAllClassesInPrerequisites changed.
 ].
 nMissing ~~ 0 ifTrue:[
-self information:'Update not complete - ' , nMissing printString
+nMissing == nTotal ifTrue:[
-, ' of the projects classes are not loaded'.
+msg := 'Project is not loaded (' , nMissing printString
-].
+, ' unloaded classes)'.
-self accept.
+] ifFalse:[
+msg := 'Project is not loaded completely - ' , nMissing printString
+, ' of the projects ' , nTotal printString , ' classes are not loaded'.
+].
+self notify:msg.
+].
+modifiedChannel value:false.
 ! !
 !ProjectBrowser methodsFor:'user actions - canvas'!
 accept
 self listOfAllProjectsInPrerequisites changed.
 self accept
 !
+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"
 self readAspectsFromProject
 !

changeset 1206	25053439af63
parent 1149	00b17864e6ef
child 1207	9a14f97ee279