From 00fa35903e2fbdfd338272cca5a688e72cfa2fe5 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 6 Sep 2001 09:35:38 +0000 Subject: Changes due to TIP#49 "Tcl_OutputBuffered" from Rolf Schroedter --- ChangeLog | 8 +++++ generic/tcl.decls | 9 +++-- generic/tclDecls.h | 9 ++++- generic/tclIO.c | 93 ++++++++++++++++++++++++++------------------------- generic/tclStubInit.c | 3 +- 5 files changed, 72 insertions(+), 50 deletions(-) diff --git a/ChangeLog b/ChangeLog index 88832a6..abf83b2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2001-09-06 Donal K. Fellows + + * generic/tcl.decls (479 generic): + * generic/tclIO.c (Tcl_Seek,Tcl_Tell,Tcl_OutputBuffered): Added + public function to return the size of the output buffer and + reworked other channel functions to use this shared functionality + and that of Tcl_InputBuffered() too. [TIP#49, Rolf Schroedter] + 2001-09-05 David Gravereaux * generic/tclPlatDecls.h: Another small trim finalizing Borland diff --git a/generic/tcl.decls b/generic/tcl.decls index f0f64a9..a4783ab 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -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: tcl.decls,v 1.54 2001/09/04 18:06:34 vincentdarley Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.55 2001/09/06 09:35:38 dkf Exp $ library tcl @@ -1542,6 +1542,7 @@ declare 438 generic { declare 439 generic { int Tcl_IsStandardChannel(Tcl_Channel channel) } +# New functions due to TIP#17 declare 440 generic { int Tcl_FSCopyFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) } @@ -1671,7 +1672,11 @@ declare 477 generic { Tcl_Filesystem* Tcl_FSGetFileSystemForPath(Tcl_Obj* pathObjPtr) } declare 478 generic { - Tcl_PathType Tcl_FSGetPathType (Tcl_Obj *pathObjPtr) + Tcl_PathType Tcl_FSGetPathType (Tcl_Obj *pathObjPtr) +} +# New function due to TIP#49 +declare 479 generic { + int Tcl_OutputBuffered(Tcl_Channel chan) } ############################################################################## diff --git a/generic/tclDecls.h b/generic/tclDecls.h index e7c744a..a0c3a73 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDecls.h,v 1.55 2001/09/04 18:06:34 vincentdarley Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.56 2001/09/06 09:35:38 dkf Exp $ */ #ifndef _TCLDECLS @@ -1495,6 +1495,8 @@ EXTERN Tcl_Filesystem* Tcl_FSGetFileSystemForPath _ANSI_ARGS_(( Tcl_Obj* pathObjPtr)); /* 478 */ EXTERN Tcl_PathType Tcl_FSGetPathType _ANSI_ARGS_((Tcl_Obj * pathObjPtr)); +/* 479 */ +EXTERN int Tcl_OutputBuffered _ANSI_ARGS_((Tcl_Channel chan)); typedef struct TclStubHooks { struct TclPlatStubs *tclPlatStubs; @@ -2033,6 +2035,7 @@ typedef struct TclStubs { char* (*tcl_FSGetTranslatedStringPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 476 */ Tcl_Filesystem* (*tcl_FSGetFileSystemForPath) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 477 */ Tcl_PathType (*tcl_FSGetPathType) _ANSI_ARGS_((Tcl_Obj * pathObjPtr)); /* 478 */ + int (*tcl_OutputBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 479 */ } TclStubs; #ifdef __cplusplus @@ -3989,6 +3992,10 @@ extern TclStubs *tclStubsPtr; #define Tcl_FSGetPathType \ (tclStubsPtr->tcl_FSGetPathType) /* 478 */ #endif +#ifndef Tcl_OutputBuffered +#define Tcl_OutputBuffered \ + (tclStubsPtr->tcl_OutputBuffered) /* 479 */ +#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclIO.c b/generic/tclIO.c index c05f530..e7be46f 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.34 2001/08/23 17:37:07 vincentdarley Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.35 2001/09/06 09:35:39 dkf Exp $ */ #include "tclInt.h" @@ -5251,7 +5251,6 @@ Tcl_Seek(chan, offset, mode) { Channel *chanPtr = (Channel *) chan; /* The real IO channel. */ ChannelState *statePtr = chanPtr->state; /* state info for channel */ - ChannelBuffer *bufPtr; int inputBuffered, outputBuffered; int result; /* Of device driver operations. */ int curPos; /* Position on the device. */ @@ -5293,33 +5292,8 @@ Tcl_Seek(chan, offset, mode) * output is buffered, cannot compute the current position. */ - for (bufPtr = statePtr->inQueueHead, inputBuffered = 0; - bufPtr != (ChannelBuffer *) NULL; - bufPtr = bufPtr->nextPtr) { - inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved); - } - - /* - * Don't forget the bytes in the topmost pushback area. - */ - - for (bufPtr = statePtr->topChanPtr->inQueueHead; - bufPtr != (ChannelBuffer *) NULL; - bufPtr = bufPtr->nextPtr) { - inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved); - } - - for (bufPtr = statePtr->outQueueHead, outputBuffered = 0; - bufPtr != (ChannelBuffer *) NULL; - bufPtr = bufPtr->nextPtr) { - outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved); - } - if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) && - (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) { - statePtr->flags |= BUFFER_READY; - outputBuffered += - (statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved); - } + inputBuffered = Tcl_InputBuffered(chan); + outputBuffered = Tcl_OutputBuffered(chan); if ((inputBuffered != 0) && (outputBuffered != 0)) { Tcl_SetErrno(EFAULT); @@ -5437,7 +5411,6 @@ Tcl_Tell(chan) { Channel *chanPtr = (Channel *) chan; /* The real IO channel. */ ChannelState *statePtr = chanPtr->state; /* state info for channel */ - ChannelBuffer *bufPtr; int inputBuffered, outputBuffered; int result; /* Of calling device driver. */ int curPos; /* Position on device. */ @@ -5478,22 +5451,8 @@ Tcl_Tell(chan) * output is buffered, cannot compute the current position. */ - for (bufPtr = statePtr->inQueueHead, inputBuffered = 0; - bufPtr != (ChannelBuffer *) NULL; - bufPtr = bufPtr->nextPtr) { - inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved); - } - for (bufPtr = statePtr->outQueueHead, outputBuffered = 0; - bufPtr != (ChannelBuffer *) NULL; - bufPtr = bufPtr->nextPtr) { - outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved); - } - if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) && - (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) { - statePtr->flags |= BUFFER_READY; - outputBuffered += - (statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved); - } + inputBuffered = Tcl_InputBuffered(chan); + outputBuffered = Tcl_OutputBuffered(chan); if ((inputBuffered != 0) && (outputBuffered != 0)) { Tcl_SetErrno(EFAULT); @@ -5708,6 +5667,48 @@ Tcl_InputBuffered(chan) /* *---------------------------------------------------------------------- * + * Tcl_OutputBuffered -- + * + * Returns the number of bytes of output currently buffered in the + * common internal buffer of a channel. + * + * Results: + * The number of output bytes buffered, or zero if the channel is not + * open for writing. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_OutputBuffered(chan) + Tcl_Channel chan; /* The channel to query. */ +{ + ChannelState *statePtr = ((Channel *) chan)->state; + /* State of real channel structure. */ + ChannelBuffer *bufPtr; + int bytesBuffered; + + for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead; + bufPtr != (ChannelBuffer *) NULL; + bufPtr = bufPtr->nextPtr) { + bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved); + } + if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) && + (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) { + statePtr->flags |= BUFFER_READY; + bytesBuffered += + (statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved); + } + + return bytesBuffered; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_ChannelBuffered -- * * Returns the number of bytes of input currently buffered in the diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ab2d80b..a3c6b02 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.57 2001/09/04 18:06:34 vincentdarley Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.58 2001/09/06 09:35:39 dkf Exp $ */ #include "tclInt.h" @@ -875,6 +875,7 @@ TclStubs tclStubs = { Tcl_FSGetTranslatedStringPath, /* 476 */ Tcl_FSGetFileSystemForPath, /* 477 */ Tcl_FSGetPathType, /* 478 */ + Tcl_OutputBuffered, /* 479 */ }; /* !END!: Do not edit above this line. */ -- cgit v0.12