[PATCH] add #/ #, methods for Directory creation, change #do: to return File/Directory

This is the first patch that actually implements the improvements,
and the one that was already posted.  The basic threads are:

1) provide more powerful constructors for FilePath objects (equivalent
of the old VFSHandler object which was wrapped by File) and for
FileStream objects.  Instead of using "magic paths" like
Seaside.star#uzip/package.xml the user will have to construct
the object (like 'Seaside.star' asFile zip / 'package.xml') and
send it a #readStream method.  Support for "magic paths" with the
# symbol may be readded in the future, but will not be enabled
by default (i.e. you will need special methods).

2) don't return Strings if you can return Files.  Polymorphism
(e.g. Files support #, and #displayOn: works properly) helps in
limiting the number of changes this cause.  This affects
especially methods like Directory class>>#image and Directory>>#do:.

This patch adds the aforementioned polymorphic method and a method #/
that is the instance-side equivalent of Directory class>>#append:to:.

Overall the new code is about 200 lines shorter, but the comparison
is apples-to-oranges because some features are added (e.g. relative
paths in File objects), some are removed (e.g. transparent gzipping
using #ugz, which will be added later), many new classes appear and
many others disappear.
---
 kernel/Directory.st                  |  108 +++++++++++++++++++++++++++++++---
 kernel/File.st                       |   31 ++++++++--
 kernel/FileDescr.st                  |    4 +-
 kernel/ObjMemory.st                  |   25 +++++---
 kernel/URL.st                        |   17 +++---
 packages/gtk/order.st                |    4 +-
 packages/java/JavaClassFiles.st      |    2 +-
 packages/seaside/core/Seaside-GST.st |    8 +--
 packages/xml/xsl/XSL.st              |    2 +-
 scripts/Load.st                      |    3 +-
 scripts/Package.st                   |   15 ++---
 scripts/Remote.st                    |    2 +-
 12 files changed, 167 insertions(+), 54 deletions(-)

diff --git a/kernel/Directory.st b/kernel/Directory.st
index 4f1636c..21bb153 100644
--- a/kernel/Directory.st
+++ b/kernel/Directory.st
@@ -186,7 +186,7 @@ virtual one).'>
 
  <category: 'file operations'>
  | name |
- name := prefix , 'XXXXXX'.
+ name := prefix asString , 'XXXXXX'.
  self primCreateTemporary: name.
  self checkError.
  ^Directory name: name
@@ -203,7 +203,7 @@ virtual one).'>
 
  <category: 'file operations'>
  | parent handler |
- parent := File pathFor: dirName ifNone: [Directory working].
+ parent := File pathFor: dirName asString ifNone: [Directory working].
  handler := VFS.VFSHandler for: parent.
  handler createDir: (File stripPathFrom: dirName).
  ^Directory name: dirName
@@ -214,7 +214,7 @@ virtual one).'>
 
  <category: 'accessing'>
  | destFullName |
- destFullName := File fullNameFor: destName.
+ destFullName := File fullNameFor: destName asString.
  vfsHandler realFileName = destFullName ifTrue: [^'.'].
  ^File computePathFrom: vfsHandler realFileName , '/somefile'
     to: destFullName
@@ -228,6 +228,13 @@ virtual one).'>
  ^File on: (vfsHandler at: aName)
     ]
 
+    / aName [
+ "Answer a File or Directory object as appropriate for a file named
+ 'aName' in the directory represented by the receiver."
+
+ ^self at: aName
+    ]
+
     at: aName [
  "Answer a File or Directory object as appropriate for a file named
  'aName' in the directory represented by the receiver."
@@ -288,6 +295,33 @@ virtual one).'>
     ifFalse: [f allFilesMatching: aPattern do: aBlock]]]
     ]
 
