hg/stx-libtool2: comparison ProjectBrowser.st

equal deleted inserted replaced

-:ca6590dae738
+:d5616023622e
 #model: #rightCanvasTextHolder
 #hasHorizontalScrollBar: true
 #hasVerticalScrollBar: true
 #miniScrollerHorizontal: true
 #isReadOnly: true
+)
+)
+)
+)
+!
+methodValidationDialogSpec
+"This resource specification was automatically generated
+by the UIPainter of ST/X."
+"Do not manually edit this!! If it is corrupted,
+the UIPainter may not be able to read the specification."
+"
+UIPainter new openOnClass:ProjectBrowser andSelector:#classValidationDialogSpec
+ProjectBrowser new openInterface:#classValidationDialogSpec
+"
+<resource: #canvas>
+^
+#(#FullSpec
+#name: #classValidationDialogSpec
+#window:
+#(#WindowSpec
+#label: 'ProjectBrowser'
+#name: 'ProjectBrowser'
+#min: #(#Point 10 10)
+#max: #(#Point 1024 768)
+#bounds: #(#Rectangle 24 554 457 1003)
+#menu: #mainMenu
+#icon: #bigProjectBrowserIcon
+)
+#component:
+#(#SpecCollection
+#collection: #(
+#(#VariableVerticalPanelSpec
+#name: 'VariableVerticalPanel1'
+#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -30 1.0)
+#handles:
+#(#OrderedCollection
+#Any 0.5
+1.0
+)
+#component:
+#(#SpecCollection
+#collection: #(
+#(#ViewSpec
+#name: 'Box1'
+#component:
+#(#SpecCollection
+#collection: #(
+#(#LabelSpec
+#label: 'Methods only in Image'
+#name: 'Label1'
+#layout: #(#LayoutFrame 0 0 0 0 0 1 30 0)
+#translateLabel: true
+#adjust: #left
+)
+#(#SequenceViewSpec
+#name: 'List2'
+#layout: #(#LayoutFrame 0 0.0 30 0.0 0 1.0 0 1.0)
+#hasHorizontalScrollBar: true
+#hasVerticalScrollBar: true
+#useIndex: false
+#sequenceList: #methodsInImageOnly
+)
+)
+)
+)
+#(#ViewSpec
+#name: 'Box2'
+#component:
+#(#SpecCollection
+#collection: #(
+#(#LabelSpec
+#label: 'Methods only in Project'
+#name: 'Label2'
+#layout: #(#LayoutFrame 0 0 0 0 0 1 30 0)
+#translateLabel: true
+#adjust: #left
+)
+#(#SequenceViewSpec
+#name: 'List1'
+#layout: #(#LayoutFrame 0 0.0 30 0.0 0 1.0 0 1.0)
+#hasHorizontalScrollBar: true
+#hasVerticalScrollBar: true
+#useIndex: false
+#sequenceList: #methodsInProjectOnly
+)
+)
+)
+)
+)
+)
+)
+#(#HorizontalPanelViewSpec
+#name: 'HorizontalPanel1'
+#layout: #(#LayoutFrame 0 0 -30 1 0 1 0 1)
+#horizontalLayout: #center
+#verticalLayout: #center
+#horizontalSpace: 3
+#verticalSpace: 3
+#component:
+#(#SpecCollection
+#collection: #(
+#(#ActionButtonSpec
+#label: 'OK'
+#name: 'Button1'
+#translateLabel: true
+#model: #closeRequest
+#extent: #(#Point 125 22)
+)
+)
+)
 )
 )
 )
 )
 nil
 nil
 )
 !
+methodsItemMenu
+"This resource specification was automatically generated
+by the MenuEditor of ST/X."
+"Do not manually edit this!! If it is corrupted,
+the MenuEditor may not be able to read the specification."
+"
+MenuEditor new openOnClass:ProjectBrowser andSelector:#menu
+(Menu new fromLiteralArrayEncoding:(ProjectBrowser menu)) startUp
+"
+<resource: #menu>
+^
+#(#Menu
+#(
+#(#MenuItem
+#label: '-'
+)
+#(#MenuItem
+#label: 'Validate...'
+#translateLabel: true
+#value: #validateAgainstMethodsInImage
+#enabled: #hasMethodsSelectedHolder
+)
+)
+nil
+nil
+)
+!
 noItemMenu
 "This resource specification was automatically generated
 by the MenuEditor of ST/X."
 "Do not manually edit this!! If it is corrupted,
 ^ self class classItemMenu
 ].
 self hasMethodNodeSelected ifTrue:[
 ^ self class methodItemMenu
 ].
