From 2d937e100928216f6ee936df4596363301450fe2 Mon Sep 17 00:00:00 2001 From: welch Date: Fri, 2 Jul 1999 19:51:29 +0000 Subject: Name change from Tcl_ReplaceChannel to Tcl_StackChannel Added new code that modifies the channel in place. --- generic/tcl.decls | 12 +- generic/tclDecls.h | 9 +- generic/tclIO.c | 447 +++++++++++++++++++++++++++++++++++++------------- generic/tclStubInit.c | 8 +- 4 files changed, 352 insertions(+), 124 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index da93b29..354882e 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.18 1999/06/30 17:47:27 welch Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.19 1999/07/02 19:51:29 welch Exp $ library tcl @@ -982,17 +982,17 @@ declare 280 generic { # version into the new one). declare 281 generic { - Tcl_Channel Tcl_ReplaceChannel(Tcl_Interp *interp, \ + Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, \ Tcl_ChannelType *typePtr, ClientData instanceData, \ int mask, Tcl_Channel prevChan) } declare 282 generic { - void Tcl_UndoReplaceChannel(Tcl_Interp *interp, Tcl_Channel chan) + void Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan) +} +declare 283 generic { + void Tcl_GetStackedChannel(Tcl_Channel chan) } - # Reserved for future use (8.0.x vs. 8.1) -# declare 283 generic { -# } # declare 284 generic { # } # declare 285 generic { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 835f858..b9ba5d5 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.18 1999/06/30 17:47:28 welch Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.19 1999/07/02 19:51:29 welch Exp $ */ #ifndef _TCLDECLS @@ -904,14 +904,15 @@ EXTERN void Tcl_GetVersion _ANSI_ARGS_((int * major, int * minor, /* 280 */ EXTERN void Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp * interp)); /* 281 */ -EXTERN Tcl_Channel Tcl_ReplaceChannel _ANSI_ARGS_((Tcl_Interp * interp, +EXTERN Tcl_Channel Tcl_StackChannel _ANSI_ARGS_((Tcl_Interp * interp, Tcl_ChannelType * typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan)); /* 282 */ -EXTERN void Tcl_UndoReplaceChannel _ANSI_ARGS_(( +EXTERN void Tcl_UnstackChannel _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Channel chan)); -/* Slot 283 is reserved */ +/* 283 */ +EXTERN Tcl_Channel Tcl_GetStackedChannel _ANSI_ARGS_((Tcl_Channel chan)); /* Slot 284 is reserved */ /* Slot 285 is reserved */ /* 286 */ diff --git a/generic/tclIO.c b/generic/tclIO.c index f9e7db6..ab3dfaa 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.9 1999/06/30 17:47:28 welch Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.10 1999/07/02 19:51:29 welch Exp $ */ #include "tclInt.h" @@ -204,7 +204,7 @@ typedef struct Channel { CopyState *csPtr; /* State of background copy, or NULL. */ struct Channel* supercedes; /* Refers to channel this one was stacked upon. This reference is NULL for normal channels. - See Tcl_ReplaceChannel. */ + See Tcl_StackChannel. */ } Channel; @@ -1352,7 +1352,7 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask) /* *---------------------------------------------------------------------- * - * Tcl_ReplaceChannel -- + * Tcl_StackChannel -- * * Replaces an entry in the hash table for a Tcl_Channel * record. The replacement is a new channel with same name, @@ -1365,16 +1365,21 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask) * "Trf-Patch for filtering channels" * * Results: - * Returns the new Tcl_Channel. + * Returns the new Tcl_Channel, which actually contains the + * saved information about prevChan. * * Side effects: - * See above. + * A new channel structure is allocated and linked below + * the existing channel. The channel operations and client + * data of the existing channel are copied down to the newly + * created channel, and the current channel has its operations + * replaced by the new typePtr. * *---------------------------------------------------------------------- */ Tcl_Channel -Tcl_ReplaceChannel(interp, typePtr, instanceData, mask, prevChan) +Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan) Tcl_Interp* interp; /* The interpreter we are working in */ Tcl_ChannelType *typePtr; /* The channel type record for the new * channel. */ @@ -1385,27 +1390,43 @@ Tcl_ReplaceChannel(interp, typePtr, instanceData, mask, prevChan) Tcl_Channel prevChan; /* The channel structure to replace */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - Channel *chanPtr, *pt, *prevPt; + Channel *chanPtr, *pt; + + /* + * AK, 06/30/1999 + * + * Tcl_StackChannel differs from Tcl_ReplaceChannel of the + * original "Trf" patch. Instead of seeing the + * newly created structure as the *new* channel to cover the specified + * one use it to *save* the current state of the specified channel and + * then reinitialize the current structure for the given transformation. + * + * Advantages: + * - No splicing into the (thread-)global list of channels (or the per- + * interp hash-tables). + * - Users of the C-API still have valid channel references even after + * the call to this procedure. + * + * Disadvantages: + * - Untested code. + */ /* - * Find the given channel in the list of all channels, compute enough - * information to allow easy removal after the conditions are met. + * Find the given channel in the list of all channels. */ - prevPt = (Channel*) NULL; pt = (Channel*) tsdPtr->firstChanPtr; while (pt != (Channel *) prevChan) { - prevPt = pt; - pt = pt->nextChanPtr; + pt = pt->nextChanPtr; } /* - * 'pt == prevChan' now + * 'pt == prevChan' now (or NULL, if not found). */ if (!pt) { - return (Tcl_Channel) NULL; + return (Tcl_Channel) NULL; } /* @@ -1422,94 +1443,167 @@ Tcl_ReplaceChannel(interp, typePtr, instanceData, mask, prevChan) */ if ((mask & Tcl_GetChannelMode (prevChan)) == 0) { - return (Tcl_Channel) NULL; + return (Tcl_Channel) NULL; } chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel)); - chanPtr->flags = mask; /* - * Set the channel up initially in no Input translation mode and - * no Output translation mode. + * Save some of the current state into the new structure, + * reinitialize the parts which will stay with the transformation. + * + * Remarks: + * - We cannot discard the buffers, and they cannot be used from the + * transformation placed later into the 'pt' structure. Save them, + * and believe that Tcl_SetChannelOption (buffering, none) will do + * the right thing. + * - encoding and EOL-translation control information is initialized + * to values for 'binary'. This is later reinforced via + * Tcl_SetChanneloption to get the handling of flags and the event + * system right. + * - The 'interestMask' of the saved channel is cleared, but the + * transformations WatchProc is used to establish the connection + * between transformation and underlying channel. This should + * reestablish the correct mask. + * - TTO = Transform Takes Over. The hidden channel no longer + * needs to perform this function. */ - chanPtr->inputTranslation = TCL_TRANSLATE_LF; - chanPtr->outputTranslation = TCL_TRANSLATE_LF; - chanPtr->inEofChar = 0; - chanPtr->outEofChar = 0; + chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1); + strcpy (chanPtr->channelName, pt->channelName); - chanPtr->unreportedError = 0; - chanPtr->instanceData = instanceData; - chanPtr->typePtr = typePtr; - chanPtr->refCount = 0; - chanPtr->closeCbPtr = (CloseCallback *) NULL; - chanPtr->curOutPtr = (ChannelBuffer *) NULL; - chanPtr->outQueueHead = (ChannelBuffer *) NULL; - chanPtr->outQueueTail = (ChannelBuffer *) NULL; - chanPtr->saveInBufPtr = (ChannelBuffer *) NULL; - chanPtr->inQueueHead = (ChannelBuffer *) NULL; - chanPtr->inQueueTail = (ChannelBuffer *) NULL; - chanPtr->chPtr = (ChannelHandler *) NULL; - chanPtr->interestMask = 0; - chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL; - chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; - chanPtr->timer = NULL; - chanPtr->csPtr = NULL; + chanPtr->flags = pt->flags; /* Save */ - /* 06/12/1998: New for Tcl 8.1 - * - * Take over the encoding from the superceded channel, so that it will be - * executed in the future despite the replacement, and at the proper time - * (*after* / *before* our transformation, depending on the direction of - * the dataflow). - * - * *Important* - * The I/O functionality of the filtering channel has to use 'Tcl_Read' to - * get at the underlying information. This will circumvent the de/encoder - * stage [*] in the superceded channel and removes the need to trouble - * ourselves with 'ByteArray's too. + chanPtr->encoding = (Tcl_Encoding) NULL; /* == 'binary' */ + chanPtr->inputEncodingState = (Tcl_EncodingState) NULL; + chanPtr->inputEncodingFlags = TCL_ENCODING_START; + chanPtr->outputEncodingState = (Tcl_EncodingState) NULL; + chanPtr->outputEncodingFlags = TCL_ENCODING_START; + + chanPtr->inputTranslation = TCL_TRANSLATE_LF; /* == 'binary' */ + chanPtr->outputTranslation = TCL_TRANSLATE_LF; /* == 'binary' */ + chanPtr->inEofChar = pt->inEofChar; /* Save */ + chanPtr->outEofChar = pt->outEofChar; /* Save */ + + chanPtr->unreportedError = pt->unreportedError; /* Save */ + chanPtr->instanceData = pt->instanceData; /* Save */ + chanPtr->typePtr = pt->typePtr; /* Save */ + chanPtr->refCount = 0; /* None, as the structure is covered */ + chanPtr->closeCbPtr = (CloseCallback*) NULL; /* TTO */ + + chanPtr->outputStage = (char*) NULL; + chanPtr->curOutPtr = pt->curOutPtr; /* Save */ + chanPtr->outQueueHead = pt->outQueueHead; /* Save */ + chanPtr->outQueueTail = pt->outQueueTail; /* Save */ + chanPtr->saveInBufPtr = pt->saveInBufPtr; /* Save */ + chanPtr->inQueueHead = pt->outQueueHead; /* Save */ + chanPtr->inQueueTail = pt->inQueueTail; /* Save */ + + chanPtr->chPtr = (ChannelHandler *) NULL; /* TTO */ + chanPtr->interestMask = 0; + chanPtr->nextChanPtr = (Channel*) NULL; /* Is not in list! */ + chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL; /* TTO */ + chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; + chanPtr->timer = (Tcl_TimerToken) NULL; /* TTO */ + chanPtr->csPtr = (CopyState*) NULL; /* TTO */ + + /* + * Place new block at the head of a possibly existing list of previously + * stacked channels, then do the missing initializations of translation + * and buffer system. + */ + + chanPtr->supercedes = pt->supercedes; + + Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr, + "-translation", "binary"); + Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr, + "-buffering", "none"); + + /* + * Save accomplished, now reinitialize the (old) structure for the + * transformation. * - * [*] I'm talking about the conversion between UNICODE and other - * representations, like ASCII. + * - The information about encoding and eol-translation is taken + * without change. There is no need to fiddle with + * refCount et. al. */ - chanPtr->encoding=Tcl_GetEncoding(interp,Tcl_GetEncodingName(pt->encoding)); - chanPtr->inputEncodingState = pt->inputEncodingState; - chanPtr->inputEncodingFlags = pt->inputEncodingFlags; - chanPtr->outputEncodingState = pt->outputEncodingState; - chanPtr->outputEncodingFlags = pt->outputEncodingFlags; + pt->flags = mask; - chanPtr->outputStage = NULL; + /* + * EDITORS NOTE: all the lines with "take it as is" should get + * deleted once this code has been debugged. + */ - if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) { - chanPtr->outputStage = (char *) - ckalloc((unsigned) (chanPtr->bufSize + 2)); - } + /* pt->encoding, take it as is */ + /* pt->inputEncodingState, take it as is */ + /* pt->inputEncodingFlags, take it as is */ + /* pt->outputEncodingState, take it as is */ + /* pt->outputEncodingFlags, take it as is */ - chanPtr->supercedes = (Channel*) prevChan; + /* pt->inputTranslation, take it as is */ + /* pt->outputTranslation, take it as is */ - chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1); - strcpy (chanPtr->channelName, pt->channelName); + /* + * No special EOF character, that condition is determined by the + * old channel + */ + + pt->inEofChar = 0; + pt->outEofChar = 0; + + pt->unreportedError = 0; /* No errors yet */ + pt->instanceData = instanceData; /* Transformation state */ + pt->typePtr = typePtr; /* Transformation type */ + /* pt->refCount, take it as it is */ + /* pt->closeCbPtr, take it as it is */ + + /* pt->outputStage, take it as it is */ + pt->curOutPtr = (ChannelBuffer *) NULL; + pt->outQueueHead = (ChannelBuffer *) NULL; + pt->outQueueTail = (ChannelBuffer *) NULL; + pt->saveInBufPtr = (ChannelBuffer *) NULL; + pt->inQueueHead = (ChannelBuffer *) NULL; + pt->inQueueTail = (ChannelBuffer *) NULL; + + /* pt->chPtr, take it as it is */ + /* pt->interestMask, take it as it is */ + /* pt->nextChanPtr, take it as it is */ + /* pt->scriptRecordPtr, take it as it is */ + pt->bufSize = CHANNELBUFFER_DEFAULT_SIZE; + /* pt->timer, take it as it is */ + /* pt->csPtr, take it as it is */ /* - * Link the new channel into the same spot in the per-interp - * channel list as the old channel was. + * Have the transformation reference the new structure containing + * the saved channel. */ - if (prevPt) { - prevPt->nextChanPtr = chanPtr; - } else { - tsdPtr->firstChanPtr = chanPtr; - } + pt->supercedes = chanPtr; + + /* + * Don't forget to reinitialize the output buffer used for encodings. + */ - chanPtr->nextChanPtr = pt->nextChanPtr; + if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) { + chanPtr->outputStage = (char *) + ckalloc((unsigned) (chanPtr->bufSize + 2)); + } /* - * The following call replaces the hash table mapping from name - * to channel with a pointer to the new channel. + * Event handling: If the information in the old channel shows + * that there was interest in some events call the 'WatchProc' + * of the transformation to establish the proper connection + * between them. */ - Tcl_RegisterChannel (interp, (Tcl_Channel) chanPtr); + if (pt->interestMask) { + int interest = pt->interestMask; + + pt->interestMask = 0; + (pt->typePtr->watchProc) (pt->instanceData, interest); + } /* * The superceded channel is effectively unregistered @@ -1518,7 +1612,6 @@ Tcl_ReplaceChannel(interp, typePtr, instanceData, mask, prevChan) * Don't add the following code: * * chanPtr->supercedes->refCount --; - * */ return (Tcl_Channel) chanPtr; @@ -1527,12 +1620,12 @@ Tcl_ReplaceChannel(interp, typePtr, instanceData, mask, prevChan) /* *---------------------------------------------------------------------- * - * Tcl_UndoReplaceChannel -- + * Tcl_UnstackChannel -- * * Unstacks an entry in the hash table for a Tcl_Channel - * record. This is the reverse to 'Tcl_ReplaceChannel'. + * record. This is the reverse to 'Tcl_StackChannel'. * The old, superceded channel is uncovered and re-registered - * in the appropriate datastructures. + * in the appropriate data structures. * * Results: * Returns the old Tcl_Channel, i.e. the one which was stacked over. @@ -1544,60 +1637,193 @@ Tcl_ReplaceChannel(interp, typePtr, instanceData, mask, prevChan) */ void -Tcl_UndoReplaceChannel (interp, chan) -Tcl_Interp* interp; /* The interpreter we are working in */ -Tcl_Channel chan; /* The channel to unstack */ +Tcl_UnstackChannel (interp, chan) + Tcl_Interp* interp; /* The interpreter we are working in */ + Tcl_Channel chan; /* The channel to unstack */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Channel* chanPtr = (Channel*) chan; if (chanPtr->supercedes != (Channel*) NULL) { - Tcl_HashTable *hTblPtr; /* Hash table of channels. */ - Tcl_HashEntry *hPtr; /* Search variable. */ - int new; /* Is the hash entry new or does it exist? */ + /* + * Instead of manipulating the per-thread / per-interp list/hashtable + * of registered channels we wind down the state of the transformation, + * and then restore the state of underlying channel into the old + * structure. + */ + + Tcl_DString ds; /* storage to copy option information */ + Channel top; /* Save area for current transformation */ + Channel* chanDownPtr = chanPtr->supercedes; + int interest; /* interest mask of transformation before destruct. */ /* - * Insert the channel we were stacked upon back into - * the list of open channels. Place it back into the hashtable too. - * Correct 'refCount', as this actually unregisters 'chan'. + * Event handling: Disallow the delivery of events from the + * old, now uncovered channel to the transformation. + * + * This is done before everything else to avoid problems + * after our heavy-duty shuffling of pointers around. */ - chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr; - tsdPtr->firstChanPtr = chanPtr->supercedes; + interest = chanPtr->interestMask; + (chanPtr->typePtr->watchProc) (chanPtr->instanceData, 0); + + /* + * Save the transformation, then restore the old channel from the + * first structure downstream. The overall effect is that + * transformation and underlying channel swapped places, and the + * transformation is cut loose from the stack. Without the latter + * a Tcl_Close on the transformation would be impossible, as that + * procedure will free the structure, making 'top' unusable. + * + * Beware, same information must not take part in the swap, + * use correction code to ensure this. + */ - hTblPtr = GetChannelTable (interp); - hPtr = Tcl_CreateHashEntry (hTblPtr, chanPtr->channelName, &new); + memcpy ((void*) &top, (void*) chanPtr, sizeof (Channel)); + memcpy ((void*) &chanPtr, (void*) chanDownPtr, sizeof (Channel)); + top.supercedes = (Channel*) NULL; + memcpy ((void*) &chanDownPtr, (void*) &top, sizeof (Channel)); + + chanPtr->refCount = chanDownPtr->refCount; + chanPtr->closeCbPtr = chanDownPtr->closeCbPtr; + chanPtr->chPtr = chanDownPtr->chPtr; + chanPtr->nextChanPtr = chanDownPtr->nextChanPtr; + chanPtr->scriptRecordPtr = chanDownPtr->scriptRecordPtr; + chanPtr->timer = chanDownPtr->timer; + chanPtr->csPtr = chanDownPtr->csPtr; + + chanDownPtr->refCount = 0; + chanDownPtr->closeCbPtr = (CloseCallback*) NULL; + chanDownPtr->chPtr = (ChannelHandler*) NULL; + chanDownPtr->nextChanPtr = (Channel*) NULL; + chanDownPtr->scriptRecordPtr = (EventScriptRecord*) NULL; + chanDownPtr->timer = (Tcl_TimerToken) NULL; + chanDownPtr->csPtr = (CopyState*) NULL; - Tcl_SetHashValue(hPtr, (ClientData) chanPtr->supercedes); - chanPtr->refCount --; + /* + * Now it is possible to wind down the transformation (in 'top'), + * especially to copy the current encoding and translation control + * information down. + */ + + /* + * Move the currently active encoding from the transformation + * to the now uncovered channel. We assume here that this + * channel uses 'encoding binary' (==> encoding == NULL, etc. + * This allows us to simply copy the pointers without having to + * think about refcounts and deallocation of the old encoding. + */ + + chanPtr->encoding = chanDownPtr->encoding; + chanPtr->inputEncodingState = chanDownPtr->inputEncodingState; + chanPtr->inputEncodingFlags = chanDownPtr->inputEncodingFlags; + chanPtr->outputEncodingState = chanDownPtr->outputEncodingState; + chanPtr->outputEncodingFlags = chanDownPtr->outputEncodingFlags; + + /* + * Prevent the accidential removal of the encoding during + * the destruction of the transformation channel. + */ + + chanDownPtr->encoding = (Tcl_Encoding) NULL; + chanDownPtr->inputEncodingState = (Tcl_EncodingState) NULL; + chanDownPtr->inputEncodingFlags = TCL_ENCODING_START; + chanDownPtr->outputEncodingState = (Tcl_EncodingState) NULL; + chanDownPtr->outputEncodingFlags = TCL_ENCODING_START; /* - * The superceded channel is effectively registered again - * Don't add the following code because we didn't - * decremented the reference count at replace time. + * And don't forget to reenable the EOL-translation used by the + * transformation. Using a DString to do this *is* a bit awkward, + * but still the best way to handle the complexities here, like + * flag manipulation and event system. + */ + + Tcl_DStringInit (&ds); + Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr, + "-translation", &ds); + Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr, + "-translation", ds.string); + + Tcl_DStringSetLength (&ds, 0); + + Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr, + "-buffering", &ds); + Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr, + "-buffering", ds.string); + + Tcl_DStringFree (&ds); + + /* + * Now a little trick: Add the transformation structure to the + * per-thread list of existing channels (which it never were + * part of so far), or Tcl_Close/FlushChannel will panic + * ("damaged channel list"). * - * chanPtr->supercedes->refCount ++; + * Afterward do a regular close upon the transformation. + * This may cause flushing of data into the old channel (if the + * transformation remembered its own channel in itself). * + * We know that its refCount dropped to 0. */ - } - /* - * Disconnect the channels, then do a regular close upon the - * stacked one, the filtering channel. This may cause flushing - * of data into the superceded channel (if the filtering channel - * ('chan') remembered its parent in itself). - */ + chanDownPtr->nextChanPtr = tsdPtr->firstChanPtr; + tsdPtr->firstChanPtr = chanDownPtr; + + Tcl_Close (interp, (Tcl_Channel)chanDownPtr); + + /* + * Event handling: If the information from the now destroyed + * transformation shows that there was interest in some events + * call the 'WatchProc' of the now uncovered channel to renew + * that interest with underlying channels or the driver. + */ - chanPtr->supercedes = NULL; + if (interest) { + chanPtr->interestMask = 0; + (chanPtr->typePtr->watchProc) (chanPtr->instanceData, + interest); + } + + } else { + /* This channel does not cover another one. + * Simply do a close, if necessary. + */ - if (chanPtr->refCount == 0) { - Tcl_Close (interp, chan); + if (chanPtr->refCount == 0) { + Tcl_Close (interp, chan); + } } } /* *---------------------------------------------------------------------- * + * Tcl_GetStackedChannel -- + * + * Determines wether the specified channel is stacked upon another. + * + * Results: + * NULL if the channel is not stacked upon another one, or a reference + * to the channel it is stacked upon. This reference can be used in + * queries, but modification is not allowed. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Channel +Tcl_GetStackedChannel(Tcl_Channel chan) +{ + Channel* chanPtr = (Channel*) chan; + return (Tcl_Channel) chanPtr->supercedes; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_GetChannelMode -- * * Computes a mask indicating whether the channel is open for @@ -7902,3 +8128,4 @@ SetBlockMode(interp, chanPtr, mode) } return TCL_OK; } + diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index d763023..0da46d6 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.21 1999/06/30 22:34:45 redman Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.22 1999/07/02 19:51:30 welch Exp $ */ #include "tclInt.h" @@ -665,9 +665,9 @@ TclStubs tclStubs = { #endif /* MAC_TCL */ Tcl_GetVersion, /* 279 */ Tcl_InitMemory, /* 280 */ - Tcl_ReplaceChannel, /* 281 */ - Tcl_UndoReplaceChannel, /* 282 */ - NULL, /* 283 */ + Tcl_StackChannel, /* 281 */ + Tcl_UnstackChannel, /* 282 */ + Tcl_GetStackedChannel, /* 283 */ NULL, /* 284 */ NULL, /* 285 */ Tcl_AppendObjToObj, /* 286 */ -- cgit v0.12