+    files [
+ "Answer an Array with File objects for the contents of the directory
+ represented by the receiver."
+
+ <category: 'enumerating'>
+ ^self select: [ :each | each isFile ]
+    ]
+
+    directories [
+ "Answer an Array with Directory objects for the subdirectories
+ of the directory represented by the receiver."
+
+ <category: 'enumerating'>
+ ^self select: [ :each | each isDirectory ]
+    ]
+
+    entries [
+ "Answer an Array with File or Directory objects for the contents
+ of the directory represented by the receiver."
+
+ <category: 'enumerating'>
+ | ws |
+ ws := WriteStream on: (Array new: 50).
+ self do: [:each | ws nextPut: each].
+ ^ws contents
+    ]
+
     contents [
  "Answer an Array with the names of the files in the directory
  represented by the receiver."
@@ -295,16 +329,64 @@ virtual one).'>
  <category: 'enumerating'>
  | ws |
  ws := WriteStream on: (Array new: 50).
- self do: [:each | ws nextPut: each].
+ self namesDo: [:each | ws nextPut: each].
  ^ws contents
     ]
 
     do: aBlock [
  "Evaluate aBlock once for each file in the directory represented by the
- receiver, passing its name. aBlock should not return."
+ receiver, passing its name."
 
  <category: 'enumerating'>
- vfsHandler do: aBlock
+ self namesDo: [ :name |
+    aBlock value: (self at: name) ]
+    ]
+
+    namesDo: aBlock [
+ "Evaluate aBlock once for each file in the directory represented by the
+ receiver, passing its name."
+
+ <category: 'enumerating'>
+ vfsHandler do: [ :name | aBlock value: name ]
+    ]
+
+    filesMatching: aPattern [
+ "Evaluate aBlock once for each file in the directory represented by the
+ receiver, passing a File or Directory object to aBlock. Returns the
+ *names* of the files for which aBlock returns true."
+
+ <category: 'enumerating'>
+ | ws |
+ ws := WriteStream on: (Array new: 50).
+ self namesDo: [ :name |
+    (aPattern match: name) ifTrue: [ ws nextPut: (self at: name) ] ].
+ ^ws contents
+    ]
+
+    reject: aBlock [
+ "Evaluate aBlock once for each file in the directory represented by the
+ receiver, passing a File or Directory object to aBlock. Returns the
+ *names* of the files for which aBlock returns true."
+
+ <category: 'enumerating'>
+ | ws |
+ ws := WriteStream on: (Array new: 50).
+ self do: [ :each |
+    (aBlock value: each) ifFalse: [ ws nextPut: each ] ].
+ ^ws contents
+    ]
+
+    select: aBlock [
+ "Evaluate aBlock once for each file in the directory represented by the
+ receiver, passing a File or Directory object to aBlock. Returns the
+ *names* of the files for which aBlock returns true."
+
+ <category: 'enumerating'>
+ | ws |
+ ws := WriteStream on: (Array new: 50).
+ self do: [ :each |
+    (aBlock value: each) ifTrue: [ ws nextPut: each ] ].
+ ^ws contents
     ]
 
     filesMatching: aPattern do: block [
@@ -312,8 +394,8 @@ virtual one).'>
  String>>#match:) in the directory named by the receiver."
 
  <category: 'enumerating'>
- self
-    do: [:name | (aPattern match: name) ifTrue: [block value: (self at: name)]]
+ self namesDo: [:name |
+    (aPattern match: name) ifTrue: [block value: (self at: name)]]
     ]
 
     namesMatching: aPattern do: block [
@@ -321,8 +403,16 @@ virtual one).'>
  String>>#match:) in the directory named by the receiver."
 
  <category: 'enumerating'>
- self
+ vfsHandler
     do: [:name | (aPattern match: name) ifTrue: [block value: (self nameAt: name)]]
     ]
 ]
 
+String extend [
+    / aName [
+ "Answer a File or Directory object as appropriate for a file named
+ 'aName' in the directory represented by the receiver."
+
+ ^(Directory name: self) at: aName
+    ]
+]
diff --git a/kernel/File.st b/kernel/File.st
index 5f2d4db..0bc8f5c 100644
--- a/kernel/File.st
+++ b/kernel/File.st
@@ -371,6 +371,20 @@ size and timestamps.'>
  aStream nextPutAll: string
     ]
 
+    , aName [
+ "Answer an object of the same kind as the receiver, whose name
+ is suffixed with aName."
+
+ ^self class name: self name, aName
+    ]
+
+    asString [
+ "Answer the name of the file identified by the receiver"
+
+ <category: 'accessing'>
+ ^vfsHandler fullName
+    ]
+
     name [
  "Answer the name of the file identified by the receiver"
 
@@ -594,6 +608,11 @@ size and timestamps.'>
  ^contents
     ]
 
