--- a/ProjectBrowser.st Sat Oct 09 13:35:49 1999 +0200
+++ b/ProjectBrowser.st Sat Oct 09 14:21:55 1999 +0200
@@ -588,6 +588,126 @@
)
!
+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)
+ )
+ )
+
+ )
+ )
+ )
+
+ )
+ )
+!
+
rightCanvasSpecForBuildOptions
"This resource specification was automatically generated
by the UIPainter of ST/X."
@@ -2345,6 +2465,38 @@
)
!
+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."
@@ -3552,6 +3704,9 @@
self hasMethodNodeSelected ifTrue:[
^ self class methodItemMenu
].
+ self hasPatchesNodeSelected ifTrue:[
+ ^ self class methodsItemMenu
+ ].
self hasPrerequisiteClassesNodeSelected ifTrue:[
^ self class prerequisiteClassesItemMenu
].
@@ -3717,12 +3872,7 @@
!
hasClassesNodeSelected
- |selectedNode|
-
- selectedNode := self selectedTreeNode.
- selectedNode isNil ifTrue:[^ false].
-
- ^ selectedNode contents == #classes
+ ^ self hasNodeSelected:#classes.
!
@@ -3737,29 +3887,28 @@
!
-hasMethodsNodeSelected
+hasNodeSelected
+ ^ self selectedTreeNode notNil
+
+!
+
+hasNodeSelected:type
|selectedNode|
selectedNode := self selectedTreeNode.
selectedNode isNil ifTrue:[^ false].
- ^ selectedNode contents key == #patches
-
-!
-
-hasNodeSelected
- ^ self selectedTreeNode notNil
+ ^ selectedNode contents == type
+
+!
+
+hasPatchesNodeSelected
+ ^ self hasNodeSelected:#patches.
!
hasPrerequisiteClassesNodeSelected
- |selectedNode|
-
- selectedNode := self selectedTreeNode.
- selectedNode isNil ifTrue:[^ false].
-
- ^ selectedNode contents == #prerequisiteClasses
-
+ ^ self hasNodeSelected:#prerequisiteClasses.
!
hasProjectNodeSelected
@@ -3787,12 +3936,7 @@
!
hasSubProjectsNodeSelected
- |selectedNode|
-
- selectedNode := self selectedTreeNode.
- selectedNode isNil ifTrue:[^ false].
-
- ^ selectedNode contents == #subprojects
+ ^ self hasNodeSelected:#subprojects.
!
@@ -3915,7 +4059,7 @@
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.
]
@@ -5758,6 +5902,65 @@
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'!