diff -r af82888ceb72 -r 1f5aa87f6170 Smalltalk.st --- a/Smalltalk.st Fri Mar 25 06:29:08 2016 +0000 +++ b/Smalltalk.st Sat Mar 26 07:56:10 2016 +0000 @@ -2954,9 +2954,20 @@ "Modified: / 07-05-2010 / 10:56:09 / cg" ! +allLoadedPackageIDs + + ^ self allPackageIdsIncludingUnloadedClasses: false + + + " + Smalltalk allLoadedPackageIDs + " +! + allLoadedProjectIDs - - ^ self allProjectsIdsIncludingUnloadedClasses: false + + self obsoleteMethodWarning:'use allLoadedPackageIDs'. + ^ self allPackageIdsIncludingUnloadedClasses: false " @@ -2964,10 +2975,66 @@ " ! +allPackageIDs + + ^ self allPackageIdsIncludingUnloadedClasses: true + + " + Smalltalk allPackageIDs + " +! + +allPackageIdsIncludingUnloadedClasses: includeUnloadedClasses + "Returns all package ids. + Excludes packages coming from unloaded classes if includeUnloadedClasses is false. + " + + |allProjects| + + allProjects := Set new. + self allClassesDo:[:eachClass | + |cls pkg| + + eachClass isRealNameSpace ifFalse:[ + (includeUnloadedClasses or:[eachClass isLoaded]) ifTrue:[ + cls := eachClass theNonMetaclass. + cls isPrivate ifTrue:[ + cls := cls topOwningClass + ]. + pkg := cls package. + pkg size > 0 ifTrue:[ + allProjects add:pkg. + ] 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 | + | package packageAsSymbol | + + package := mthd package. + packageAsSymbol := package asSymbol. + allProjects add: packageAsSymbol + ]. + ]. + ]. + ]. + ]. + allProjects := allProjects asOrderedCollection sort. + ^ allProjects + + " + Smalltalk allProjectsIdsIncludingUnloadedClasses: true + Smalltalk allProjectsIdsIncludingUnloadedClasses: false + " +! + allProjectIDs - - ^ self allProjectsIdsIncludingUnloadedClasses: true - + + self obsoleteMethodWarning:'use allPackageIDs'. + ^ self allPackageIDs " Smalltalk allProjectIDs @@ -2975,45 +3042,13 @@ ! allProjectsIdsIncludingUnloadedClasses: includeUnloadedClasses + "Returns all projects ids. Excludes projects coming from unloaded classes if includeUnloadedClasses is false. " - |allProjects| - - allProjects := Set new. - self allClassesDo:[:eachClass | - |cls pkg| - - eachClass isRealNameSpace ifFalse:[ - (includeUnloadedClasses or:[eachClass isLoaded]) ifTrue:[ - cls := eachClass theNonMetaclass. - cls isPrivate ifTrue:[ - cls := cls topOwningClass - ]. - pkg := cls package. - pkg size > 0 ifTrue:[ - allProjects add:pkg. - ] 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 | - | package packageAsSymbol | - - package := mthd package. - packageAsSymbol := package asSymbol. - allProjects add: packageAsSymbol - ]. - ]. - ]. - ]. - ]. - allProjects := allProjects asOrderedCollection sort. - ^ allProjects + self obsoleteMethodWarning:'use allPackageIdsIncludingUnloadedClasses:'. + ^ self allPackageIdsIncludingUnloadedClasses: includeUnloadedClasses " Smalltalk allProjectsIdsIncludingUnloadedClasses: true