summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2001-09-06 09:35:38 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2001-09-06 09:35:38 (GMT)
commit00fa35903e2fbdfd338272cca5a688e72cfa2fe5 (patch)
tree93416be5c270a49dbdaf6d13f37789d57f26b257 /generic
parentc8fdd3bc2f632161150acc34eba0e6904ada0e9c (diff)
downloadtcl-00fa35903e2fbdfd338272cca5a688e72cfa2fe5.zip
tcl-00fa35903e2fbdfd338272cca5a688e72cfa2fe5.tar.gz
tcl-00fa35903e2fbdfd338272cca5a688e72cfa2fe5.tar.bz2
Changes due to TIP#49 "Tcl_OutputBuffered" from Rolf Schroedter
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.decls9
-rw-r--r--generic/tclDecls.h9
-rw-r--r--generic/tclIO.c93
-rw-r--r--generic/tclStubInit.c3
4 files changed, 64 insertions, 50 deletions
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. */