--- a/ProjectBrowser.st Fri Sep 24 19:26:36 1999 +0200
+++ b/ProjectBrowser.st Sat Sep 25 03:34:03 1999 +0200
@@ -423,6 +423,126 @@
!ProjectBrowser class methodsFor:'interface specs'!
+classValidationDialogSpec
+ "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: 'Classes 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: #classesInImageOnly
+ )
+ )
+
+ )
+ )
+ #(#ViewSpec
+ #name: 'Box2'
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#LabelSpec
+ #label: 'Classes 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: #classesInProjectOnly
+ )
+ )
+
+ )
+ )
+ )
+
+ )
+ )
+ #(#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)
+ )
+ )
+
+ )
+ )
+ )
+
+ )
+ )
+!
+
emptyRightCanvasSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
@@ -1894,6 +2014,16 @@
#label: '-'
)
#(#MenuItem
+ #label: 'Validate...'
+ #translateLabel: true
+ #value: #validateAgainstClassesInImage
+ #enabled: #hasClassesSelectedHolder
+ )
+
+ #(#MenuItem
+ #label: '-'
+ )
+ #(#MenuItem
#label: 'Browse...'
#translateLabel: true
#value: #browseClasses
@@ -4498,6 +4628,7 @@
Transcript showCR:('ProjectBrowser: cannot checkIn unloaded class: ' , aClass name).
] ifTrue:[
aClass owningClass isNil ifTrue:[ "/ skip private classes
+ Transcript showCR:('ProjectBrowser: checking in class: ' , aClass name).
self checkInClass:aClass.
]
]
@@ -4518,6 +4649,7 @@
anyMethodMissing ifTrue:[
Transcript showCR:'ProjectBrowser: cannot save method patches & extensions due to missing method(s)'.
] ifFalse:[
+ Transcript showCR:('ProjectBrowser: checking in patches & extensions').
self checkInMethods:methods
].
].
@@ -5118,6 +5250,54 @@
l addAll:methodInfo.
+!
+
+validateAgainstClassesInImage
+ "validate classes in project against classes found in the image"
+
+ |project classesInProjectOnly classesInImageOnly bindings|
+
+ project := self currentProject.
+ classesInImageOnly := IdentitySet new.
+ classesInProjectOnly := IdentitySet new.
+
+ Smalltalk allClassesDo:[:aClass |
+ aClass isMeta ifFalse:[
+ (aClass isNamespace not or:[aClass == Smalltalk]) ifTrue:[
+ aClass package = project package ifTrue:[
+ (project classInfoFor:aClass) isNil ifTrue:[
+ classesInImageOnly add:aClass name.
+ ]
+ ]
+ ]
+ ]
+ ].
+ project classInfo do:[:clsInfo |
+ |clsName cls|
+
+ clsName := clsInfo className.
+ cls := Smalltalk at:clsName asSymbol.
+ (cls isBehavior not) ifTrue:[
+ classesInProjectOnly add:clsName
+ ].
+ ].
+
+ (classesInImageOnly isEmpty and:[classesInProjectOnly isEmpty]) ifTrue:[
+ self information:'Set of classes in project and image are equesl.'.
+ ^ self.
+ ].
+
+ classesInImageOnly := classesInImageOnly asOrderedCollection sort.
+ classesInProjectOnly := classesInProjectOnly asOrderedCollection sort.
+
+ bindings := IdentityDictionary new.
+ bindings at:#classesInImageOnly put:classesInImageOnly.
+ bindings at:#classesInProjectOnly put:classesInProjectOnly.
+
+ SimpleDialog
+ openDialogInterfaceSpec:(self class classValidationDialogSpec)
+ withBindings:bindings
+
! !
!ProjectBrowser methodsFor:'user actions - canvas'!