--- a/Tools_ClassList.st Fri Sep 06 20:38:51 2013 +0200
+++ b/Tools_ClassList.st Fri Sep 06 20:39:07 2013 +0200
@@ -1426,7 +1426,7 @@
nameListForClasses:aClassList
|orgMode namespaces showNamespaces fullNameList nameList
filteredPackages filteredNameSpaces classesInRemoteChangeSet
- classNamesInChangeSet classNamesInRemoteChangeSet|
+ classNamesInChangeSet classNamesInRemoteChangeSet javaClassCountsByBame |
showNamespaces := false.
@@ -1465,6 +1465,15 @@
classesInRemoteChangeSet := SmallTeam isNil ifTrue:[#()] ifFalse:[ SmallTeam changedClasses ].
classNamesInRemoteChangeSet := classesInRemoteChangeSet collect:[:each | each theNonMetaclass name].
+ javaClassCountsByBame := Dictionary new.
+ aClassList do:[:cls |
+ cls isJavaClass ifTrue:[
+ javaClassCountsByBame
+ at: cls name
+ put: (javaClassCountsByBame at: cls name ifAbsent:[0]) + 1
+ ]
+ ].
+
nameList := aClassList
collect:[:cls |
@@ -1476,6 +1485,23 @@
isInRemoteChangeSet := classNamesInRemoteChangeSet includes:className.
nm := self nameListEntryFor:cls withNameSpace:showNamespaces.
+ cls isJavaClass ifTrue:[
+ (javaClassCountsByBame at: cls name) > 1 ifTrue:[
+ | cl clstring |
+
+ cl := cls classLoader.
+ "/ Do not mark classes loaded by primordial, ext or system class loader...
+ (cl notNil
+ and:[JavaVM systemClassLoader isNil
+ or:[cl ~~ JavaVM systemClassLoader
+ and:[cl ~~ (JavaVM systemClassLoader instVarNamed:#parent)]]])
+ ifTrue:[
+ clstring := ' [', cl displayString , ']'.
+ nm := nm , (clstring asText colorizeAllWith: Color gray)
+ ]
+ ]
+ ].
+
self showCoverageInformation value ifTrue:[
clr := self colorForCoverageInformationOfClass:cls.
@@ -1558,6 +1584,7 @@
^ nameList
"Modified: / 27-10-2012 / 12:32:20 / cg"
+ "Modified: / 06-09-2013 / 18:13:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
reconstructNameList
@@ -1622,43 +1649,65 @@
found := false.
aCollection isSequenceable ifFalse:[
- classes := aCollection copy.
- aCollection removeAll.
- classes do:[:cls |
- |newClass|
+ classes := aCollection copy.
+ aCollection removeAll.
+ classes do:[:cls |
+ |newClass|
- meta := cls isMeta.
- newClass := environment at:(cls theNonMetaclass name).
- newClass isNil ifTrue:[
- newClass := cls
- ] ifFalse:[
- meta ifTrue:[
- newClass := newClass class
- ]
- ].
- found := cls ~~ newClass.
- aCollection add:newClass.
- ].
+ meta := cls isMeta.
+ "/ Sigh, special care has to be taken for Java classes as
+ "/ for them, !!!!!! (environment at: javaClass name) ~~ javaClass !!!!!!
+ cls theNonMetaclass isJavaClass ifTrue:[
+ "/ Can't use JavaVM>>classNamed:definedBy: for Java classes because environment
+ "/ could not be Java class. Do a full search instead, sigh...
+ newClass := environment allClasses
+ detect:[:each|each isJavaClass and:[each name == cls theNonMetaclass name and:[each classLoader == cls theNonMetaclass classLoader]]]
+ ifNone:[nil].
+ ] ifFalse:[
+ newClass := environment at:(cls theNonMetaclass name).
+ ].
+ newClass isNil ifTrue:[
+ newClass := cls
+ ] ifFalse:[
+ meta ifTrue:[
+ newClass := newClass class
+ ]
+ ].
+ found := cls ~~ newClass.
+ aCollection add:newClass.
+ ].
] ifTrue:[
- aCollection keysAndValuesDo:[:idx :cls |
- |newClass|
+ aCollection keysAndValuesDo:[:idx :cls |
+ |newClass|
- cls notNil ifTrue:[
- meta := cls isMeta.
- newClass := environment at:(cls theNonMetaclass name).
- newClass isNil ifTrue:[
- newClass := cls
- ] ifFalse:[
- meta ifTrue:[
- newClass := newClass class
- ]
- ].
- found := cls ~~ newClass.
- aCollection at:idx put:newClass.
- ]
- ].
+ cls notNil ifTrue:[
+ meta := cls isMeta.
+ "/ Sigh, special care has to be taken for Java classes as
+ "/ for them, !!!!!! (environment at: javaClass name) ~~ javaClass !!!!!!
+ cls theNonMetaclass isJavaClass ifTrue:[
+ "/ Can't use JavaVM>>classNamed:definedBy: for Java classes because environment
+ "/ could not be Java class. Do a full search instead, sigh...
+ newClass := environment allClasses
+ detect:[:each|each isJavaClass and:[each name == cls theNonMetaclass name and:[each classLoader == cls theNonMetaclass classLoader]]]
+ ifNone:[nil].
+ ] ifFalse:[
+ newClass := environment at:(cls theNonMetaclass name).
+ ].
+ newClass isNil ifTrue:[
+ newClass := cls
+ ] ifFalse:[
+ meta ifTrue:[
+ newClass := newClass class
+ ]
+ ].
+ found := cls ~~ newClass.
+ aCollection at:idx put:newClass.
+ ]
+ ].
].
^ found
+
+ "Modified: / 06-09-2013 / 18:10:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateList
@@ -2028,10 +2077,10 @@
!ClassList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.76 2013-09-05 10:46:11 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.77 2013-09-06 18:39:07 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.76 2013-09-05 10:46:11 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.77 2013-09-06 18:39:07 vrany Exp $'
! !