[PATCH] change some representations from Strings to Files

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

[PATCH] change some representations from Strings to Files

Paolo Bonzini-2
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



_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk