Arghh....method went to different package!
authorJan Vrany <jan.vrany@fit.cvut.cz>
Mon, 28 Apr 2014 11:58:55 +0200
changeset 14292 99cbd608202b
parent 14291 0c9a68d379d5
child 14293 148663f7e59d
Arghh....method went to different package!
Tools__ProjectList.st
--- a/Tools__ProjectList.st	Mon Apr 28 11:54:21 2014 +0200
+++ b/Tools__ProjectList.st	Mon Apr 28 11:58:55 2014 +0200
@@ -684,6 +684,98 @@
 
 !ProjectList methodsFor:'private'!
 
+allShownProjects
+    |hideUnloaded allProjects projectBag generator addWithAllParentPackages hideModules|
+
+    hideModules := HideModules ? true.
+    hideModules := HideModules ? false.
+
+    allProjects := IdentitySet new.
+    projectBag := Bag new.
+
+    inGeneratorHolder isNil ifTrue:[
+        hideUnloaded := self hideUnloadedClasses value.
+
+        addWithAllParentPackages := 
+            [:package |
+                |p parent module|
+
+                (allProjects includes:package) ifFalse:[
+                    allProjects add:package.
+                    (package ~= PackageId noProjectID 
+                    and:[package ~= #private]) ifTrue:[
+                        p := package asPackageId.
+                        [(parent := p parentPackage) notNil] whileTrue:[
+                            allProjects add:parent asSymbol.
+                            p := parent.
+                        ].
+                        hideModules ifFalse:[
+                            (module := p module) notNil ifTrue:[
+                                allProjects add:module asSymbol.
+                            ].
+                        ].
+                    ].
+                ].
+            ].
+
+        environment allClassesDo:[:eachClass |
+            |cls pkg p classPackage|
+
+            eachClass isRealNameSpace ifFalse:[
+
+                (hideUnloaded not or:[eachClass isLoaded]) ifTrue:[
+                    cls := eachClass theNonMetaclass.
+                    (cls isPrivate and:[cls isJavaClass not]) ifTrue:[
+                        cls := cls topOwningClass
+                    ].
+
+                    classPackage := cls package ? (PackageId noProjectID).
+                    classPackage size > 0 ifTrue:[
+                        classPackage := classPackage asSymbol.
+                        addWithAllParentPackages value:classPackage.
+                        projectBag add:classPackage.
+                    ] 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.
+
+        "/ those are simulated - in ST/X, empty projects do not
+        "/ really exist; however, during browsing, it makes sense.
+        AdditionalEmptyProjects size > 0 ifTrue:[
+            "/ remove those that are present ...
+            AdditionalEmptyProjects := AdditionalEmptyProjects select:[:pkg | (allProjects includes:pkg) not].
+            allProjects addAll:AdditionalEmptyProjects.
+        ].
+    ] ifFalse:[
+        generator := inGeneratorHolder value.
+        generator isNil ifTrue:[^ #() ].
+        generator do:[:prj | allProjects add:prj].
+    ].
+    ^ allProjects asOrderedCollection.
+
+    "Modified: / 16-01-2007 / 15:56:16 / cg"
+    "Modified: / 28-04-2014 / 10:15:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 defaultSlaveModeValue
     |mode|
 
@@ -933,10 +1025,10 @@
 !ProjectList class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__ProjectList.st,v 1.69 2014-04-28 09:54:21 vrany Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__ProjectList.st,v 1.70 2014-04-28 09:58:55 vrany Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__ProjectList.st,v 1.69 2014-04-28 09:54:21 vrany Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__ProjectList.st,v 1.70 2014-04-28 09:58:55 vrany Exp $'
 ! !