--- a/Tools_ProjectList.st Wed Aug 23 16:34:33 2006 +0200
+++ b/Tools_ProjectList.st Wed Aug 23 17:36:13 2006 +0200
@@ -517,40 +517,60 @@
!ProjectList methodsFor:'private'!
allShownProjects
- |allProjects generator|
+ |hideUnloaded allProjects generator addWithAllParentPackages|
allProjects := IdentitySet new.
inGeneratorHolder isNil ifTrue:[
- (self hideUnloadedClasses value) ifTrue:[
- Smalltalk allClassesDo:[:eachClass |
- |cls pkg|
+ hideUnloaded := self hideUnloadedClasses value.
+
+ addWithAllParentPackages :=
+ [:package |
+ |p parent|
- eachClass isLoaded ifTrue:[
- cls := eachClass theNonMetaclass.
- cls isPrivate ifTrue:[
- cls := cls topOwningClass
+ (allProjects includes:package) ifFalse:[
+ allProjects add:package.
+
+ p := package asPackageId.
+ [(parent := p parentPackage) notNil] whileTrue:[
+ allProjects add:parent asSymbol.
+ p := parent.
].
- pkg := cls package ? '__NoProject__'.
- pkg withoutSeparators size > 0 ifTrue:[
- allProjects add:pkg asSymbol.
- ] ifFalse:[
- "/ for now, nameSpaces are not in any package;
- "/ this might change. Then, 0-sized packages are
- "/ illegal, and the following should be enabled.
- "/ self halt
- ].
- cls isJavaClass ifFalse:[
- cls instAndClassSelectorsAndMethodsDo:[:sel :mthd |
- allProjects add:mthd package asSymbol.
+ ].
+ ].
+
+ Smalltalk allClassesDo:[:eachClass |
+ |cls pkg p classPackage|
+
+ (hideUnloaded not or:[eachClass isLoaded]) ifTrue:[
+ cls := eachClass theNonMetaclass.
+ cls isPrivate ifTrue:[
+ cls := cls topOwningClass
+ ].
+ classPackage := cls package ? #'__NoProject__'.
+ classPackage size > 0 ifTrue:[
+ addWithAllParentPackages value:classPackage asSymbol.
+ ] ifFalse:[
+ "/ for now, nameSpaces are not in any package;
+ "/ this might change. Then, 0-sized packages are
+ "/ illegal, and the following should be enabled.
+ "/ self halt
+ ].
+ cls isJavaClass ifFalse:[
+ cls instAndClassSelectorsAndMethodsDo:[:sel :mthd |
+ |mpkg|
+
+ mpkg := mthd package asSymbol.
+ mpkg ~~ classPackage ifTrue:[
+ (allProjects includes:mpkg) ifFalse:[
+ addWithAllParentPackages value:mpkg.
+ ]
].
].
].
].
- allProjects := allProjects asOrderedCollection.
- ] ifFalse:[
- allProjects := Smalltalk allProjectIDs.
].
+ allProjects := allProjects asOrderedCollection.
"/ those are simulated - in ST/X, empty projects do not
"/ really exist; however, during browsing, it makes sense.
@@ -769,5 +789,5 @@
!ProjectList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.14 2006-08-23 09:50:00 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.15 2006-08-23 15:36:13 cg Exp $'
! !