+    includes: aString [
+ "Return false, regular files do not include other paths."
+ ^false
+    ]
+
     touch [
  "Update the timestamp of the file corresponding to the receiver."
 
@@ -649,18 +668,18 @@ size and timestamps.'>
  ^[aBlock value: stream] ensure: [stream close]
     ]
 
-    readStream [
- "Open a read-only FileStream on the receiver"
+    fileIn [
+ "File in the receiver"
 
  <category: 'file operations'>
- ^self open: FileStream read
+ self withReadStreamDo: [ :fs | fs fileIn ]
     ]
 
-    fileIn [
- "File in the receiver"
+    readStream [
+ "Open a read-only FileStream on the receiver"
 
  <category: 'file operations'>
- self withReadStreamDo: [ :fs | fs fileIn ]
+ ^self open: FileStream read
     ]
 
     withWriteStreamDo: aBlock [
diff --git a/kernel/FileDescr.st b/kernel/FileDescr.st
index c2f7ff0..85f0a93 100644
--- a/kernel/FileDescr.st
+++ b/kernel/FileDescr.st
@@ -131,7 +131,7 @@ do arbitrary processing on the files.'>
  ((fileName indexOfSubCollection: '://') > 0
     and: [fileMode = FileStream read])
  ifTrue: [^NetClients.URIResolver openStreamOn: fileName ifFail: aBlock ].
- ^(VFS.VFSHandler for: fileName)
+ ^(VFS.VFSHandler for: fileName asString)
     open: self
     mode: fileMode
     ifFail: aBlock
@@ -148,7 +148,7 @@ do arbitrary processing on the files.'>
  <category: 'instance creation'>
  ^(self basicNew)
     fileOp: 16
- with: baseName
+ with: baseName asString
  ifFail: [SystemExceptions.FileError signal: 'could not open temporary file'];
     initialize;
     yourself
diff --git a/kernel/ObjMemory.st b/kernel/ObjMemory.st
index 12ab663..d2b0742 100644
--- a/kernel/ObjMemory.st
+++ b/kernel/ObjMemory.st
@@ -46,13 +46,6 @@ manager, while instance-side methods are used together with the #current
 class-side method to take a look at statistics on the memory manager''s
 state.'>
 
-    ObjectMemory class >> snapshot [
- "Save a snapshot on the image file that was loaded on startup."
-
- <category: 'saving the image'>
- ^self snapshot: File image
-    ]
-
     ObjectMemory class >> changed: aSymbol [
  "Before quitting, wait until all processes are done."
  <category: 'initialization'>
@@ -293,16 +286,30 @@ state.'>
  ^self primitiveFailed
     ]
 
-    ObjectMemory class >> snapshot: aString [
+    ObjectMemory class >> primSnapshot: aString [
  "Save an image on the aString file"
 
- <category: 'builtins'>
+ <category: 'private - builtins'>
  <primitive: VMpr_ObjectMemory_snapshot>
  ^aString isString
     ifFalse: [SystemExceptions.WrongClass signalOn: aString mustBe: String]
     ifTrue: [File checkError]
     ]
 
+    ObjectMemory class >> snapshot [
+ "Save a snapshot on the image file that was loaded on startup."
+
+ <category: 'saving the image'>
+ ^self primSnapshot: File image asString
+    ]
+
+    ObjectMemory class >> snapshot: aString [
+ "Save an image on the aString file"
+
+ <category: 'saving the image'>
+ ^self primSnapshot: aString asString
+    ]
+
     ObjectMemory class >> gcMessage [
  "Answer whether messages indicating that garbage collection is taking
  place are printed on stdout"
diff --git a/kernel/URL.st b/kernel/URL.st
index b04179d..edc99d4 100644
--- a/kernel/URL.st
+++ b/kernel/URL.st
@@ -127,22 +127,23 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
  "check fragment and query parts"
 
  | fragmentIndex queryIndex limit fragmentLimit queryLimit urlString url |
- limit := aString size + 1.
- (queryIndex := aString indexOf: $?) ~= 0
+ urlString := aString asString.
+ limit := urlString size + 1.
+ (queryIndex := urlString indexOf: $?) ~= 0
     ifTrue:
  [limit := queryIndex.
- queryLimit := aString
+ queryLimit := urlString
     indexOf: $#
     startingAt: queryIndex + 1
-    ifAbsent: [aString size + 1]].
- (fragmentIndex := aString indexOf: $#) ~= 0
+    ifAbsent: [urlString size + 1]].
+ (fragmentIndex := urlString indexOf: $#) ~= 0
     ifTrue:
  [limit := limit min: fragmentIndex.
- fragmentLimit := aString
+ fragmentLimit := urlString
     indexOf: $?
     startingAt: fragmentIndex + 1
-    ifAbsent: [aString size + 1]].
- urlString := aString copyFrom: 1 to: limit - 1.
+    ifAbsent: [urlString size + 1]].
+ urlString := urlString copyFrom: 1 to: limit - 1.
  url := self fromURLString: urlString.
  queryIndex > 0
     ifTrue: [url query: (urlString copyFrom: queryIndex + 1 to: queryLimit - 1)].
diff --git a/packages/gtk/order.st b/packages/gtk/order.st
index 3d01826..c6583f9 100644
--- a/packages/gtk/order.st
+++ b/packages/gtk/order.st
@@ -124,7 +124,7 @@ Object subclass: IncludesScanner [
     ifFalse:
  [paths do:
  [:each |
- f := File name: each , '/' , aFile.
+ f := each / aFile.
  f isReadable ifTrue: [^f]]].
  paths do: [:each | ('looked in ' , each) displayNl].
  self error: 'Can''t find: ' , aFile printString
@@ -154,7 +154,7 @@ Object subclass: IncludesScanner [
  one with the #include directory.  If it succeeds, use
  an absolute path."
 
- f := File name: (Directory append: fname to: dir).
+ f := dir / fname.
  f isReadable ifTrue: [prefix := dir]].
  (self hasCorrectPrefix: fname) ifTrue: [r add: prefix , fname]]].
  ^r
diff --git a/packages/java/JavaClassFiles.st b/packages/java/JavaClassFiles.st
index a3a81ee..cfc3cd4 100644
--- a/packages/java/JavaClassFiles.st
+++ b/packages/java/JavaClassFiles.st
@@ -904,7 +904,7 @@ findClassFile: aClass
     self classDirectories isNil
  ifTrue: [ self error: 'CLASSPATH not set' ].
     self classDirectories do: [:dir || file |
-        file := File name: (Directory append: path to: dir).
+        file := dir / path.
         file exists ifTrue: [ ^file ]].
 
     ^nil
diff --git a/packages/seaside/core/Seaside-GST.st b/packages/seaside/core/Seaside-GST.st
index c694168..f7d3745 100644
--- a/packages/seaside/core/Seaside-GST.st
+++ b/packages/seaside/core/Seaside-GST.st
@@ -547,7 +547,7 @@ Object subclass: WAGNUSmalltalkPlatform [
 
     ensureExistenceOfFolder: aString [
  "creates a folder named aString in the image directory"
- (Directory append: aString to: Directory image) create
+ (Directory image / aString) create
     ]
 
     filesIn: aPathString [
@@ -645,10 +645,8 @@ Object subclass: WAGNUSmalltalkPlatform [
     write: aStringOrByteArray toFile: aFileNameString inFolder: aFolderString [
  "writes aStringOrByteArray to a file named aFilenameString in the folder aFolderString"
  | stream fileName |
- fileName := Directory append: aFileNameString to: aFolderString.
- stream := FileStream open: fileName mode: 'w'.
- [ stream nextPutAll: aStringOrByteArray ]
- ensure: [ stream close ]
+ aFolderString / aFileNameString withWriteStreamDo: [ :stream |
+    stream nextPutAll: aStringOrByteArray ]
     ]
 ]
 
diff --git a/packages/xml/xsl/XSL.st b/packages/xml/xsl/XSL.st
index d5898d2..d6cfda6 100644
--- a/packages/xml/xsl/XSL.st
+++ b/packages/xml/xsl/XSL.st
@@ -599,7 +599,7 @@ E. Acknowledgements (Non-Normative)
 
     RuleDatabase class >> examplesDirectory [
  <category: 'examples'>
- ^Directory append: 'xml' to: Directory image
+ ^Directory image / 'xml'
     ]
 
     RuleDatabase class >> store: document on: filename [
diff --git a/scripts/Load.st b/scripts/Load.st
index 211682a..ae21b8a 100644
--- a/scripts/Load.st
+++ b/scripts/Load.st
@@ -129,8 +129,7 @@ test
     ifTrue: [
  | tmpFile tmpFileName result |
  snapshot ifTrue: [
-    tmpFile := FileDescriptor openTemporaryFile: (Directory
- append: 'im-' to: Directory temporary).
+    tmpFile := FileDescriptor openTemporaryFile: Directory temporary / 'im-'.
     tmpFileName := tmpFile name.
     ObjectMemory snapshot: tmpFileName.
     wasVerbose := FileStream verbose: wasVerbose ].
diff --git a/scripts/Package.st b/scripts/Package.st
index 6727d51..d3c5048 100644
--- a/scripts/Package.st
+++ b/scripts/Package.st
@@ -309,9 +309,9 @@ Command subclass: PkgDist [
  packages filesDo: [ :each |
     | destName autoconfName srcdir |
     destName := File stripPathFrom: each.
-    srcdir := Directory append: (File pathFor: each) to: self srcdir.
+    srcdir := srcdir / (File pathFor: each).
     autoconfName := destName, '.in'.
-    ((Directory name: srcdir) includes: autoconfName)
+    (srcdir includes: autoconfName)
  ifFalse: [
     self distribute: (File name: each)
  as: destName
@@ -340,11 +340,10 @@ Command subclass: PkgDist [
  dirs := dirs asSet asOrderedCollection.
 
  aPackage relativeDirectory isNil ifFalse: [
-    dirs := dirs collect: [ :dir |
- Directory append: dir to: aPackage relativeDirectory ] ].
+    dirs := dirs collect: [ :dir | aPackage relativeDirectory / dir ] ].
 
         dirs do: [ :dir || destName |
-    (self installDir directoryAt: dir) emitMkdir ].
+    (self installDir directoryAt: dir name) emitMkdir ].
 
         files do: [ :file || srcFile destName |
     srcFile := File name: (aPackage fullPathOf: file).
@@ -417,7 +416,7 @@ Command subclass: PkgInstall [
 
     tmpDir [
  tmpDir isNil ifTrue: [
-            tmpDir := Directory createTemporary: Directory temporary, '/gstar-'.
+            tmpDir := Directory createTemporary: Directory temporary / 'gstar-'.
             ('mkdir %1' % { tmpDir }) displayNl ].
  ^tmpDir
     ]
@@ -516,11 +515,11 @@ Command subclass: PkgPrepare [
     ^super addAllFiles: { srcFile } ].
 
  srcFile isNil ifTrue: [
-    f := Directory append: aCollection first to: self srcdir.
+    f := self srcdir / aCollection first.
             (File exists: f)
         ifTrue: [ srcFile := (Directory name: self srcdir) pathTo: f ].
 
-    f := Directory append: aCollection first, '.in' to: self srcdir.
+    f := f, '.in'.
             (File exists: f)
         ifTrue: [ srcFile := (Directory name: self srcdir) pathTo: f ]
  ].
diff --git a/scripts/Remote.st b/scripts/Remote.st
index 6313b48..5fec5aa 100644
--- a/scripts/Remote.st
+++ b/scripts/Remote.st
@@ -168,7 +168,7 @@ available in the PATH of the remote machine.
  arg isNil
     ifTrue: [ commands add: 'ObjectMemory snapshot' ]
     ifFalse: [ commands add: 'ObjectMemory snapshot: ',
-     (Directory append: arg to: Directory working) storeString ] ].
+     (Directory working / arg) name storeString ] ].
 
     opt isNil ifTrue: [
  host isNil ifFalse: [ self error: 'multiple hosts are invalid' ].
--
1.5.3.4.910.gc5122-dirty



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