Initial version of the Tcl_ReplaceChannel and Tcl_UndoReplaceChannel

functions.

5 files changed, 371 insertions, 18 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index ebe7f34..da93b29 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.17 1999/06/17 19:32:14 stanton Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.18 1999/06/30 17:47:27 welch Exp $
 
 library tcl
 
@@ -967,11 +967,30 @@ declare 280 generic {
     void Tcl_InitMemory(Tcl_Interp *interp)
 }
 
+# Andreas Kupries <a.kupries@westend.com>, 03/21/1999
+# "Trf-Patch for filtering channels"
+#
+# C-Level API for (un)stacking of channels. This allows the introduction
+# of filtering channels with relatively little changes to the core.
+# This patch was created in cooperation with Jan Nijtmans <nijtmans@wxs.nl>
+# and is therefore part of his plus-patches too.
+#
+# It would have been possible to place the following definitions according
+# to the alphabetical order used elsewhere in this file, but I decided
+# against that to ease the maintenance of the patch across new tcl versions
+# (patch usually has no problems to integrate the patch file for the last
+# version into the new one).
+
+declare 281 generic {
+    Tcl_Channel Tcl_ReplaceChannel(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)
+}
+
 # Reserved for future use (8.0.x vs. 8.1)
-#  declare 281 generic {
-#  }
-#  declare 282 generic {
-#  }
 #  declare 283 generic {
 #  }
 #  declare 284 generic {
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 0b755fe..835f858 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.17 1999/06/17 19:32:15 stanton Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.18 1999/06/30 17:47:28 welch Exp $
  */
 
 #ifndef _TCLDECLS
@@ -903,8 +903,14 @@ EXTERN void		Tcl_GetVersion _ANSI_ARGS_((int * major, int * minor,
 				int * patchLevel, int * type));
 /* 280 */
 EXTERN void		Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp * interp));
-/* Slot 281 is reserved */
-/* Slot 282 is reserved */
+/* 281 */
+EXTERN Tcl_Channel	Tcl_ReplaceChannel _ANSI_ARGS_((Tcl_Interp * interp, 
+				Tcl_ChannelType * typePtr, 
+				ClientData instanceData, int mask, 
+				Tcl_Channel prevChan));
+/* 282 */
+EXTERN void		Tcl_UndoReplaceChannel _ANSI_ARGS_((
+				Tcl_Interp * interp, Tcl_Channel chan));
 /* Slot 283 is reserved */
 /* Slot 284 is reserved */
 /* Slot 285 is reserved */
@@ -1546,8 +1552,8 @@ typedef struct TclStubs {
 #endif /* MAC_TCL */
     void (*tcl_GetVersion) _ANSI_ARGS_((int * major, int * minor, int * patchLevel, int * type)); /* 279 */
     void (*tcl_InitMemory) _ANSI_ARGS_((Tcl_Interp * interp)); /* 280 */
-    void *reserved281;
-    void *reserved282;
+    Tcl_Channel (*tcl_ReplaceChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_ChannelType * typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan)); /* 281 */
+    void (*tcl_UndoReplaceChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 282 */
     void *reserved283;
     void *reserved284;
     void *reserved285;
@@ -2826,8 +2832,14 @@ extern TclStubs *tclStubsPtr;
 #define Tcl_InitMemory \
 	(tclStubsPtr->tcl_InitMemory) /* 280 */
 #endif
-/* Slot 281 is reserved */
-/* Slot 282 is reserved */
+#ifndef Tcl_ReplaceChannel
+#define Tcl_ReplaceChannel \
+	(tclStubsPtr->tcl_ReplaceChannel) /* 281 */
+#endif
+#ifndef Tcl_UndoReplaceChannel
+#define Tcl_UndoReplaceChannel \
+	(tclStubsPtr->tcl_UndoReplaceChannel) /* 282 */
+#endif
 /* Slot 283 is reserved */
 /* Slot 284 is reserved */
 /* Slot 285 is reserved */
diff --git a/generic/tclIO.c b/generic/tclIO.c
index bc8db94..f9e7db6 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.8 1999/05/18 20:17:59 hershey Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.9 1999/06/30 17:47:28 welch Exp $
  */
 
 #include "tclInt.h"
@@ -202,6 +202,10 @@ typedef struct Channel {
     int bufSize;		/* What size buffers to allocate? */
     Tcl_TimerToken timer;	/* Handle to wakeup timer for this 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. */
+
 } Channel;
     
 /*
@@ -1038,7 +1042,21 @@ Tcl_RegisterChannel(interp, chan)
             if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
                 return;
             }
-            panic("Tcl_RegisterChannel: duplicate channel names");
+
+	    /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998
+	     * "Trf-Patch for filtering channels"
+	     *
+	     * This is the change to 'Tcl_RegisterChannel'.
+	     *
+	     * Explanation:
+	     *		The moment a channel is stacked upon another he
+	     *		takes the identity of the channel he supercedes,
+	     *		i.e. he gets the *same* name. Because of this we
+	     *		cannot check for duplicate names anymore, they
+	     *		have to be allowed now.
+	     */
+
+	    /* panic("Tcl_RegisterChannel: duplicate channel names"); */
         }
         Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
     }
