added interface to truncate & ftruncate (req. by Mr. Olberding)
--- a/ExtStream.st Fri Feb 02 20:21:40 1996 +0100
+++ b/ExtStream.st Sun Feb 04 20:06:39 1996 +0100
@@ -17,7 +17,7 @@
lastErrorNumber'
classVariableNames:'Lobby LastErrorNumber
InvalidReadSignal InvalidWriteSignal InvalidModeSignal
- OpenErrorSignal StreamNotOpenSignal'
+ OpenErrorSignal StreamNotOpenSignal InvalidOperationSignal'
poolDictionaries:''
category:'Streams-External'
!
@@ -196,6 +196,10 @@
InvalidModeSignal nameClass:self message:#invalidModeSignal.
InvalidModeSignal notifierString:'binary/text mode mismatch'.
+ InvalidOperationSignal := StreamErrorSignal newSignalMayProceed:false.
+ InvalidOperationSignal nameClass:self message:#invalidOperationSignal.
+ InvalidOperationSignal notifierString:'unsupported file operation'.
+
StreamNotOpenSignal := StreamErrorSignal newSignalMayProceed:false.
StreamNotOpenSignal nameClass:self message:#streamNotOpenSignal.
StreamNotOpenSignal notifierString:'stream is not open'.
@@ -244,6 +248,13 @@
^ InvalidModeSignal
!
+invalidOperationSignal
+ "return the signal raised when an unsupported or invalid
+ I/O operation is attempted"
+
+ ^ InvalidOperationSignal
+!
+
invalidReadSignal
"return the signal raised when reading from writeonly streams"
@@ -526,6 +537,15 @@
in:thisContext sender
!
+errorUnsupportedOperation
+ "report an error, that some unsupported operation was attempted"
+
+ ^ InvalidOperationSignal
+ raiseRequestWith:self
+ errorString:'unsupported operation'
+ in:thisContext sender
+!
+
errorWriteOnly
"report an error, that the stream is a writeOnly stream"
@@ -1185,6 +1205,41 @@
self position:"0" 1
!
+truncateTo:newSize
+ "truncate the underlying OS file to newSize.
+ Warning: this may not be implemented on all platforms."
+%{ /* NOCONTEXT */
+#ifdef HAS_FTRUNCATE
+ FILE *f;
+ OBJ fp;
+
+ if (((fp = _INST(filePointer)) != nil)
+ && (_INST(mode) != @symbol(readonly))) {
+ if (__isSmallInteger(newSize)) {
+ f = __FILEVal(fp);
+
+ ftruncate(fileno(f), __intVal(newSize));
+ RETURN (self);
+ }
+ }
+#endif
+%}.
+ filePointer isNil ifTrue:[^ self errorNotOpen].
+ (mode == #readonly) ifTrue:[^ self errorReadOnly].
+ ^ self errorUnsupportedOperation
+
+ "
+ |s|
+
+ s := 'test' asFilename writeStream.
+ s next:1000 put:$a.
+ s truncateTo:100.
+ s close.
+
+ ('test' asFilename fileSize) printNL
+ "
+!
+
setToEnd
"redefined since it must be implemented differently"
@@ -3474,6 +3529,6 @@
!ExternalStream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.84 1996-01-16 19:11:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.85 1996-02-04 19:06:39 cg Exp $'
! !
ExternalStream initialize!
--- a/ExternalStream.st Fri Feb 02 20:21:40 1996 +0100
+++ b/ExternalStream.st Sun Feb 04 20:06:39 1996 +0100
@@ -17,7 +17,7 @@
lastErrorNumber'
classVariableNames:'Lobby LastErrorNumber
InvalidReadSignal InvalidWriteSignal InvalidModeSignal
- OpenErrorSignal StreamNotOpenSignal'
+ OpenErrorSignal StreamNotOpenSignal InvalidOperationSignal'
poolDictionaries:''
category:'Streams-External'
!
@@ -196,6 +196,10 @@
InvalidModeSignal nameClass:self message:#invalidModeSignal.
InvalidModeSignal notifierString:'binary/text mode mismatch'.
+ InvalidOperationSignal := StreamErrorSignal newSignalMayProceed:false.
+ InvalidOperationSignal nameClass:self message:#invalidOperationSignal.
+ InvalidOperationSignal notifierString:'unsupported file operation'.
+
StreamNotOpenSignal := StreamErrorSignal newSignalMayProceed:false.
StreamNotOpenSignal nameClass:self message:#streamNotOpenSignal.
StreamNotOpenSignal notifierString:'stream is not open'.
@@ -244,6 +248,13 @@
^ InvalidModeSignal
!
+invalidOperationSignal
+ "return the signal raised when an unsupported or invalid
+ I/O operation is attempted"
+
+ ^ InvalidOperationSignal
+!
+
invalidReadSignal
"return the signal raised when reading from writeonly streams"
@@ -526,6 +537,15 @@
in:thisContext sender
!
+errorUnsupportedOperation
+ "report an error, that some unsupported operation was attempted"
+
+ ^ InvalidOperationSignal
+ raiseRequestWith:self
+ errorString:'unsupported operation'
+ in:thisContext sender
+!
+
errorWriteOnly
"report an error, that the stream is a writeOnly stream"
@@ -1185,6 +1205,41 @@
self position:"0" 1
!
+truncateTo:newSize
+ "truncate the underlying OS file to newSize.
+ Warning: this may not be implemented on all platforms."
+%{ /* NOCONTEXT */
+#ifdef HAS_FTRUNCATE
+ FILE *f;
+ OBJ fp;
+
+ if (((fp = _INST(filePointer)) != nil)
+ && (_INST(mode) != @symbol(readonly))) {
+ if (__isSmallInteger(newSize)) {
+ f = __FILEVal(fp);
+
+ ftruncate(fileno(f), __intVal(newSize));
+ RETURN (self);
+ }
+ }
+#endif
+%}.
+ filePointer isNil ifTrue:[^ self errorNotOpen].
+ (mode == #readonly) ifTrue:[^ self errorReadOnly].
+ ^ self errorUnsupportedOperation
+
+ "
+ |s|
+
+ s := 'test' asFilename writeStream.
+ s next:1000 put:$a.
+ s truncateTo:100.
+ s close.
+
+ ('test' asFilename fileSize) printNL
+ "
+!
+
setToEnd
"redefined since it must be implemented differently"
@@ -3474,6 +3529,6 @@
!ExternalStream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.84 1996-01-16 19:11:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.85 1996-02-04 19:06:39 cg Exp $'
! !
ExternalStream initialize!
--- a/Filename.st Fri Feb 02 20:21:40 1996 +0100
+++ b/Filename.st Sun Feb 04 20:06:39 1996 +0100
@@ -881,6 +881,26 @@
"
'/tmp/foo' asFilename renameTo:'/tmp/bar'
"
+!
+
+truncateTo:newSize
+ "change the files size.
+ This may not be supported on all operating systems"
+
+ (OperatingSystem truncateFile:nameString to:newSize) ifFalse:[
+ ^ self reportError:'unsupported operation' with:self
+ ]
+
+ "
+ |s|
+
+ s := 'test' asFilename writeStream.
+ s next:1000 put:$1.
+ s close.
+ ('test' asFilename fileSize) printNL.
+ 'test' asFilename truncateTo:100.
+ ('test' asFilename fileSize) printNL.
+ "
! !
!Filename methodsFor:'file queries'!
@@ -1617,5 +1637,5 @@
!Filename class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.49 1996-01-18 21:34:08 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.50 1996-02-04 19:06:34 cg Exp $'
! !
--- a/Unix.st Fri Feb 02 20:21:40 1996 +0100
+++ b/Unix.st Sun Feb 04 20:06:39 1996 +0100
@@ -257,17 +257,17 @@
# include <wingdi.h> /* */
# include <winuser.h> /* */
-# ifdef DEF_Array
-# define Array DEF_Array
+# ifdef __VM_Array
+# define Array __VM_Array
# endif
-# ifdef DEF_Number
-# define Number DEF_Number
+# ifdef __VM_Number
+# define Number __VM_Number
# endif
-# ifdef DEF_Method
-# define Method DEF_Method
+# ifdef __VM_Method
+# define Method __VM_Method
# endif
-# ifdef DEF_Point
-# define Point DEF_Point
+# ifdef __VM_Point
+# define Point __VM_Point
# endif
# endif
@@ -3260,6 +3260,32 @@
"
!
+truncateFile:aPathName to:newSize
+ "change a files size return true on success, false on failure.
+ This may not be supported on all architectures."
+
+%{ /* NOCONTEXT */
+#ifdef HAS_FTRUNCATE
+ int ret;
+
+ if (__isString(aPathName)
+ && __isSmallInteger(newSize)) {
+ __BEGIN_INTERRUPTABLE__
+ do {
+ ret = truncate((char *) _stringVal(aPathName), __intVal(newSize));
+ } while (ret < 0 && errno == EINTR);
+ __END_INTERRUPTABLE__
+ if (ret < 0) {
+ OperatingSystem_LastErrorNumber = _MKSMALLINT(errno);
+ RETURN ( false );
+ }
+ RETURN (true);
+ }
+#endif
+%}.
+ ^ self primitiveFailed
+!
+
typeOf:aPathName
"return the type of a file as a symbol"
@@ -6379,6 +6405,6 @@
!OperatingSystem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Attic/Unix.st,v 1.119 1996-01-28 13:12:25 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Attic/Unix.st,v 1.120 1996-02-04 19:06:28 cg Exp $'
! !
OperatingSystem initialize!