Hello,
here is the first version of the patch for adding <dir name="...">
support in package.xml.
example:
<filein>compiler/initialization/SystemInitialization.st</filein>
<filein>compiler/type/Extensions.st</filein>
...
becomes:
<dir name="compiler">
<filein>...</filein>
</dir>
Comments are welcome
Gwen
diff --git a/kernel/PkgLoader.st b/kernel/PkgLoader.st
index 8a3a429..9ee5e2e 100644
--- a/kernel/PkgLoader.st
+++ b/kernel/PkgLoader.st
@@ -1185,7 +1185,7 @@ Object subclass: Version [
Kernel.PackageInfo subclass: Package [
| features prerequisites builtFiles files fileIns relativeDirectory
baseDirectories libraries modules callouts url namespace sunitScripts
- startScript stopScript test version |
+ startScript stopScript test version path |
<category: 'Language-Packaging'>
<comment: 'I am not part of a standard Smalltalk system. I store internally the
@@ -1200,7 +1200,7 @@ XML.'>
^ Tags ifNil: [ Tags := Dictionary from: {
'file' -> #addFile:.
'filein' -> #addFileIn:.
- 'prereq' -> #addPrerequisite:.
+ 'prereq' -> #addPrerequisite:.
'provides' -> #addFeature:.
'module' -> #addModule:.
'directory' -> #relativeDirectory:.
@@ -1360,7 +1360,7 @@ XML.'>
<category: 'accessing'>
files isNil ifTrue: [files := OrderedCollection new].
- files add: aString
+ files add: self path, aString
]
files [
@@ -1379,7 +1379,7 @@ XML.'>
addFileIn: aString [
<category: 'accessing'>
- self fileIns add: aString
+ self fileIns add: self path, aString
]
fileIns [
@@ -1573,9 +1573,40 @@ XML.'>
Namespace current: namespace]
]
+ path [
+
+ ^ path ifNil: [ path := '' ]
+ ]
+
+ path: aString [
+
+ path := aString
+ ]
+
+ dir: file tag: aString [
+
+ | attribute args key value tag oldPath |
+ attribute := ReadStream on: aString.
+ tag := attribute upTo: $ .
+ args := OrderedCollection new.
+ [ attribute atEnd ] whileFalse: [
+ attribute peek isAlphaNumeric ifTrue: [
+ key := attribute upTo: $=.
+ attribute upTo: $".
+ value := attribute upTo: $".
+ args add: key->value. ].
+ attribute next ].
+ args := Dictionary from: args.
+ args size > 1 ifTrue: [ self error: '' ].
+ oldPath := self path.
+ self path: (self path, (args at: 'name')).
+ self parse: file tag: 'dir'.
+ self path: oldPath.
+ ]
+
parse: file tag: openingTag [
<category: 'private-initializing'>
- | stack cdata ch tag testPackage |
+ | stack cdata ch tag testPackage attribute args key value |
stack := OrderedCollection new.
stack addLast: openingTag.
@@ -1591,18 +1622,20 @@ XML.'>
ifTrue:
[tag := stack removeLast.
file next.
- (file upTo: $>) = tag
- ifFalse: [^self error: 'error in packages file: unmatched end tag ' , tag].
-
+ (file upTo: $>) = tag
+ ifFalse: [^self error: 'error in packages file: unmatched end tag ' , tag ].
tag = openingTag ifTrue: [ ^ self ].
- self perform: (self class tags at: tag ifAbsent: [ self error: 'invalid tag ', tag ]) with: cdata.
- cdata := nil].
+ self perform: (self class tags at: tag ifAbsent: [ self error: 'invalid tag ', tag ]) with: cdata.
+ args := attribute := key := value := cdata := nil ].
ch isAlphaNumeric
ifTrue:
[tag := file upTo: $>.
+ (tag size > 4 and: [ (tag copyFrom: 1 to: 4) = 'dir ' ])
+ ifTrue: [ self dir: file tag: tag ]
+ ifFalse: [
tag = 'test'
ifTrue: [self test: (TestPackage new parse: file tag: tag)]
- ifFalse: [stack addLast: tag].
+ ifFalse: [stack addLast: tag] ].
cdata trimSeparators isEmpty
ifFalse: [^self error: 'unexpected character data'].
cdata := nil]]]
_______________________________________________
help-smalltalk mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/help-smalltalk
