--- a/BrowserView.st Thu Jan 09 13:50:40 1997 +0100
+++ b/BrowserView.st Fri Jan 10 14:17:19 1997 +0100
@@ -1142,45 +1142,82 @@
classCategoryValidateClassRevisions
"for all classes, ask the sourceCodeManager for the most recent version
- and compare this to the actual version. Send mismatch info to the Transcript"
+ and compare this to the actual version. Send mismatch info to the Transcript.
+ Use this, to find classes, which need to be reloaded from the repository."
self withWaitCursorDo:[
- |logMessage classes repVersion clsVersion binVersion|
-
- (currentClassCategory = '* all *'
- or:[currentClassCategory = '* hierarchy *']) ifTrue:[
- classes := Smalltalk allClasses
- ] ifFalse:[
- classes := Smalltalk allClassesInCategory:currentClassCategory.
- ].
+ |logMessage classes repVersion clsVersion binVersion
+ count unloadedCount badCount|
+
+ classes := self listOfAllClassesInCategory:currentClassCategory names:false.
+"/ (currentClassCategory = '* all *'
+"/ or:[currentClassCategory = '* hierarchy *']) ifTrue:[
+"/ classes := Smalltalk allClasses
+"/ ] ifFalse:[
+"/ classes := Smalltalk allClassesInCategory:currentClassCategory.
+"/ ].
+
+ count := unloadedCount := badCount := 0.
classes do:[:aClass |
- aClass isLoaded ifTrue:[
- self busyLabel:'validating %1 ...' with:aClass name.
-
- repVersion := aClass sourceCodeManager newestRevisionOf:aClass.
- clsVersion := aClass revision.
- binVersion := aClass binaryRevision.
-
- clsVersion ~= repVersion ifTrue:[
- Transcript showCR:(aClass name , ' is not up-to-date.').
- ] ifFalse:[
- clsVersion ~= binVersion ifTrue:[
- binVersion notNil ifTrue:[
- Transcript showCR:(aClass name , ' should to be recompiled.').
+ |clsName msg|
+
+ count := count + 1.
+
+ "/ ignore autoloaded and private classes here
+
+ aClass isLoaded ifFalse:[
+ unloadedCount := unloadedCount + 1
+ ] ifTrue:[
+ ((aClass isNamespace not or:[aClass == Smalltalk])
+ and:[aClass topOwningClass isNil]) ifTrue:[
+
+"/ self busyLabel:'validating %1 ...' with:aClass name.
+
+ repVersion := aClass sourceCodeManager newestRevisionOf:aClass.
+ clsVersion := aClass revision.
+ binVersion := aClass binaryRevision.
+
+ clsName := aClass name.
+ msg := nil.
+
+ clsVersion ~= repVersion ifTrue:[
+ badCount := badCount + 1.
+ msg := clsName
+ , ' is not up-to-date (this: '
+ , clsVersion printString
+ , ' repository: '
+ , repVersion printString
+ , ').'
+ ] ifFalse:[
+ clsVersion ~= binVersion ifTrue:[
+ binVersion notNil ifTrue:[
+ msg := clsName
+ , ' should to be recompiled (this: '
+ , clsVersion printString
+ , ' repository: '
+ , repVersion printString
+ , ').'
+ ]
+ ] ifFalse:[
+"/ msg := clsName , ' is up-to-date.'
]
- ] ifFalse:[
-"/ Transcript showCR:(aClass name , ' is up-to-date.').
- ]
+ ].
+ msg notNil ifTrue:[
+ Transcript showCR:msg
+ ].
].
]
].
+ Transcript showCR:('%1 classes / %2 unloaded / %3 need(s) to be updated from the repository.'
+ bindWith:count with:unloadedCount with:badCount).
+
self normalLabel.
]
"Modified: 15.6.1996 / 00:25:58 / stefan"
"Created: 29.10.1996 / 13:21:08 / cg"
- "Modified: 29.10.1996 / 13:23:58 / cg"
+ "Modified: 10.1.1997 / 14:16:02 / cg"
! !
!BrowserView methodsFor:'class category stuff'!
@@ -3717,8 +3754,17 @@
]
!
-listOfAllClassesInCategory:aCategory
- "return a list of all classes in a given category"
+listOfAllClassNamesInCategory:aCategory
+ "return a list of the names of all classes in a given category"
+
+ ^ self listOfAllClassesInCategory:aCategory names:true
+
+ "Modified: 10.1.1997 / 14:00:33 / cg"
+!
+
+listOfAllClassesInCategory:aCategory names:namesFlag
+ "return a list of (the names) of all classes in a given category
+ from the currently selected set of nameSpaces."
|nameSpaces listOfClassNames listOfClasses classesPresent namesPresent searchCategory
match anyCategory nm owner allNameSpaces|
@@ -3729,34 +3775,35 @@
namesPresent := Set new.
- (aCategory = '* hierarchy *') ifTrue:[
- listOfClassNames := OrderedCollection new.
-
- self classHierarchyOf:Object withAutoloaded:true do:[:aClass :lvl|
- |indent|
-
- (aClass isNamespace not
- or:[aClass == Smalltalk]) ifTrue:[
- nm := self displayedClassNameOf:aClass.
-
- (namesPresent includes:nm) ifFalse:[
- indent := String new:lvl*2.
-
- "/ show classes from other nameSpaces in italic
-
- (allNameSpaces not
- and:[(self findClassNamedInNameSpace:nm) isNil]) ifTrue:[
- nm := nm asText emphasizeAllWith:#italic.
- ].
- nm := indent , nm.
- namesPresent add:nm.
- listOfClassNames add:nm
+ namesFlag ifTrue:[
+ (aCategory = '* hierarchy *') ifTrue:[
+ listOfClassNames := OrderedCollection new.
+
+ self classHierarchyOf:Object withAutoloaded:true do:[:aClass :lvl|
+ |indent|
+
+ (aClass isNamespace not
+ or:[aClass == Smalltalk]) ifTrue:[
+ nm := self displayedClassNameOf:aClass.
+
+ (namesPresent includes:nm) ifFalse:[
+ indent := String new:lvl*2.
+
+ "/ show classes from other nameSpaces in italic
+
+ (allNameSpaces not
+ and:[(self findClassNamedInNameSpace:nm) isNil]) ifTrue:[
+ nm := nm asText emphasizeAllWith:#italic.
+ ].
+ nm := indent , nm.
+ namesPresent add:nm.
+ listOfClassNames add:nm
+ ]
]
- ]
- ].
- ^ listOfClassNames
- ].
-
+ ].
+ ^ listOfClassNames
+ ].
+ ].
(aCategory = '* all *') ifTrue:[
anyCategory := true
@@ -3861,6 +3908,10 @@
"/ sort by name
listOfClassNames sortWith:listOfClasses.
+ namesFlag ifFalse:[
+ ^ listOfClasses
+ ].
+
"/ indent after sorting
1 to:listOfClassNames size do:[:index |
|nm cls owner s|
@@ -3880,10 +3931,11 @@
^ listOfClassNames
- "Modified: 5.1.1997 / 18:45:22 / cg"
-!
-
-listOfClassHierarchyOf:aClass
+ "Created: 10.1.1997 / 13:57:34 / cg"
+ "Modified: 10.1.1997 / 13:59:54 / cg"
+!
+
+listOfClassNameHierarchyOf:aClass
"return a hierarchy class-list"
|startClass classes thisOne|
@@ -3908,6 +3960,7 @@
^ classes collect:[:c | c name]
"Modified: 20.12.1996 / 17:13:36 / cg"
+ "Created: 10.1.1997 / 14:01:06 / cg"
!
renameCurrentClassTo:aString
@@ -4095,10 +4148,10 @@
].
currentClassCategory notNil ifTrue:[
- classes := self listOfAllClassesInCategory:currentClassCategory
+ classes := self listOfAllClassNamesInCategory:currentClassCategory
] ifFalse:[
currentClassHierarchy notNil ifTrue:[
- classes := self listOfClassHierarchyOf:currentClassHierarchy
+ classes := self listOfClassNameHierarchyOf:currentClassHierarchy
]
].
@@ -4123,7 +4176,7 @@
].
]
- "Modified: 4.1.1997 / 19:57:38 / cg"
+ "Modified: 10.1.1997 / 14:01:20 / cg"
! !
!BrowserView methodsFor:'class-method list menu'!
@@ -9191,6 +9244,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.252 1997-01-09 11:59:41 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.253 1997-01-10 13:17:19 cg Exp $'
! !
BrowserView initialize!