summaryrefslogtreecommitdiffstats
path: root/generic/tclIO.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2005-06-06 23:45:37 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2005-06-06 23:45:37 (GMT)
commite9429305435f6edac06ba3dc914e5658705e160a (patch)
tree374c84c5df35cf33d6fe30319969eb01c100c078 /generic/tclIO.c
parent6580b2352407aa1b0f314552899f301558bc3113 (diff)
downloadtcl-e9429305435f6edac06ba3dc914e5658705e160a.zip
tcl-e9429305435f6edac06ba3dc914e5658705e160a.tar.gz
tcl-e9429305435f6edac06ba3dc914e5658705e160a.tar.bz2
TIP#208 implementation
It's crude (especially in the tests and docs department) and incomplete (no truncation on non-POSIX platforms).
Diffstat (limited to 'generic/tclIO.c')
-rw-r--r--generic/tclIO.c84
1 files changed, 83 insertions, 1 deletions
diff --git a/generic/tclIO.c b/generic/tclIO.c
index ee37035..06fd55b 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIO.c,v 1.86 2005/05/10 18:34:38 kennykb Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.87 2005/06/06 23:45:45 dkf Exp $
*/
#include "tclInt.h"
@@ -5777,6 +5777,77 @@ Tcl_TellOld(chan)
/*
*---------------------------------------------------------------------------
*
+ * Tcl_TruncateChannel --
+ *
+ * Truncate a channel to the given length.
+ *
+ * Results:
+ * TCL_OK on success, TCL_ERROR if the operation failed (e.g. is
+ * not supported by the type of channel, or the underlying OS
+ * operation failed in some way).
+ *
+ * Side effects:
+ * Seeks the channel to the current location. Sets errno on OS
+ * error.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_TruncateChannel(chan, length)
+ Tcl_Channel chan;
+ Tcl_WideInt length;
+{
+ Channel *chanPtr = (Channel *) chan;
+ Tcl_DriverTruncateProc *truncateProc =
+ Tcl_ChannelTruncateProc(chanPtr->typePtr);
+ int result;
+
+ if (truncateProc == NULL) {
+ /*
+ * Feature not supported and it's not emulatable. Pretend it's
+ * returned an EINVAL, a very generic error!
+ */
+ Tcl_SetErrno(EINVAL);
+ return TCL_ERROR;
+ }
+
+ if (!(chanPtr->stateptr->flags & TCL_WRITABLE)) {
+ /*
+ * We require that the file was opened of writing. Do that
+ * check now so that we only flush if we think we're going to
+ * succeed.
+ */
+ Tcl_SetErrno(EINVAL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Seek first to force a total flush of all pending buffers and
+ * ditch any pre-read input data.
+ */
+
+ if (Tcl_Seek(chan, 0, SEEK_CUR) == Tcl_LongAsWide(-1)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * We're all flushed to disk now and we also don't have any
+ * unfortunate input baggage around either; can truncate with
+ * impunity.
+ */
+
+ result = truncateProc(chanPtr->instanceData, length);
+ if (result != 0) {
+ Tcl_SetErrno(result);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* CheckChannelErrors --
*
* See if the channel is in an ready state and can perform the
@@ -9367,6 +9438,17 @@ Tcl_ChannelThreadActionProc(chanTypePtr)
}
}
+Tcl_DriverTruncateProc *
+Tcl_ChannelTruncateProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_5)) {
+ return chanTypePtr->truncateProc;
+ } else {
+ return NULL;
+ }
+}
+
#if 0
/*
* For future debugging work, a simple function to print the flags of