[PATCH] some file/directory fixes

For 2.3 and 3.0

Paolo

2007-06-22  Paolo Bonzini  <[hidden email]>

        * kernel/File.st: Fix fullNameFor: returning root, add
        printing methods and #with{Read,Write}StreamDo:.
        * kernel/Directory.st: Support appending empty filename,
        return newly created directory in #create:.

        * gst-load.in: Use eval to support quotes in GSTARGS.
        * gst-sunit.in: Likewise.

--- orig/gst-load.in
+++ mod/gst-load.in
@@ -39,19 +39,19 @@ gst () {
   script=$1
   shift
   if test x${image_file:+set} = xset; then
-    "$GST" $GSTARGS -I "$image_file" -qK "$script" -a "$@"
+    eval \"\$GST\" "$GSTARGS" -I \"\$image_file\" -qK \"\$script\" -a \"\$@\"
   else
-    "$GST" $GSTARGS -qK "$script" -a "$@"
+    eval \"\$GST\" "$GSTARGS" -qK \"\$script\" -a \"\$@\"
   fi
 }
 
 show_help () {
-  "$GST" $GSTARGS -qK scripts/Load.st -a $1
+  eval \"\$GST\" "$GSTARGS" -qK scripts/Load.st -a \$1
   exit $?
 }
 
 getopt () {
-  "$GST" $GSTARGS -qK scripts/Getopt.st -a "$OPTIONS" "$@"
+  eval \"\$GST\" "$GSTARGS" -qK scripts/Getopt.st -a \"\$OPTIONS\" \"\$@\"
 }
 
 getopt "$@" | {


--- orig/gst-sunit.in
+++ mod/gst-sunit.in
@@ -40,19 +40,19 @@ gst () {
   script=$1
   shift
   if test x${image_file:+set} = xset; then
-    "$GST" $GSTARGS -I "$image_file" -qK "$script" -a "$@"
+    eval \"\$GST\" "$GSTARGS" -I \"\$image_file\" -qK \"\$script\" -a \"\$@\"
   else
-    "$GST" $GSTARGS -qK "$script" -a "$@"
+    eval \"\$GST\" "$GSTARGS" -qK \"\$script\" -a \"\$@\"
   fi
-}
+}
 
 show_help () {
-  "$GST" $GSTARGS -qK scripts/Test.st -a $1
+  eval \"\$GST\" "$GSTARGS" -qK scripts/Test.st -a \$1
   exit $?
 }
 
 getopt () {
-  "$GST" $GSTARGS -qK scripts/Getopt.st -a "$OPTIONS" "$@"
+  eval \"\$GST\" "$GSTARGS" -qK scripts/Getopt.st -a \"\$OPTIONS\" \"\$@\"
 }
 
 getopt "$@" | {


--- orig/kernel/Directory.st
+++ mod/kernel/Directory.st
@@ -113,6 +113,7 @@ append: fileName to: directory
     "Answer the name of a file named `fileName' which resides in a directory
      named `directory'."
     directory isEmpty ifTrue: [ ^fileName ].
+    fileName isEmpty ifTrue: [ ^directory ].
     self pathSeparator == $\
  ifFalse: [
     (fileName at: 1) isPathSeparator ifTrue: [ ^fileName ] ]
@@ -160,9 +161,12 @@ allFilesMatching: aPattern do: aBlock
 !
 
 create: dirName
-    "Create a directory named dirName."
-    ^(VFS.VFSHandler for: (File pathFor: dirName ifNone: [ Directory working ]))
- createDir: (File stripPathFrom: dirName)
+    "Create a directory named dirName and answer it."
+    | parent handler |
+    parent := File pathFor: dirName ifNone: [ Directory working ].
+    handler := VFS.VFSHandler for: parent.
+    handler createDir: (File stripPathFrom: dirName).
+    ^Directory name: dirName
 ! !
 
 


--- orig/kernel/File.st
+++ mod/kernel/File.st
@@ -161,6 +161,7 @@ fullNameFor: aString
  ]
     ].
 
+    path isEmpty ifTrue: [ ^Directory pathSeparatorString ].
     result := path inject: '' into: [ :old :each |
  old, Directory pathSeparatorString, each ].
 
@@ -303,6 +304,30 @@ image
 ! !
 
 
+!File methodsFor: 'printing'!
+
+printOn: aStream
+    "Print a representation of the receiver on aStream."
+    aStream
+ nextPut: $<;
+ print: self class;
+ space;
+ display: self;
+ nextPut: $>
+!
+
+displayOn: aStream
+    "Print a representation of the receiver on aStream."
+    | name string |
+    name := self name.
+    string := (name anySatisfy: [ :each | '"$\<>'' `' includes: each ])
+ ifTrue: [ { ''''. name copyReplaceAll: '''' with: '''\'''''. '''' } join ]
+ ifFalse: [ name ].
+
+    aStream nextPutAll: string
+! !
+
+
 !File methodsFor: 'accessing'!
 
 name
@@ -499,11 +524,23 @@ openDescriptor: mode ifFail: aBlock
     ^vfsHandler openDescriptor: mode ifFail: aBlock
 !
 
+withReadStreamDo: aBlock
+    | stream |
+    stream := self readStream.
+    [ aBlock value: stream ] ensure: [ stream close ]
+!
+
 readStream
     "Open a read-only FileStream on the receiver"
     ^self open: FileStream read
 !
 
+withWriteStreamDo: aBlock
+    | stream |
+    stream := self writeStream.
+    [ aBlock value: stream ] ensure: [ stream close ]
+!
+
 writeStream
     "Open a write-only FileStream on the receiver"
     ^self open: FileStream write
@@ -520,6 +557,13 @@ symlinkAs: destName
     dest symlinkFrom: relPath
 !
 
+pathFrom: dirName
+    "Compute the relative path from the directory dirName to the receiver"
+    ^File
+ computePathFrom: (File fullNameFor: dirName), '/somefile'
+ to: vfsHandler realFileName
+!
+
 pathTo: destName
     "Compute the relative path from the receiver to destName."
     ^File



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