[RFC] Filesystem class improvements

I just came across http://wiki.squeak.org/squeak/5929 and I think it has
a great potential.  I quickly put together a couple of ideas from it
into GNU Smalltalk's file and directory classes, which I attach.

The only incompatible change is that Directory>>#do: now returns
File/Directory objects, not names.  That was a mistake, and surprisingly
I found no user in GNU Smalltalk outside of File and Directory themselves.

Now, the RFC is: should the patch go in, or is it just an incomplete
transition?

However, implementing more ideas from that wiki page would require a
rewrite of File and Directory.  It would be great also to rewrite the
current VFS classes so that they would be accessed with
decorators/adaptors as in the wiki page (currently GNU Smalltalk has
some problems with files that include `#' characters) because of VFS.
Actually, I don't mind incompatible changes in this area as long as the
transition is well documented.

I think it would make an even better summer of code project than the
ones already listed if you want to learn about OO design.  Personally,
I'd love to mentor this one.

Paolo

diff --git a/kernel/Directory.st b/kernel/Directory.st
index 4f1636c..4912cd9 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,56 @@ virtual one).'>
  <category: 'enumerating'>
  | ws |
  ws := WriteStream on: (Array new: 50).
- self do: [:each | ws nextPut: each].
+ vfsHandler do: [: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
+ vfsHandler do: [ :name |
+    aBlock value: (self at: 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).
+ vfsHandler do: [ :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 [
@@ -321,8 +395,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 bfa4ff6..73b5d65 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, 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."
 
diff --git a/kernel/FileDescr.st b/kernel/FileDescr.st
index 9b7c1da..a86a8ab 100644
--- a/kernel/FileDescr.st
+++ b/kernel/FileDescr.st
@@ -110,7 +110,7 @@ do arbitrary processing on the files.'>
  ((fileName indexOfSubCollection: '://') > 0
     and: [fileMode = FileStream read])
  ifTrue: [^NetClients.URIResolver openStreamOn: fileName].
- ^(VFS.VFSHandler for: fileName)
+ ^(VFS.VFSHandler for: fileName asString)
     open: self
     mode: fileMode
     ifFail: [SystemExceptions.FileError signal: 'could not open ' , fileName]
@@ -132,7 +132,7 @@ do arbitrary processing on the files.'>
  no references exist anymore, send it #removeToBeFinalized"
 
  <category: 'instance creation'>
- ^(VFS.VFSHandler for: fileName)
+ ^(VFS.VFSHandler for: fileName asString)
     open: self
     mode: fileMode
     ifFail: aBlock
@@ -149,7 +149,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/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' ].

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