#FEATURE by cg
authorClaus Gittinger <cg@exept.de>
Tue, 08 Nov 2016 16:42:47 +0100
changeset 20898 d640780dabb0
parent 20897 49ffdb7d9c18
child 20899 e81f16882160
#FEATURE by cg class: Smalltalk added: #knownLoadablePackagesDo:
Smalltalk.st
--- a/Smalltalk.st	Tue Nov 08 16:06:52 2016 +0100
+++ b/Smalltalk.st	Tue Nov 08 16:42:47 2016 +0100
@@ -8304,6 +8304,71 @@
     "
 !
 
+knownLoadablePackagesDo:aBlock
+    "enumerate loadable packages from the packages folder."
+
+    Smalltalk realSystemPath do:[:dirName |
+        |packageDir|
+        
+        packageDir := dirName asFilename / 'packages'.
+        (packageDir exists and:[packageDir isDirectory]) ifTrue:[
+            packageDir directoryContentsAsFilenames sort do:[:fn |
+                |item base nm path parentPath parent isLibrary isApplication isAlreadyLoaded 
+                 defClass target type nameComponents packageName packageID|
+
+                ((fn suffix = 'mcz') 
+                or:[ fn isDirectory   
+                or:[ (fn baseName startsWith:'.')   
+                or:[ (fn baseName = 'README') ]]]) ifFalse:[    
+                    base := fn withoutSuffix baseName.
+                    (base startsWith:'lib') ifTrue:[
+                        nm := (base copyFrom:4).
+                        fn suffix notEmptyOrNil ifTrue:[
+                            type := #library.
+                        ] ifFalse:[
+                            type := #application.
+                        ]
+                    ] ifFalse:[
+                        nm := base.
+                        type := #application.
+                    ].
+
+                    (fn withoutSuffix = 'librun') ifTrue:[
+                        packageName := nil.
+                    ] ifFalse:[
+                        (fn suffix = 'mcz') ifTrue:[
+                            packageName := fn withoutSuffix.
+                            target := fn.
+                        ] ifFalse:[ 
+                            ( #('dll' 'so' 'sl' 'dylib') includes:(fn suffix)) ifTrue:[
+                                (base startsWith:'lib') ifTrue:[
+                                    nm := base copyFrom:4.
+                                ] ifFalse:[
+                                    nm := base.
+                                ].    
+                            ]. 
+                            nameComponents := nm asCollectionOfSubstringsSeparatedBy:$_.
+                            packageName := nameComponents first.
+                            nameComponents size > 1 ifTrue:[
+                                packageName := packageName,':',((nameComponents from:2) asStringWith:'/')
+                            ]. 
+                        ].
+                        packageName notNil ifTrue:[
+                            aBlock value:packageName value:type value:fn .
+                        ]
+                    ]
+                ]
+            ]
+        ]
+    ]
+
+    "
+     Smalltalk knownLoadablePackagesDo:[:packageID :type :path |
+         Transcript showCR:'%1 (%2) in %3' with:packageID with:type with:path.
+     ]
+    "
+!
+
 loadPackage:aPackageIdOrPackage
     "make certain, that some particular package is loaded into the system.
      Return true if loaded, false otherwise."