@@ -1296,6 +1314,7 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
     chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
     chanPtr->timer = NULL;
     chanPtr->csPtr = NULL;
+    chanPtr->supercedes = (Channel*) NULL;
 
     chanPtr->outputStage = NULL;
     if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
@@ -1333,6 +1352,252 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_ReplaceChannel --
+ *
+ *	Replaces an entry in the hash table for a Tcl_Channel
+ *	record. The replacement is a new channel with same name,
+ *	it supercedes the replaced channel. Input and output of
+ *	the superceded channel is now going through the newly
+ *	created channel and allows the arbitrary filtering/manipulation
+ *	of the dataflow.
+ *
+ *	Andreas Kupries <a.kupries@westend.com>, 12/13/1998
+ *	"Trf-Patch for filtering channels"
+ *
+ * Results:
+ *	Returns the new Tcl_Channel.
+ *
+ * Side effects:
+ *	See above.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_ReplaceChannel(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. */
+    ClientData       instanceData; /* Instance specific data for the new
+				    * channel. */
+    int              mask;	   /* TCL_READABLE & TCL_WRITABLE to indicate
+				    * if the channel is readable, writable. */
+    Tcl_Channel      prevChan;	   /* The channel structure to replace */
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    Channel            *chanPtr, *pt, *prevPt;
+
+    /*
+     * Find the given channel in the list of all channels, compute enough
+     * information to allow easy removal after the conditions are met.
+     */
+
+    prevPt = (Channel*) NULL;
+    pt     = (Channel*) tsdPtr->firstChanPtr;
+
+    while (pt != (Channel *) prevChan) {
+	prevPt = pt;
+	pt     = pt->nextChanPtr;
+    }
+
+    /*
+     * 'pt == prevChan' now
+     */
+
+    if (!pt) {
+	return (Tcl_Channel) NULL;
+    }
+
+    /*
+     * Here we check if the given "mask" matches the "flags"
+     * of the already existing channel.
+     *
+     *	  | - | R | W | RW |
+     *	--+---+---+---+----+	<=>  0 != (chan->mask & prevChan->mask)
+     *	- |   |   |   |    |
+     *	R |   | + |   | +  |	The superceding channel is allowed to
+     *	W |   |   | + | +  |	restrict the capabilities of the
+     *	RW|   | + | + | +  |	superceded one !
+     *	--+---+---+---+----+
+     */
+
+    if ((mask & Tcl_GetChannelMode (prevChan)) == 0) {
+	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.
+     */
+
+    chanPtr->inputTranslation = TCL_TRANSLATE_LF;
+    chanPtr->outputTranslation = TCL_TRANSLATE_LF;
+    chanPtr->inEofChar = 0;
+    chanPtr->outEofChar = 0;
+
+    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;
+
+    /* 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.
+     *
+     * [*] I'm talking about the conversion between UNICODE and other
+     *     representations, like ASCII.
+     */
+
+    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;
+
+    chanPtr->outputStage = NULL;
+
+    if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
+    chanPtr->outputStage = (char *)
+	ckalloc((unsigned) (chanPtr->bufSize + 2));
+    }
+
+    chanPtr->supercedes = (Channel*) prevChan;
+
+    chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1);
+    strcpy (chanPtr->channelName, pt->channelName);
+
+    /*
+     * Link the new channel into the same spot in the per-interp
+     * channel list as the old channel was.
+     */
+
+    if (prevPt) {
+	prevPt->nextChanPtr = chanPtr;
+    } else {
+	tsdPtr->firstChanPtr = chanPtr;
+    }
+
+    chanPtr->nextChanPtr = pt->nextChanPtr;
+
+    /*
+     * The following call replaces the hash table mapping from name
+     * to channel with a pointer to the new channel.
+     */
+
+    Tcl_RegisterChannel (interp, (Tcl_Channel) chanPtr);
+
+    /*
+     * The superceded channel is effectively unregistered
+     * We cannot decrement its reference count because that
+     * can cause it to get garbage collected out from under us.
+     * Don't add the following code:
+     *
+     * chanPtr->supercedes->refCount --;
+     *
+     */
+
+    return (Tcl_Channel) chanPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UndoReplaceChannel --
+ *
+ *	Unstacks an entry in the hash table for a Tcl_Channel
+ *	record. This is the reverse to 'Tcl_ReplaceChannel'.
+ *	The old, superceded channel is uncovered and re-registered
+ *	in the appropriate datastructures.
+ *
+ * Results:
+ *	Returns the old Tcl_Channel, i.e. the one which was stacked over.
+ *
+ * Side effects:
+ *	See above.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_UndoReplaceChannel (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? */
+
+	/*
+	 * 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'.
+	 */
+
+	chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr;
+	tsdPtr->firstChanPtr             = chanPtr->supercedes;
+
+	hTblPtr = GetChannelTable (interp);
+	hPtr    = Tcl_CreateHashEntry (hTblPtr, chanPtr->channelName, &new);
+
+	Tcl_SetHashValue(hPtr, (ClientData) chanPtr->supercedes);
+	chanPtr->refCount --;
+
+	/*
+	 * The superceded channel is effectively registered again
+	 * Don't add the following code because we didn't
+	 * decremented the reference count at replace time.
+	 *
+	 * chanPtr->supercedes->refCount ++;
+	 *
+	 */
+    }
+
+    /*
+     * 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).
+     */
+
+    chanPtr->supercedes = NULL;
+
+    if (chanPtr->refCount == 0) {
+	Tcl_Close (interp, chan);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_GetChannelMode --
  *
  *	Computes a mask indicating whether the channel is open for
@@ -2005,6 +2270,42 @@ CloseChannel(interp, chanPtr, errorCode)
         }
     }
 