+self hasPatchesNodeSelected ifTrue:[
+^ self class methodsItemMenu
+].
 self hasPrerequisiteClassesNodeSelected ifTrue:[
 ^ self class prerequisiteClassesItemMenu
 ].
 ^ nil
 !
 and:[selectedNode contents key == #class]
 !
 hasClassesNodeSelected
+^ self hasNodeSelected:#classes.
+!
+hasMethodNodeSelected
 |selectedNode|
 selectedNode := self selectedTreeNode.
 selectedNode isNil ifTrue:[^ false].
-^ selectedNode contents == #classes
+^ selectedNode contents isAssociation
+and:[selectedNode contents key == #method]
-!
+!
-hasMethodNodeSelected
+hasNodeSelected
+^ self selectedTreeNode notNil
+!
+hasNodeSelected:type
 |selectedNode|
 selectedNode := self selectedTreeNode.
 selectedNode isNil ifTrue:[^ false].
-^ selectedNode contents isAssociation
+^ selectedNode contents == type
-and:[selectedNode contents key == #method]
+!
-!
+hasPatchesNodeSelected
-hasMethodsNodeSelected
+^ self hasNodeSelected:#patches.
-|selectedNode|
-selectedNode := self selectedTreeNode.
-selectedNode isNil ifTrue:[^ false].
-^ selectedNode contents key == #patches
-!
-hasNodeSelected
-^ self selectedTreeNode notNil
 !
 hasPrerequisiteClassesNodeSelected
-|selectedNode|
+^ self hasNodeSelected:#prerequisiteClasses.
-selectedNode := self selectedTreeNode.
-selectedNode isNil ifTrue:[^ false].
-^ selectedNode contents == #prerequisiteClasses
 !
 hasProjectNodeSelected
 |selectedNode|
 ].
 ^ false.
 !
 hasSubProjectsNodeSelected
-|selectedNode|
+^ self hasNodeSelected:#subprojects.
-selectedNode := self selectedTreeNode.
-selectedNode isNil ifTrue:[^ false].
-^ selectedNode contents == #subprojects
 !
 makeTranscriptVisible
 |transcript|
 methodIcon := self class methodIcon.
 patchesNode contents:#patches.
 patchesNode icon:(self class methodsIcon).
 patchesNode info:'Patches & Extensions (system-changes) contained in the project'.
-((aProject methodInfo ? #()) copy
+(aProject methodInfo copy
 sort:[:a :b |
 a displayString < b displayString.
 ]
 ) do:[:aMethodInfo |
 |cNode cName|
 SimpleDialog
 openDialogInterfaceSpec:(self class classValidationDialogSpec)
 withBindings:bindings
 "Modified: / 26.9.1999 / 16:03:50 / cg"
+!
+validateAgainstMethodsInImage
+"validate methods in project against methods found in the image"
+|project package methodsInProjectOnly methodsInImageOnly bindings who|
+project := self currentProject.
+package := project package.
+methodsInImageOnly := IdentitySet new.
+methodsInProjectOnly := IdentitySet new.
+Method allSubInstancesDo:[:aMethod |
+aMethod package = package ifTrue:[
+who := aMethod who.
+who notNil ifTrue:[
+(project classInfoFor:who methodClass) isNil ifTrue:[
+"/ is it in the projects methodList ?
+(project includesMethod:aMethod) ifFalse:[
+methodsInImageOnly add:(who methodClass name , ' ' , who methodSelector).
+]
+]
+]
+]
+].
+project methodInfo do:[:mthdInfo |
+|clsName sel cls m|
+clsName := mthdInfo className.
+sel := mthdInfo methodName.
+cls := Smalltalk at:clsName asSymbol.
+(project includesClass:clsName) ifFalse:[
+(cls isBehavior not
+or:[(m := cls compiledMethodAt:sel) isNil
+or:[m package ~= package]]) ifTrue:[
+methodsInProjectOnly add:(clsName , ' ' , sel)
+].
+].
+].
+(methodsInImageOnly isEmpty and:[methodsInProjectOnly isEmpty]) ifTrue:[
+self information:'Set of methods in project and image are equal.'.
+^ self.
+].
+methodsInImageOnly := methodsInImageOnly asOrderedCollection sort:[:a :b | a printString < b printString].
+methodsInProjectOnly := methodsInProjectOnly asOrderedCollection sort:[:a :b | a printString < b printString].
+bindings := IdentityDictionary new.
+bindings at:#methodsInImageOnly put:methodsInImageOnly.
+bindings at:#methodsInProjectOnly put:methodsInProjectOnly.
+SimpleDialog
+openDialogInterfaceSpec:(self class methodValidationDialogSpec)
+withBindings:bindings
+"Modified: / 26.9.1999 / 16:03:50 / cg"
 ! !
 !ProjectBrowser::ProjectTreeItem methodsFor:'accessing'!
 action

changeset 1255	d5616023622e
parent 1254	ca6590dae738
child 1267	db910ada83f7