[Help-smalltalk] [PATCH] kernel: Introduce the DirPackage packages to help with development

[Holger Hans Peter Freyther]

From: Holger Hans Peter Freyther <address@hidden>

Add a way to load a Package from the package.xml and not go through
the creation of a star file. This can make developing with packages
more effective.

2013-03-24  Holger Hans Peter Freyther  <address@hidden>

        * libgst/files.c: Add DirPackage.st to the bootstrap.
        * kernel/DirPackage.st: Add new file with the DirPackage and 
DirPackagesContainer.
        * kernel/PkgLoader.st: Refactor and create ExternalPackage baseclass.
---
 ChangeLog            |    6 +++
 NEWS                 |    7 +++
 kernel/DirPackage.st |  132 ++++++++++++++++++++++++++++++++++++++++++++++++++
 kernel/PkgLoader.st  |   28 +++++++----
 libgst/files.c       |    1 +
 5 files changed, 165 insertions(+), 9 deletions(-)
 create mode 100644 kernel/DirPackage.st

diff --git a/ChangeLog b/ChangeLog
index 6b6d9d2..8a3085d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2013-03-24  Holger Hans Peter Freyther  <address@hidden>
+
+       * libgst/files.c: Add DirPackage.st to the bootstrap.
+       * kernel/DirPackage.st: Add new file with the DirPackage and 
DirPackagesContainer.
+       * kernel/PkgLoader.st: Refactor and create ExternalPackage baseclass.
+
 2013-03-04  Holger Hans Peter Freyther  <address@hidden>
 
        * kernel/PkgLoader.st: Remove unused variable.
diff --git a/NEWS b/NEWS
index b5e9127..d768a8f 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,12 @@
 List of user-visible changes in GNU Smalltalk
 
+NEWS FROM 3.2.5 to 3.2.90
+
+o   Add PackageLoader>>#loadPackageFromFile: to load a package by using
+    a package.xml. This can make the development more effective.
+
+-----------------------------------------------------------------------------
+
 NEWS FROM 3.2.4 to 3.2.5
 
 o   Add Delay>>#value:onTimeoutDo: as an easy way to timeout an operation.
diff --git a/kernel/DirPackage.st b/kernel/DirPackage.st
new file mode 100644
index 0000000..2cdc57e
--- /dev/null
+++ b/kernel/DirPackage.st
@@ -0,0 +1,132 @@
+"======================================================================
+|
+|   Load packages from a directory without loading a Star file.
+|
+|
+ ======================================================================"
+
+"======================================================================
+|
+| Copyright 2013
+| Free Software Foundation, Inc.
+| Written by Holger Hans Peter Freyther.
+|
+| This file is part of the GNU Smalltalk class library.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+|
+| The GNU Smalltalk class library is distributed in the hope that it will be
+| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
+| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
+| General Public License for more details.
+|
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+Namespace current: Kernel [
+
+ExternalPackage subclass: DirPackage [
+    <category: 'Language-Packaging'>
+    <comment: 'I can parse a package.xml from a directort and treat it
+    like a package. This allows loading packages from a directory without
+    the need of zipping them first.'>
+
+    DirPackage class >> file: aFile [
+        ^ self new
+            file: aFile;
+            yourself
+    ]
+
+    directory [
+        ^ self file asFile directory.
+    ]
+
+    name [
+        "Pick the name of the loaded package"
+        ^ self loadedPackage name.
+    ]
+
+    loadedPackage [
+        <category: 'accessing'>
+        | file package |
+        loadedPackage isNil ifFalse: [^loadedPackage].
+        file := self file asFile.
+        package := Package parse: file readStream.
+        package isNil
+            ifTrue: [^self error: 'invalid disabled-package tag inside a star 
file'].
+        package relativeDirectory: file directory.
+        package baseDirectories: {file directory}.
+        package name isNil
+            ifTrue: [^self error: 'package name must not be nil'].
+        loadedPackage := package.
+        ^loadedPackage
+    ]
+]
+
+PackageContainer subclass: DirPackageContainer [
+
+    <category: 'Language-Packaging'>
+    <comment: 'I hold a list of parsed packages.'>
+
+    DirPackageContainer class >> on: aPackage [
+        <category: 'creation'>
+        ^ self new
+            add: aPackage;
+            yourself
+    ]
+
+    add: aPackage [
+        <category: 'addition'>
+
+        self packages
+                at: aPackage name, '.dir' put: aPackage.
+    ]
+
+    refresh: aDate [
+        "no op.. packages contain what we need"
+    ]
+]
+
+]
+
+PackageLoader class extend [
+
+    dirPackages [
+        | container |
+
+        <category: '*Language-Kernel'>
+
+        "Check if there is already a container"
+        root do: [:each |
+            each class = Kernel.DirPackageContainer
+                ifTrue: [^each].
+        ].
+
+        container := Kernel.DirPackageContainer new.
+        root add: container.
+        ^ container.
+    ]
+
+    loadPackageFromFile: aFileName [
+        | package |
+        <category: '*Language-Kernel'>
+
+        "Make sure that root is initialized."
+        self refresh.
+
+        "Add the 'directory' to the packages"
+        package := Kernel.DirPackage file: aFileName.
+
+        self dirPackages add: package.
+
+        "And now file it in"
+        package primFileIn.
+    ]
+]
diff --git a/kernel/PkgLoader.st b/kernel/PkgLoader.st
index b9748f2..53d9367 100644
--- a/kernel/PkgLoader.st
+++ b/kernel/PkgLoader.st
@@ -917,20 +917,12 @@ XML.'>
 
 Namespace current: Kernel [
 
-PackageInfo subclass: StarPackage [
+PackageInfo subclass: ExternalPackage [
     | file loadedPackage |
     
     <category: 'Language-Packaging'>
     <comment: nil>
 
-    StarPackage class >> file: file [
-       <category: 'accessing'>
-       ^(self new)
-           file: file;
-           name: (File stripPathFrom: (File stripExtensionFrom: file name));
-           yourself
-    ]
-
     fullPathOf: fileName [
        "Try appending 'self directory' and fileName to each of the directory
         in baseDirectories, and return the path to the first tried filename 
that
@@ -1079,6 +1071,24 @@ PackageInfo subclass: StarPackage [
     ]
 
     loadedPackage [
+        ^ self subclassResponsibility
+    ]
+]
+
+ExternalPackage subclass: StarPackage [
+
+    <category: 'Language-Packaging'>
+    <comment: 'I represent an external package in the form of a .star package'>
+
+    StarPackage class >> file: file [
+       <category: 'accessing'>
+       ^(self new)
+           file: file;
+           name: (File stripPathFrom: (File stripExtensionFrom: file name));
+           yourself
+    ]
+
+    loadedPackage [
        <category: 'accessing'>
        | package |
        loadedPackage isNil ifFalse: [^loadedPackage].
diff --git a/libgst/files.c b/libgst/files.c
index ec33933..a7156f9 100644
--- a/libgst/files.c
+++ b/libgst/files.c
@@ -288,6 +288,7 @@ static const char standard_files[] = {
   "StreamOps.st\0"
   "Regex.st\0"
   "PkgLoader.st\0"
+  "DirPackage.st\0"
   "Autoload.st\0"
 };
 
-- 
1.7.10.4