help-smalltalk
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Help-smalltalk] [PATCH] some file/directory fixes


From: Paolo Bonzini
Subject: [Help-smalltalk] [PATCH] some file/directory fixes
Date: Fri, 22 Jun 2007 17:48:40 +0200
User-agent: Thunderbird 2.0.0.4 (Macintosh/20070604)

For 2.3 and 3.0

Paolo
2007-06-22  Paolo Bonzini  <address@hidden>

        * 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 
\"address@hidden"
   else
-    "$GST" $GSTARGS -qK "$script" -a "$@"
+    eval \"\$GST\" "$GSTARGS" -qK \"\$script\" -a \"address@hidden"
   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\" 
\"address@hidden"
 }
 
 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 
\"address@hidden"
   else
-    "$GST" $GSTARGS -qK "$script" -a "$@"
+    eval \"\$GST\" "$GSTARGS" -qK \"\$script\" -a \"address@hidden"
   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\" 
\"address@hidden"
 }
 
 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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]