[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] [PATCH] change some representations from Strings to Fil
|
From: |
Paolo Bonzini |
|
Subject: |
[Help-smalltalk] [PATCH] change some representations from Strings to Files |
|
Date: |
Sat, 05 Apr 2008 14:54:06 -0000 |
This is another preparatory step that does not change the implementation
of the filesystem classes, but returns them when possible.
I don't know why it's here, but this patch also renames File>>#directory
to File>>#parent. I think I will leave a #directory method for
compatibility though.
---
kernel/Directory.st | 36 +++++----
kernel/File.st | 12 ++--
kernel/FileSegment.st | 19 +++--
kernel/PkgLoader.st | 136 +++++++++++++++++-----------------
kernel/SysDict.st | 2 +-
packages/browser/ClassHierBrow.st | 6 +-
packages/httpd/FileServer.st | 2 +-
packages/httpd/WikiServer.st | 2 +-
packages/java/java_lang_Runtime.st | 6 +-
packages/seaside/core/Seaside-GST.st | 2 +-
packages/vfs/VFS.st | 6 +-
packages/xml/parser/XML.st | 2 +-
packages/xml/xsl/XSL.st | 2 +-
scripts/Package.st | 60 ++++++++--------
tests/AnsiLoad.st | 4 +-
15 files changed, 153 insertions(+), 144 deletions(-)
diff --git a/kernel/Directory.st b/kernel/Directory.st
index 4372407..ec8890f 100644
--- a/kernel/Directory.st
+++ b/kernel/Directory.st
@@ -57,35 +57,35 @@ virtual one).'>
"Answer the path to the user's home directory"
<category: 'reading system defaults'>
- ^Smalltalk getenv: 'HOME'
+ ^File name: (Smalltalk getenv: 'HOME')
]
Directory class >> image [
"Answer the path to GNU Smalltalk's image file"
<category: 'reading system defaults'>
- ^ImageFilePath
+ ^File name: ImageFilePath
]
Directory class >> module [
"Answer the path to GNU Smalltalk's dynamically loaded modules"
<category: 'reading system defaults'>
- ^ModulePath
+ ^File name: ModulePath
]
Directory class >> libexec [
"Answer the path to GNU Smalltalk's auxiliary executables"
<category: 'reading system defaults'>
- ^LibexecPath
+ ^File name: LibexecPath
]
Directory class >> systemKernel [
"Answer the path to the installed Smalltalk kernel source files."
<category: 'reading system defaults'>
- ^SystemKernelPath
+ ^File name: SystemKernelPath
]
Directory class >> localKernel [
@@ -101,7 +101,7 @@ virtual one).'>
Smalltalk are stored."
<category: 'reading system defaults'>
- ^UserFileBasePath
+ ^File name: UserFileBasePath
]
Directory class >> temporary [
@@ -110,13 +110,13 @@ virtual one).'>
<category: 'reading system defaults'>
| d |
- (d := Smalltalk getenv: 'TMPDIR') isNil ifFalse: [^d].
- (d := Smalltalk getenv: 'TEMP') isNil ifFalse: [^d].
+ (d := Smalltalk getenv: 'TMPDIR') isNil ifFalse: [^File name: d].
+ (d := Smalltalk getenv: 'TEMP') isNil ifFalse: [^File name: d].
(d := self home) isNil
ifFalse:
- [d := d , '/tmp'.
- (File name: d) isDirectory ifTrue: [^d]].
- ^'/tmp'
+ [d := d / 'tmp'.
+ d isDirectory ifTrue: [^File name: d]].
+ ^File name: '/tmp'
]
Directory class >> kernel [
@@ -125,8 +125,8 @@ virtual one).'>
<category: 'reading system defaults'>
^KernelFilePath isNil
- ifTrue: [ SystemKernelPath ]
- ifFalse: [ KernelFilePath ]
+ ifTrue: [ File name: SystemKernelPath ]
+ ifFalse: [ File name: KernelFilePath ]
]
Directory class >> append: fileName to: directory [
@@ -169,6 +169,12 @@ virtual one).'>
Directory class >> working [
"Answer the current working directory, not following symlinks."
<category: 'file operations'>
+ ^File name: Directory workingName
+ ]
+
+ Directory class >> workingName [
+ "Answer the current working directory, not following symlinks."
+ <category: 'private'>
<cCall: 'getCurDirName' returning: #stringOut args: #()>
]
@@ -177,7 +183,7 @@ virtual one).'>
"Change the current working directory to dirName."
<category: 'file operations'>
- self primWorking: dirName.
+ self primWorking: dirName asString.
self checkError
]
@@ -203,7 +209,7 @@ virtual one).'>
<category: 'file operations'>
| parent handler |
- parent := File pathFor: dirName asString ifNone: [Directory working].
+ parent := File pathFor: dirName asString ifNone: ['.'].
handler := VFS.VFSHandler for: parent.
handler createDir: (File stripPathFrom: dirName).
^File name: dirName
diff --git a/kernel/File.st b/kernel/File.st
index 730b485..3a59ea0 100644
--- a/kernel/File.st
+++ b/kernel/File.st
@@ -155,7 +155,7 @@ size and timestamps.'>
path := OrderedCollection new.
isAbsolute
ifFalse:
- [path addAll: (Directory working substrings: Directory
pathSeparator)].
+ [path addAll: (Directory workingName substrings: Directory
pathSeparator)].
"A Windows path may contain both / and \ separators. Clean it up
to allow easy parsing"
@@ -186,8 +186,8 @@ size and timestamps.'>
"Answer the relative path to destName when the current
directory is srcName's directory."
<category: 'file name management'>
- ^self computePathFrom: (File fullNameFor: srcName)
- to: (File fullNameFor: destName)
+ ^self computePathFrom: (File fullNameFor: srcName asString)
+ to: (File fullNameFor: destName asString)
]
File class >> computePathFrom: srcName to: destName [
@@ -330,7 +330,7 @@ size and timestamps.'>
"Answer the full path to the executable being run."
<category: 'reading system defaults'>
- ^ExecutableFileName
+ ^self path: ExecutableFileName
]
File class >> image [
@@ -565,7 +565,7 @@ size and timestamps.'>
^File stripPathFrom: self name
]
- directory [
+ parent [
"Answer the Directory object for the receiver's path"
<category: 'file name management'>
@@ -709,7 +709,7 @@ size and timestamps.'>
"Compute the relative path from the directory dirName to the receiver"
<category: 'file operations'>
- ^File computePathFrom: (File fullNameFor: dirName) , '/somefile'
+ ^File computePathFrom: (File fullNameFor: dirName asString) ,
'/somefile'
to: vfsHandler realFileName
]
diff --git a/kernel/FileSegment.st b/kernel/FileSegment.st
index 5e3aa50..230f19d 100644
--- a/kernel/FileSegment.st
+++ b/kernel/FileSegment.st
@@ -45,11 +45,11 @@ Smalltalk-80 kernel; I am specific to the GNU Smalltalk
implementation.'>
support $(DESTDIR) and relocatable installation."
<category: 'installing'>
- | map startPath |
+ | map startPath startPathString |
map := IdentityDictionary new.
- startPath := Directory kernel.
+ startPath := Directory kernel asString.
self allInstancesDo: [:each | each relocateFrom: startPath map: map].
- startPath = Directory systemKernel ifTrue: [KernelFilePath := nil].
+ Directory kernel = Directory systemKernel ifTrue: [KernelFilePath :=
nil].
]
FileSegment class >> on: aFile startingAt: startPos for: sizeInteger [
@@ -116,16 +116,21 @@ Smalltalk-80 kernel; I am specific to the GNU Smalltalk
implementation.'>
identified by the receiver is stored"
<category: 'basic'>
- | result fileStream |
- fileStream := FileStream open: self fileName mode: FileStream read.
- ^[aBlock value: fileStream] ensure: [fileStream close]
+ ^self file withReadStreamDo: aBlock
+ ]
+
+ file [
+ "Answer the File object for the file containing the segment"
+
+ <category: 'basic'>
+ ^Directory kernel / file
]
fileName [
"Answer the name of the file containing the segment"
<category: 'basic'>
- ^Directory append: file to: Directory kernel
+ ^self file name
]
filePos [
diff --git a/kernel/PkgLoader.st b/kernel/PkgLoader.st
index 1bf5d17..1ef566d 100644
--- a/kernel/PkgLoader.st
+++ b/kernel/PkgLoader.st
@@ -261,7 +261,7 @@ XML.'>
Namespace current: Kernel [
PackageGroup subclass: PackageDirectory [
- | packages fileName baseDirectories baseDirCache |
+ | packages file baseDirectories baseDirCache |
<category: 'Language-Packaging'>
<comment: 'I am not part of a standard Smalltalk system. I store
internally the
@@ -273,21 +273,26 @@ XML.'>
self shouldNotImplement
]
- PackageDirectory class >> on: aString baseDirectories: aBlock [
+ PackageDirectory class >> on: aFile baseDirectories: aBlock [
<category: 'accessing'>
^(super new)
- fileName: aString;
+ file: aFile;
baseDirectories: aBlock
]
+ file [
+ <category: 'accessing'>
+ ^file
+ ]
+
fileName [
<category: 'accessing'>
- ^fileName
+ ^self file name
]
- fileName: aString [
+ file: aFile [
<category: 'accessing'>
- fileName := aString
+ file := aFile
]
baseDirectories: aBlock [
@@ -316,13 +321,12 @@ XML.'>
Package objects along the way."
<category: 'refreshing'>
- | dir file allDirs |
- file := File name: fileName.
- dir := file directory.
+ | dir allDirs |
+ dir := self file parent.
allDirs := Smalltalk imageLocal
ifTrue: [{Directory image} , baseDirectories value]
ifFalse: [baseDirectories value].
- ((file exists and: [file lastModifyTime > loadDate]) or:
+ ((self file exists and: [self file lastModifyTime > loadDate]) or:
[(dir exists and: [dir lastModifyTime > loadDate])
or: [allDirs ~= baseDirCache]])
ifTrue:
@@ -334,25 +338,24 @@ XML.'>
refreshPackageList [
<category: 'refreshing'>
- | file |
baseDirCache isEmpty ifTrue: [^self].
- file := [FileStream open: fileName mode: FileStream read] on: Error
- do: [:ex | ^self].
-
- [[self parse: file] on: SystemExceptions.PackageNotAvailable
- do: [:ex | ex resignalAs: PackageSkip new]]
- ensure: [file close].
+ self file exists ifFalse: [^self].
+ self file withReadStreamDo: [ :fileStream |
+ [self parse: fileStream]
+ on: SystemExceptions.PackageNotAvailable
+ do: [:ex | ex resignalAs: PackageSkip new]].
+
packages := packages reject: [:each | each isDisabled]
]
refreshStarList: dir [
<category: 'refreshing'>
dir exists ifFalse: [^self].
- dir namesMatching: '*.star'
+ dir filesMatching: '*.star'
do:
- [:starName |
+ [:starFile |
| package |
- package := Kernel.StarPackage fileName: starName.
+ package := Kernel.StarPackage file: starFile.
packages at: package name put: package]
]
@@ -391,7 +394,7 @@ XML.'>
package notNil
ifTrue:
[package name isNil
- ifTrue: [^self error: 'missing package
name in ' , fileName].
+ ifTrue: [^self error: 'missing package
name in ' , self fileName].
[package baseDirectories: baseDirCache.
packages at: package name put: package]
@@ -454,9 +457,7 @@ XML.'>
<category: 'accessing'>
^aCollection collect:
- [:fileName |
- | name |
- name := self fullPathOf: fileName]
+ [:fileName | self fullPathOf: fileName]
]
fullPathOf: fileName [
@@ -835,16 +836,16 @@ XML.'>
Namespace current: Kernel [
PackageInfo subclass: StarPackage [
- | fileName loadedPackage |
+ | file loadedPackage |
<category: 'Language-Packaging'>
<comment: nil>
- StarPackage class >> fileName: fileName [
+ StarPackage class >> file: file [
<category: 'accessing'>
^(self new)
- fileName: fileName;
- name: (File stripPathFrom: (File stripExtensionFrom: fileName));
+ file: file;
+ name: (File stripPathFrom: (File stripExtensionFrom: file name));
yourself
]
@@ -965,17 +966,22 @@ PackageInfo subclass: StarPackage [
directory [
<category: 'accessing'>
- ^fileName , '#uzip'
+ ^File name: self fileName, '#uzip'
+ ]
+
+ file [
+ <category: 'accessing'>
+ ^file
]
fileName [
<category: 'accessing'>
- ^fileName
+ ^self file name
]
- fileName: aString [
+ file: aFile [
<category: 'accessing'>
- fileName := aString
+ file := aFile
]
primFileIn [
@@ -987,9 +993,8 @@ PackageInfo subclass: StarPackage [
<category: 'accessing'>
| file package |
loadedPackage isNil ifFalse: [^loadedPackage].
- file := FileStream open: fileName , '#uzip/package.xml'
- mode: FileStream read.
- [package := Package parse: file] ensure: [file close].
+ package := self file , '#uzip/package.xml'
+ withReadStreamDo: [ :fileStream | Package parse: fileStream].
package isNil
ifTrue: [^self error: 'invalid disabled-package tag inside a star
file'].
package relativeDirectory: self relativeDirectory.
@@ -1223,17 +1228,16 @@ XML.'>
found that contains the file."
<category: 'accessing'>
- | name |
baseDirectories do:
- [:dir |
- name := dir.
+ [:baseDir || dir file |
+ dir := baseDir.
self relativeDirectory isNil
- ifFalse: [name := Directory append: self relativeDirectory
to: dir].
- name := Directory append: fileName to: name.
- (File exists: name) ifTrue: [^name]].
+ ifFalse: [dir := dir / self relativeDirectory].
+ file := dir / fileName.
+ file exists ifTrue: [^file]].
"TODO: should put the name and baseDirectories into the exception."
- "name printNl. baseDirectories printNl."
+ "fileName printNl. baseDirectories printNl."
SystemExceptions.PackageNotAvailable signal: self name
]
@@ -1243,10 +1247,10 @@ XML.'>
<category: 'accessing'>
self relativeDirectory isNil ifTrue: [^nil].
self baseDirectories do:
- [:dir |
- | name |
- name := Directory append: self relativeDirectory to: dir.
- (Directory exists: name) ifTrue: [^name]].
+ [:baseDir || dir |
+ dir := baseDir / relativeDirectory.
+ dir exists ifTrue: [^dir]].
+
SystemExceptions.PackageNotAvailable signal: self name
]
@@ -1288,7 +1292,7 @@ XML.'>
(CFunctionDescriptor isFunction: func)
ifFalse: [^self error: 'C callout not available: '
, func]]].
loadedFiles := self fullPathsOf: self fileIns.
- loadedFiles do: [:each | FileStream fileIn: each].
+ loadedFiles do: [:each | each fileIn].
self name isNil ifFalse: [Smalltalk addFeature: self name].
self features do: [:each | Smalltalk addFeature: each]]
ensure:
@@ -1443,7 +1447,7 @@ into a Smalltalk image, correctly handling dependencies.'>
]
PackageLoader class >> directoryFor: package [
- "Answer a complete path to the given package's files"
+ "Answer a Directory object to the given package's files"
<category: 'accessing'>
^(self packageAt: package) directory
@@ -1565,14 +1569,13 @@ into a Smalltalk image, correctly handling
dependencies.'>
ifTrue:
[self flush.
root := Kernel.PackageDirectories new.
- root add: (Kernel.PackageDirectory on: self packageFileName
- baseDirectories:
- [
+ root add: (Kernel.PackageDirectory on: self packageFile
+ baseDirectories: [
{Directory userBase.
- Directory kernel , '/..'}]).
- root add: (Kernel.PackageDirectory on: self userPackageFileName
+ Directory kernel / '..'}]).
+ root add: (Kernel.PackageDirectory on: self userPackageFile
baseDirectories: [{Directory userBase}]).
- root add: (Kernel.PackageDirectory on: self localPackageFileName
+ root add: (Kernel.PackageDirectory on: self localPackageFile
baseDirectories: [#()])].
root refresh: loadDate.
loadDate := Date dateAndTimeNow
@@ -1620,19 +1623,19 @@ into a Smalltalk image, correctly handling
dependencies.'>
^root includesKey: feature asString
]
- PackageLoader class >> packageFileName [
+ PackageLoader class >> packageFile [
<category: 'private - packages file'>
- ^Directory kernel , '/../packages.xml'
+ ^Directory kernel / '../packages.xml'
]
- PackageLoader class >> userPackageFileName [
+ PackageLoader class >> userPackageFile [
<category: 'private - packages file'>
- ^Directory userBase , '/packages.xml'
+ ^Directory userBase / 'packages.xml'
]
- PackageLoader class >> localPackageFileName [
+ PackageLoader class >> localPackageFile [
<category: 'private - packages file'>
- ^Directory image , '/packages.xml'
+ ^Directory image / 'packages.xml'
]
PackageLoader class >> rebuildPackageFile [
@@ -1643,15 +1646,10 @@ into a Smalltalk image, correctly handling
dependencies.'>
<category: 'private - packages file'>
| file |
self refresh.
- file := FileStream open: Directory image , '/packages.xml'
- mode: FileStream write.
-
- [file nextPutAll: '<!-- GNU Smalltalk packages description file -->'.
- file
- nl;
- nl.
- root printOn: file]
- ensure: [file close]
+ Directory image / 'packages.xml' withWriteStreamDo: [ :file |
+ file nextPutAll: '<!-- GNU Smalltalk packages description file -->'.
+ file nl; nl.
+ root printOn: file]
]
]
diff --git a/kernel/SysDict.st b/kernel/SysDict.st
index f551120..fde805e 100644
--- a/kernel/SysDict.st
+++ b/kernel/SysDict.st
@@ -235,7 +235,7 @@ My instance also helps keep track of dependencies between
objects.'>
directory (non-local image) or not."
<category: 'testing'>
- ^(File pathFor: Directory kernel) ~= Directory image
+ ^Directory kernel parent ~= Directory image
]
isSmalltalk [
diff --git a/packages/browser/ClassHierBrow.st
b/packages/browser/ClassHierBrow.st
index 51e85fb..37e8f6c 100644
--- a/packages/browser/ClassHierBrow.st
+++ b/packages/browser/ClassHierBrow.st
@@ -598,9 +598,9 @@ GuiData subclass: ClassHierarchyBrowser [
["If the image directory is a subdirectory of the home
directory, the default is
the image directory. Else the default is the home directory"
- fileoutDir := Directory image , '/'.
- home := Directory home.
- home = '.' ifTrue: [home := Directory working].
+ fileoutDir := Directory image name , '/'.
+ home := Directory home name.
+ home = '.' ifTrue: [home := Directory working name].
home isEmpty
ifFalse:
[fileoutDir size < home size ifTrue: [^fileoutDir :=
home , '/'].
diff --git a/packages/httpd/FileServer.st b/packages/httpd/FileServer.st
index 22e2b94..6e5ba95 100644
--- a/packages/httpd/FileServer.st
+++ b/packages/httpd/FileServer.st
@@ -824,7 +824,7 @@ and DirectoryResponses.'>
initialize [
<category: 'initialize-release'>
- initialDirectory := File name: Directory working.
+ initialDirectory := Directory working.
uploadAuthorizer := WebAuthorizer new.
name := 'File'
]
diff --git a/packages/httpd/WikiServer.st b/packages/httpd/WikiServer.st
index 9046301..67de862 100644
--- a/packages/httpd/WikiServer.st
+++ b/packages/httpd/WikiServer.st
@@ -2297,7 +2297,7 @@ WebServer class extend [
initializeImages [
<category: 'examples'>
(self at: 8080) handler addComponent: (FileWebServer named: 'images'
- directory: Directory systemKernel , '/../net/httpd')
+ directory: Directory systemKernel / '../net/httpd')
]
initializeWiki [
diff --git a/packages/java/java_lang_Runtime.st
b/packages/java/java_lang_Runtime.st
index 14ece64..97d10e7 100644
--- a/packages/java/java_lang_Runtime.st
+++ b/packages/java/java_lang_Runtime.st
@@ -142,7 +142,7 @@
java_lang_Runtime_insertSystemProperties_java_util_Properties: arg1
put value: 'java.vm.specification.vendor' value: 'Sun Microsystems Inc.'.
put value: 'java.class.path' value: JavaClassFileReader classPath.
- put value: 'java.home' value: Directory image.
+ put value: 'java.home' value: Directory image name.
put value: 'os.name' value: os.
put value: 'os.arch' value: cpu.
put value: 'os.version' value: '1'.
@@ -150,8 +150,8 @@
java_lang_Runtime_insertSystemProperties_java_util_Properties: arg1
put value: 'path.separator' value: ':'.
put value: 'line.separator' value: (Character nl asString).
put value: 'user.name' value: (Smalltalk getenv: 'USER').
- put value: 'user.home' value: (Smalltalk getenv: 'HOME').
- put value: 'user.dir' value: (Smalltalk getenv: 'HOME').
+ put value: 'user.home' value: Directory home name.
+ put value: 'user.dir' value: Directory home name.
put value: 'java.io.tmpdir' value: tmpDir.
put value: 'java.tmpdir' value: tmpDir! !
diff --git a/packages/seaside/core/Seaside-GST.st
b/packages/seaside/core/Seaside-GST.st
index 5d04ee6..b49b110 100644
--- a/packages/seaside/core/Seaside-GST.st
+++ b/packages/seaside/core/Seaside-GST.st
@@ -612,7 +612,7 @@ Object subclass: WAGNUSmalltalkPlatform [
defaultDirectoryName [
<category: '*Seaside-Squeak-Core'>
- ^Directory working
+ ^Directory working name
]
platformString [
diff --git a/packages/vfs/VFS.st b/packages/vfs/VFS.st
index 141ae2e..ac2600c 100644
--- a/packages/vfs/VFS.st
+++ b/packages/vfs/VFS.st
@@ -60,13 +60,13 @@ Commander and with GNOME VFS.'>
<category: 'registering'>
fileTypes := LookupTable new.
- [self fileSystemsIn: Directory libexec , '/vfs'] on: Error
+ [self fileSystemsIn: Directory libexec / 'vfs'] on: Error
do: [:ex | ex return].
- [self fileSystemsIn: Directory userBase , '/vfs'] on: Error
+ [self fileSystemsIn: Directory userBase / 'vfs'] on: Error
do: [:ex | ex return].
Smalltalk imageLocal
ifTrue:
- [[self fileSystemsIn: Directory image , '/vfs'] on: Error
+ [[self fileSystemsIn: Directory image / 'vfs'] on: Error
do: [:ex | ex return]].
^fileTypes keys asSet
]
diff --git a/packages/xml/parser/XML.st b/packages/xml/parser/XML.st
index aee4368..ce9ccc4 100644
--- a/packages/xml/parser/XML.st
+++ b/packages/xml/parser/XML.st
@@ -2313,7 +2313,7 @@ Instance Variables:
s := self fullSourceStack reverse detect: [:i | i uri notNil] ifNone:
[nil].
^s == nil
ifTrue:
- [NetClients.URL fromString: (Directory append: 'foo' to:
Directory working)]
+ [NetClients.URL fromString: (Directory working / 'foo')]
ifFalse: [s uri]
]
diff --git a/packages/xml/xsl/XSL.st b/packages/xml/xsl/XSL.st
index d6cfda6..f54b9f7 100644
--- a/packages/xml/xsl/XSL.st
+++ b/packages/xml/xsl/XSL.st
@@ -951,7 +951,7 @@ E. Acknowledgements (Non-Normative)
readString: aString [
<category: 'loading'>
| doc |
- self initURI: 'file' name: (Directory append: 'xxx' to: Directory
working).
+ self initURI: 'file' name: (Directory working / 'xxx') name.
doc := XMLParser processDocumentString: aString
beforeScanDo:
[:parser |
diff --git a/scripts/Package.st b/scripts/Package.st
index f195839..1a9d04d 100644
--- a/scripts/Package.st
+++ b/scripts/Package.st
@@ -35,14 +35,14 @@ Package extend [
]
isStarPackageBody [
- ^'*.star#uzip' match: self baseDirectories first
+ ^'*.star#uzip' match: self baseDirectories first name
]
starFileName [
| dir |
self isStarPackageBody ifFalse: [ self halt ].
dir := self baseDirectories first.
- ^dir copyFrom: 1 to: dir size - 5 ]
+ ^dir name allButLast: 5 ]
runCommand: aCommand [
self isStarPackageBody
@@ -54,7 +54,7 @@ Package extend [
Kernel.PackageDirectory subclass: StarPackageFile [
refreshStarList: dir [
| package |
- package := Kernel.StarPackage fileName: self fileName.
+ package := Kernel.StarPackage file: self file.
packages at: package name put: package loadedPackage
]
@@ -66,9 +66,8 @@ Kernel.PackageDirectory subclass: PackageFile [
refreshPackageList [
| file |
- file := FileStream open: fileName mode: FileStream read.
- [ self parse: file ]
- ensure: [ file close ].
+ self file withReadStreamDo: [ :fileStream |
+ self parse: fileStream ]
]
]
@@ -80,16 +79,17 @@ Kernel.PackageDirectories subclass: PackageFiles [
]
parse: fileName [
- | packageFile |
+ | file packageFile |
+ file := File name: fileName.
packageFile := ('*.star' match: fileName)
ifFalse: [
PackageFile
- on: fileName
- baseDirectories: [ self baseDirsFor: fileName ] ]
+ on: file
+ baseDirectories: [ self baseDirsFor: file ] ]
ifTrue: [
StarPackageFile
- on: fileName
- baseDirectories: [ fileName, '#uzip' ] ].
+ on: file
+ baseDirectories: [ {File name: fileName, '#uzip'} ] ].
packageFile refresh.
^packageFile
@@ -99,23 +99,23 @@ Kernel.PackageDirectories subclass: PackageFiles [
self add: (self parse: fileName).
]
- baseDirsFor: fileName [
- | file srcdirPath builddirPrefix |
- file := File name: fileName.
+ baseDirsFor: file [
+ | srcdirFile builddirPrefix |
self srcdir isNil ifTrue: [ ^{ file path } ].
"See if the file is in srcdir or builddir. In any case, we want to
look for files first in the builddir, and secondarily in srcdir."
- srcdirPath := file pathFrom: srcdir.
- builddirPrefix := (File name: Directory working) pathFrom: srcdir.
- ^(srcdirPath startsWith: builddirPrefix, Directory pathSeparatorString)
- ifFalse: [
+ srcdirFile := file pathFrom: self srcdir.
+ builddirPrefix := Directory working pathFrom: self srcdir.
+ ^(srcdirFile startsWith: builddirPrefix, Directory pathSeparatorString)
+ ifFalse: [ {
"file is in srcdir."
- { File pathFor: srcdirPath. file path } ]
+ (File name: srcdirFile) parent.
+ file parent } ]
ifTrue: [ {
"file is in builddir."
- file path.
- Directory append: (File pathFor: fileName) to: self srcdir } ]
+ file parent.
+ (self srcdir / (file pathFrom: Directory working)) parent } ]
]
filesDo: aBlock [
@@ -186,7 +186,7 @@ File extend [
emitMkdir [
| doThat |
self exists ifTrue: [ ^self ].
- Command execute: [ self directory emitMkdir ].
+ Command execute: [ self parent emitMkdir ].
('mkdir %1' % { self }) displayNl.
Command execute: [ Directory create: self name ].
]
@@ -309,7 +309,7 @@ Command subclass: PkgDist [
packages filesDo: [ :each |
| destName autoconfName srcdir |
destName := File stripPathFrom: each.
- srcdir := srcdir / (File pathFor: each).
+ srcdir := self srcdir / (File pathFor: each).
autoconfName := destName, '.in'.
(srcdir includes: autoconfName)
ifFalse: [
@@ -339,14 +339,14 @@ Command subclass: PkgDist [
dirs := files collect: [ :file | File pathFor: file ].
dirs := dirs asSet asOrderedCollection.
+ baseDir := self installDir.
aPackage relativeDirectory isNil ifFalse: [
- dirs := dirs collect: [ :dir | aPackage relativeDirectory / dir ] ].
+ baseDir := baseDir / aPackage relativeDirectory ].
- dirs do: [ :dir || destName |
- (self installDir / dir name) emitMkdir ].
+ dirs do: [ :dir | (baseDir / dir) emitMkdir ].
files do: [ :file || srcFile destName |
- srcFile := File name: (aPackage fullPathOf: file).
+ srcFile := aPackage fullPathOf: file.
self distribute: srcFile as: file in: aPackage relativeDirectory ]
]
runOnStar: aPackage [
@@ -409,7 +409,7 @@ Command subclass: PkgInstall [
Smalltalk system: (pat % {
gstLoad.
File name: File image.
- Directory name: Directory kernel.
+ Directory kernel.
(self isOption: 'test') ifTrue: [ '--test' ] ifFalse: [ '' ].
packageList })
]
@@ -439,7 +439,7 @@ Command subclass: PkgInstall [
(baseDir / dir) emitMkdir ].
files do: [ :file || srcFile |
- srcFile := File name: (aPackage fullPathOf: file).
+ srcFile := (aPackage fullPathOf: file).
srcFile emitSymlink: (baseDir nameAt: file) ].
(self installDir / aPackage name, '.star')
@@ -708,7 +708,7 @@ Except in uninstall and list files mode, gst-package
requires write
access to the GNU Smalltalk image directory, and merges the XML package
files on the command line with that file.
-The default target directory is ', Directory image, '
+The default target directory is ', Directory image name, '
'.
[
diff --git a/tests/AnsiLoad.st b/tests/AnsiLoad.st
index f511b47..a74bd5e 100644
--- a/tests/AnsiLoad.st
+++ b/tests/AnsiLoad.st
@@ -80,8 +80,8 @@ PackageLoader fileInPackage: #SUnit!
| ps loaded |
FileStream verbose: true.
-Directory working indexOfSubCollection: 'tests'
- ifAbsent: [ Directory working: Directory kernel, '/../tests' ].
+Directory working name indexOfSubCollection: 'tests'
+ ifAbsent: [ Directory working: Directory kernel / '../tests' ].
ps := Smalltalk at: #ProtocolSpec ifAbsent: [ nil ].
loaded := (ps respondsTo: #includesProtocolNamed:)
--
1.5.3.4.910.gc5122-dirty
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Help-smalltalk] [PATCH] change some representations from Strings to Files,
Paolo Bonzini <=