+    /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998
+     * "Trf-Patch for filtering channels"
+     *
+     * This is the change to 'CloseChannel'.
+     *
+     * Explanation
+     *		Closing a filtering channel closes the one it
+     *		superceded too. This basically ripples through
+     *		the whole chain of filters until it reaches
+     *		the underlying normal channel.
+     *
+     *		This is done by reintegrating the superceded
+     *		channel into the (thread) global list of open
+     *		channels and then invoking a regular close.
+     *		There is no need to handle the complexities of
+     *		this process by ourselves.
+     *
+     *		*Note*
+     *		This has to be done after the call to the
+     *		'closeProc' of the filtering channel to allow
+     *		that one to flush internal buffers into
+     *		the underlying channel.
+     */
+
+    if (chanPtr->supercedes != (Channel*) NULL) {
+	/*
+	 * Insert the channel we were stacked upon back into
+	 * the list of open channels, then do a regular close.
+	 */
+
+	chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr;
+	tsdPtr->firstChanPtr             = chanPtr->supercedes;
+	chanPtr->supercedes->refCount --; /* is deregistered */
+	Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes);
+    }
+
     /*
      * Cancel any outstanding timer.
      */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 8b824cc..fc491f7 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.19 1999/06/17 19:32:15 stanton Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.20 1999/06/30 17:47:28 welch Exp $
  */
 
 #include "tclInt.h"
@@ -661,8 +661,8 @@ TclStubs tclStubs = {
 #endif /* MAC_TCL */
     Tcl_GetVersion, /* 279 */
     Tcl_InitMemory, /* 280 */
-    NULL, /* 281 */
-    NULL, /* 282 */
+    Tcl_ReplaceChannel, /* 281 */
+    Tcl_UndoReplaceChannel, /* 282 */
     NULL, /* 283 */
     NULL, /* 284 */
     NULL, /* 285 */
diff --git a/generic/tclStubs.c b/generic/tclStubs.c
index 21ebe06..0194243 100644
--- a/generic/tclStubs.c
+++ b/generic/tclStubs.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStubs.c,v 1.7 1999/04/16 00:46:53 stanton Exp $
+ * RCS: @(#) $Id: tclStubs.c,v 1.8 1999/06/30 17:47:29 welch Exp $
  */
 
 #include "tcl.h"
@@ -3263,5 +3263,26 @@ Tcl_ServiceModeHook(mode)
     (tclStubsPtr->tcl_ServiceModeHook)(mode);
 }
 
+/* Slot 345 */
+Tcl_Channel
+Tcl_ReplaceChannel(interp, typePtr, instanceData, mask, prevChan)
+    Tcl_Interp * interp;
+    Tcl_ChannelType * typePtr;
+    ClientData instanceData;
+    int mask;
+    Tcl_Channel prevChan;
+{
+    return (tclStubsPtr->tcl_ReplaceChannel)(interp, typePtr, instanceData, mask, prevChan);
+}
+
+/* Slot 346 */
+void
+Tcl_UndoReplaceChannel(interp, chan)
+    Tcl_Interp * interp;
+    Tcl_Channel chan;
+{
+    (tclStubsPtr->tcl_UndoReplaceChannel)(interp, chan);
+}
+
 
 /* !END!: Do not edit above this line. */