[Top][All Lists]
[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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Help-smalltalk] [PATCH] some file/directory fixes,
Paolo Bonzini <=