Tools_ProjectList.st
changeset 6960 aa7f999ae458
parent 6951 a089896c6970
child 6965 de49c9a12837
--- 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 $'
 ! !