commit 29c338d542628a2729931496f49ea820c4575ea2
Author: Gwenael Casaccio
Date: Sun Jan 3 19:03:54 2010 +0100
New ignore
Display list of packages
diff --git a/.gitignore b/.gitignore
index 504cfce..9c8f800 100644
--- a/.gitignore
+++ b/.gitignore
@@ -34,3 +34,12 @@ termnorm
/gst-tool
/gst.im
/smalltalk-mode-init.el
+
+/libgst/genbc-decl.c
+/libgst/genbc-decl.h
+/libgst/genpr-parse.c
+/libgst/genpr-parse.h
+snprintfv/snprintfv/filament.h
+snprintfv/snprintfv/printf.h
+snprintfv/snprintfv/stream.h
+tests/testsuite
diff --git a/kernel/PkgLoader.st b/kernel/PkgLoader.st
index 840890f..aef5ee9 100644
--- a/kernel/PkgLoader.st
+++ b/kernel/PkgLoader.st
@@ -42,6 +42,74 @@ Notification subclass: PackageSkip [
]
+Namespace current: Kernel [
+
+Smalltalk.Object subclass: TinyXMLParser [
+
+
+
+ | stream endTag contents |
+
+ TinyXMLParser class >> on: aStream [
+
+
+ ^ self new
+ initialize;
+ stream: aStream
+ ]
+
+ initialize [
+
+
+ endTag := false.
+ contents := ''.
+ ]
+
+ stream: aStream [
+
+
+ stream := aStream
+ ]
+
+ nextTag [
+
+
+ stream upTo: $<.
+ stream atEnd ifTrue: [ self error: 'unmatched tag' ].
+ (endTag := stream peek == $/) ifTrue: [ stream next ].
+ contents := stream upTo: $>.
+ ^ self text
+ ]
+
+ nextContents [
+
+
+ contents := stream upTo: $<.
+ stream atEnd ifTrue: [ self error: 'unmatched tag' ].
+ stream skip: - 1.
+ ^ contents
+ ]
+
+ isStartTag [
+
+
+ ^ self isEndTag not
+ ]
+
+ isEndTag [
+
+
+ ^ endTag
+ ]
+
+ text [
+
+
+ ^ contents
+ ]
+]
+
+]
Namespace current: SystemExceptions [
@@ -1679,6 +1747,64 @@ that package.
]
+
+Namespace current: Kernel [
+Smalltalk.Object subclass: PackageRepository [
+
+ | url packages |
+
+ PackageRepository class >> parse: aStream [
+
+
+ ^ self new
+ parse: aStream;
+ yourself
+ ]
+
+ packages [
+
+
+ ^ packages ifNil: [ packages := OrderedCollection new ]
+ ]
+
+ addPackage: aString [
+
+
+ self packages add: aString
+ ]
+
+ packagesDo: aOneArgBlock [
+
+
+ self packages do: aOneArgBlock
+ ]
+
+ parse: aStream [
+
+
+ | parser |
+ parser := TinyXMLParser on: aStream.
+ parser nextTag = 'repository' ifFalse: [ self error: 'Should be a repository : ', parser text ].
+ [ parser nextTag = 'repository' ] whileFalse: [
+ parser text = 'package' ifFalse: [ self error: 'Bad repository file' ].
+ self addPackage: parser nextContents.
+ parser nextTag = 'package' ifFalse: [ self error: 'Bad repository file' ] ]
+ ]
+
+ printOn: aStream [
+ "Print a represention of the receiver on aStream."
+
+
+ super printOn: aStream.
+ aStream nl; nl; nextPutAll: 'packages:'; nl.
+ self packagesDo: [ :each |
+ aStream
+ tab;
+ nextPutAll: each;
+ nl ]
+ ]
+]
+]
Object subclass: PackageLoader [
diff --git a/scripts/Package.st b/scripts/Package.st
index fbf2928..6115f7d 100644
--- a/scripts/Package.st
+++ b/scripts/Package.st
@@ -202,10 +202,10 @@ Kernel.PackageContainer subclass: PackageCheckout [
mainPackage := addedPackages first.
MainPackage use: mainPackage during: [
mainPackage prerequisites printNl do: [ :each || file |
- ((each startsWith: mainPackage name, '-') and: [
+ ((each startsWith: mainPackage name, '-') and: [
(file := mainPackage baseDirectories first
- / (each copyFrom: mainPackage name size + 2)
- / 'package.xml') exists ])
+ / (each copyFrom: mainPackage name size + 2)
+ / 'package.xml') exists ])
ifTrue: [ self parseFile: file ]]].
^addedPackages
@@ -228,11 +228,11 @@ PackageCheckout subclass: SvnPackageCheckout [
| realUrl command saveDir |
self checkoutDirectory exists
ifFalse: [
- self checkoutDirectory emitMkdir.
+ self checkoutDirectory emitMkdir.
realUrl := url copy.
url scheme = 'svn+http' ifTrue: [ realUrl scheme: 'http' ].
url host = '' ifTrue: [ realUrl := realUrl path ].
- command := 'svn checkout %1 .' % {realUrl} ]
+ command := 'svn checkout %1 .' % {realUrl} ]
ifTrue: [
command := 'svn update' ].
@@ -240,7 +240,7 @@ PackageCheckout subclass: SvnPackageCheckout [
saveDir := Directory working.
Command
execute: [
- Directory working: self checkoutDirectory.
+ Directory working: self checkoutDirectory.
Smalltalk system: command ]
ensure: [ Directory working: saveDir ]
]
@@ -252,12 +252,12 @@ PackageCheckout subclass: GitPackageCheckout [
| realUrl command saveDir |
self checkoutDirectory exists
ifFalse: [
- self checkoutDirectory emitMkdir.
+ self checkoutDirectory emitMkdir.
realUrl := url copy.
url scheme ~ 'git+(https?|rsync)' ifTrue: [
realUrl scheme: (url scheme copyFrom: 5) ].
url host = '' ifTrue: [ realUrl := realUrl path ].
- command := 'git clone --depth 1 %1 .' % {realUrl} ]
+ command := 'git clone --depth 1 %1 .' % {realUrl} ]
ifTrue: [
command := 'git fetch' ].
@@ -265,7 +265,7 @@ PackageCheckout subclass: GitPackageCheckout [
saveDir := Directory working.
Command
execute: [
- Directory working: self checkoutDirectory.
+ Directory working: self checkoutDirectory.
Smalltalk system: command ]
ensure: [ Directory working: saveDir ].
@@ -274,10 +274,10 @@ PackageCheckout subclass: GitPackageCheckout [
('cd %1 && ' % { self checkoutDirectory }, command) displayNl.
Command
- execute: [
- Directory working: self checkoutDirectory.
+ execute: [
+ Directory working: self checkoutDirectory.
Smalltalk system: command ]
- ensure: [ Directory working: saveDir ] ]
+ ensure: [ Directory working: saveDir ] ]
]
]
@@ -326,7 +326,7 @@ Kernel.PackageDirectories subclass: PackageFiles [
package packages do: [ :each |
(each url notNil and: [each url notEmpty]) ifTrue: [
found := true.
- each url = urlString ifTrue: [
+ each url = urlString ifTrue: [
^self error: 'infinite loop in package.xml urls' ].
self addURL: (NetClients.URL fromString: each url) ]].
found ifTrue: [^self].
@@ -381,7 +381,7 @@ File extend [
saveDir := Directory working.
Command
execute: [
- Directory working: dir name.
+ Directory working: dir name.
Smalltalk system: '%1 -n .st:.xml -qr %2 .' % { Command zip. self }
]
ensure: [ Directory working: saveDir ]
@@ -411,10 +411,10 @@ File extend [
displayNl.
Command
execute: [
- destFile exists ifTrue: [ destFile remove ].
- srcStream := self readStream.
+ destFile exists ifTrue: [ destFile remove ].
+ srcStream := self readStream.
destStream := destFile writeStream.
- destStream nextPutAll: srcStream.
+ destStream nextPutAll: srcStream.
]
ensure: [
destStream isNil ifFalse: [ destStream close ].
@@ -467,7 +467,7 @@ Object subclass: Command [
optionsCollection := OrderedCollection new.
options keysDo: [ :opt |
(options at: opt) do: [ :arg |
- optionsCollection add: opt->arg ]].
+ optionsCollection add: opt->arg ]].
^optionsCollection
]
@@ -475,9 +475,9 @@ Object subclass: Command [
options := Dictionary new.
aCollection do: [ :assoc |
(options at: assoc key ifAbsentPut: [ OrderedCollection new ])
- addLast: assoc value.
+ addLast: assoc value.
(self isValidOption: assoc key) ifFalse: [
- self error: ('--%1 invalid for this mode' % {assoc key}) ] ]
+ self error: ('--%1 invalid for this mode' % {assoc key}) ] ]
]
isValidOption: aString [
@@ -753,19 +753,19 @@ PackageCommand subclass: PkgInstall [
baseDir emitMkdir.
Command
execute: [
- (baseDir / 'package.xml') withWriteStreamDo: [ :s |
- pkg printOn: s ].
+ (baseDir / 'package.xml') withWriteStreamDo: [ :s |
+ pkg printOn: s ].
- files := pkg allFiles.
+ files := pkg allFiles.
dirs := files collect: [ :file | File pathFor: file ].
- (dirs asSet remove: '' ifAbsent: []; asSortedCollection)
+ (dirs asSet remove: '' ifAbsent: []; asSortedCollection)
do: [ :dir | (baseDir / dir) emitMkdir ].
files do: [ :file || srcFile |
- srcFile := (aPackage fullPathOf: file).
- srcFile emitSymlink: (baseDir nameAt: file) ].
+ srcFile := (aPackage fullPathOf: file).
+ srcFile emitSymlink: (baseDir nameAt: file) ].
- (self installDir / aPackage name, '.star')
+ (self installDir / aPackage name, '.star')
emitZipDir: baseDir
]
ensure: [ baseDir all remove ].
@@ -811,6 +811,30 @@ PackageCommand subclass: ListCommand [
defaultInstallDir [ ^'.' ]
]
+ListCommand subclass: PckRepositoryList [
+ PckRepositoryList class >> selectionOptions [
+
+
+ ^ #('list-repository')
+ ]
+
+ run [
+
+
+ "stream := '/home/gwenael/Temp/repository.xml' asFile readStream."
+ 'Packages list : ' displayNl.
+ (Kernel.PackageRepository parse: (NetClients.URL fromString: 'http://smalltalk.gnu.org/project/repository.xml') readStream)
+ packagesDo: [ :each |
+ each displayNl ]
+ ]
+
+ executeOnAll: args [
+
+
+ self run
+ ]
+]
+
ListCommand subclass: PkgList [
PkgList class >> selectionOptions [
^#('list-files' 'no-install')
@@ -885,11 +909,11 @@ PackageCommand subclass: PkgPrepare [
srcFile isNil ifTrue: [
f := self srcdir / aString.
(File exists: f)
- ifTrue: [ srcFile := (File name: self srcdir) pathTo: f ].
+ ifTrue: [ srcFile := (File name: self srcdir) pathTo: f ].
f := f, '.in'.
(File exists: f)
- ifTrue: [ srcFile := (File name: self srcdir) pathTo: f ].
+ ifTrue: [ srcFile := (File name: self srcdir) pathTo: f ].
(File exists: aString)
ifTrue: [ srcFile := File name: aString ].
@@ -910,15 +934,15 @@ PackageCommand subclass: PkgPrepare [
configureAC exists ifFalse: [
'creating configure.ac' displayNl.
Command dryRun ifFalse: [
- configureAC withWriteStreamDo: [ :ws | self writeConfigure: ws ] ] ].
+ configureAC withWriteStreamDo: [ :ws | self writeConfigure: ws ] ] ].
gstIN exists ifFalse: [
'creating gst.in' displayNl.
Command dryRun ifFalse: [
- gstIN withWriteStreamDo: [ :ws | self writeGstIn: ws ] ] ].
+ gstIN withWriteStreamDo: [ :ws | self writeGstIn: ws ] ] ].
makefileAM exists ifFalse: [
'creating Makefile.am' displayNl.
Command dryRun ifFalse: [
- makefileAM withWriteStreamDo: [ :ws | self writeMakefile: ws ] ] ]
+ makefileAM withWriteStreamDo: [ :ws | self writeMakefile: ws ] ] ]
]
writeGstIn: ws [
@@ -984,8 +1008,8 @@ AC_OUTPUT
(File name: each) withReadStreamDo: [ :rs |
| pkg |
[ pkg := Package parse: rs ]
- on: Kernel.PackageNotAvailable
- do: [ :ex | ex resume ].
+ on: Kernel.PackageNotAvailable
+ do: [ :ex | ex resume ].
pkgName := pkg name ].
ws nextPutAll: ('GST_PACKAGE_ENABLE([%1], [%2]' % {
@@ -1043,7 +1067,7 @@ Object subclass: PackageManager [
ModeClasses isNil ifTrue: [
ModeClasses := Dictionary new.
Command allSubclassesDo: [ :each |
- each selectionOptions do: [ :opt |
+ each selectionOptions do: [ :opt |
ModeClasses at: opt put: each ] ] ].
^ModeClasses
@@ -1085,6 +1109,7 @@ Operation modes:
--prepare create configure.ac or Makefile.am
--list-files PKG just output the list of files in the package
--list-packages just output the list of packages in the files
+ --list-repository just output the list of packages in the repository smalltalk.gnu.org
--download, --update download package from smalltalk.gnu.org or
from its specified URL
@@ -1095,8 +1120,8 @@ Operation modes:
Common suboptions:
-n, --dry-run print commands without running them
--srcdir DIR look for non-built files in directory DIR
- --distdir DIR for --dist, place files in directory DIR
- --destdir DIR prefix the destination directory with DIR
+ --distdir DIR for --dist, place files in directory DIR
+ --destdir DIR prefix the destination directory with DIR
--target-directory DIR install the files in DIR (unused for --dist)
-I, --image-file=FILE load into the specified image
--kernel-dir=PATH use the specified kernel directory
@@ -1144,16 +1169,16 @@ The default target directory is ', Directory image name, '
default. --no-install is also present for backwards compatibility."
parse: args
with: '-h|--help --no-load --test --load --no-install --uninstall
- --dist -t|--target-directory: --list-files: --list-packages
+ --dist -t|--target-directory: --list-files: --list-packages --list-repository
--prepare --srcdir: --distdir|--destdir: -n|--dry-run
--all-files --vpath --copy -I|--image-file: --kernel-directory:
--update|--download --version'
do: [ :opt :arg || modeClass |
- opt = 'help' ifTrue: [
+ opt = 'help' ifTrue: [
self displayHelpAndQuit: 0 ].
- opt = 'version' ifTrue: [
+ opt = 'version' ifTrue: [
('gst-package - %1' % {Smalltalk version}) displayNl.
ObjectMemory quit: 0 ].