1*** tcl.h.orig Fri Oct 23 23:21:39 1998 2--- tcl.h Sun Mar 14 16:31:36 1999 3*************** 4*** 1547,1552 **** 5--- 1547,1574 ---- 6 EXTERN void Tcl_WrongNumArgs _ANSI_ARGS_((Tcl_Interp *interp, 7 int objc, Tcl_Obj *CONST objv[], char *message)); 8 9+ /* Andreas Kupries <a.kupries@westend.com>, 05/31/1997. 10+ * "Trf-Patch for filtering channels" 11+ * 12+ * C-Level API for (un)stacking of channels. This allows the introduction 13+ * of filtering channels with relatively little changes to the core. 14+ * This patch was created in cooperation with Jan Nijtmans <nijtmans@wxs.nl> 15+ * and is therefore part of his plus-patches too. 16+ * 17+ * It would have been possible to place the following definitions according 18+ * to the alphabetical order used elsewhere in this file, but I decided 19+ * against that to ease the maintenance of the patch across new tcl versions 20+ * (patch usually has no problems to integrate the patch file for the last 21+ * version into the new one). 22+ */ 23+ 24+ EXTERN Tcl_Channel Tcl_ReplaceChannel _ANSI_ARGS_ ((Tcl_Interp* interp, 25+ Tcl_ChannelType* typePtr, ClientData instanceData, 26+ int mask, Tcl_Channel prevChan)); 27+ 28+ EXTERN void Tcl_UndoReplaceChannel _ANSI_ARGS_ ((Tcl_Interp* interp, 29+ Tcl_Channel chan)); 30+ 31 #endif /* RESOURCE_INCLUDED */ 32 33 #undef TCL_STORAGE_CLASS 34*** tclIO.c.orig Fri Oct 30 01:38:38 1998 35--- tclIO.c Sun Mar 14 16:35:19 1999 36*************** 37*** 170,175 **** 38--- 170,197 ---- 39 int bufSize; /* What size buffers to allocate? */ 40 Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */ 41 CopyState *csPtr; /* State of background copy, or NULL. */ 42+ 43+ 44+ /* Andreas Kupries <a.kupries@westend.com>, 05/31/1997. 45+ * "Trf-Patch for filtering channels" 46+ * 47+ * The single change to the internal datastructures of the core. Every 48+ * channel now maintains a reference to the channel he is stacked upon. 49+ * This reference is NULL for normal channels. Only the two exported 50+ * procedures (Tcl_ReplaceChannel and Tcl_UndoReplaceChannel, see at the 51+ * end of 'tcl.h') use this field in a non-trivial way. 52+ * 53+ * Of the existing procedures the only following are affected by this 54+ * change: 55+ * 56+ * - Tcl_RegisterChannel 57+ * - Tcl_CreateChannel 58+ * - CloseChannel 59+ * 60+ * The why is explained at the changed locations. 61+ */ 62+ struct Channel* supercedes; /* Refers to channel this one was stacked upon */ 63+ 64 } Channel; 65 66 /* 67*************** 68*** 1067,1073 **** 69 if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) { 70 return; 71 } 72! panic("Tcl_RegisterChannel: duplicate channel names"); 73 } 74 Tcl_SetHashValue(hPtr, (ClientData) chanPtr); 75 } 76--- 1089,1108 ---- 77 if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) { 78 return; 79 } 80! /* Andreas Kupries <a.kupries@westend.com>, 05/31/1997. 81! * "Trf-Patch for filtering channels" 82! * 83! * This is the change to 'Tcl_RegisterChannel'. 84! * 85! * Explanation: 86! * The moment a channel is stacked upon another he 87! * takes the identity of the channel he supercedes, 88! * i.e. he gets the *same* name. Because of this we 89! * cannot check for duplicate names anymore, they 90! * have to be allowed now. 91! */ 92! 93! /* panic("Tcl_RegisterChannel: duplicate channel names"); */ 94 } 95 Tcl_SetHashValue(hPtr, (ClientData) chanPtr); 96 } 97*************** 98*** 1218,1223 **** 99--- 1253,1272 ---- 100 chanPtr->timer = NULL; 101 chanPtr->csPtr = NULL; 102 103+ /* Andreas Kupries <a.kupries@westend.com>, 05/31/1997. 104+ * "Trf-Patch for filtering channels" 105+ * 106+ * This is the change to 'Tcl_CreateChannel'. 107+ * 108+ * Explanation: 109+ * It is of course necessary to initialize the new field 110+ * in the Channel structure. The chosen value indicates 111+ * that the created channel is a normal one, and not 112+ * stacked upon another. 113+ */ 114+ 115+ chanPtr->supercedes = (Channel*) NULL; 116+ 117 /* 118 * Link the channel into the list of all channels; create an on-exit 119 * handler if there is not one already, to close off all the channels 120*************** 121*** 1250,1255 **** 122--- 1299,1490 ---- 123 return (Tcl_Channel) chanPtr; 124 } 125 126+ /* Andreas Kupries <a.kupries@westend.com>, 05/31/1997. 127+ * "Trf-Patch for filtering channels" 128+ * 129+ * The following two procedures are the new, exported ones. They 130+ * - create a channel stacked upon an existing one and 131+ * - pop a stacked channel off, thus revealing the superceded one. 132+ * 133+ * Please read the following completely. 134+ */ 135+ /* 136+ *---------------------------------------------------------------------- 137+ * 138+ * Tcl_ReplaceChannel -- 139+ * 140+ * Replaces an entry in the hash table for a Tcl_Channel 141+ * record. 142+ * 143+ * Results: 144+ * Returns the new Tcl_Channel. 145+ * 146+ * Side effects: 147+ * Replaces a Tcl_Channel instance into the hash table. 148+ * 149+ *---------------------------------------------------------------------- 150+ */ 151+ 152+ Tcl_Channel 153+ Tcl_ReplaceChannel(interp, typePtr, instanceData, mask, prevChan) 154+ Tcl_Interp* interp; /* the interpreter we are working in */ 155+ Tcl_ChannelType *typePtr; /* The channel type record. */ 156+ ClientData instanceData; /* Instance specific data. */ 157+ int mask; /* TCL_READABLE & TCL_WRITABLE to indicate 158+ * if the channel is readable, writable. */ 159+ Tcl_Channel prevChan; /* The channel structure that should 160+ * be replaced. */ 161+ { 162+ Channel *chanPtr, *pt, *prevPt; 163+ 164+ /* 165+ * Replace the channel into the list of all channels; 166+ */ 167+ 168+ prevPt = (Channel*) NULL; 169+ pt = (Channel*) firstChanPtr; 170+ 171+ while (pt != (Channel *) prevChan) { 172+ prevPt = pt; 173+ pt = pt->nextChanPtr; 174+ } 175+ 176+ if (!pt) { 177+ return (Tcl_Channel) NULL; 178+ } 179+ 180+ /* 181+ * Here we check if the "mask" matches the "flags" 182+ * of the already existing channel. 183+ * 184+ * | - | R | W | RW | 185+ * --+---+---+---+----+ <=> 0 != (chan->mask & prevChan->mask) 186+ * - | | | | | 187+ * R | | + | | + | The superceding channel is allowed to 188+ * W | | | + | + | restrict the capabilities of the 189+ * RW| | + | + | + | superceded one ! 190+ * --+---+---+---+----+ 191+ */ 192+ 193+ if ((mask & Tcl_GetChannelMode (prevChan)) == 0) { 194+ return (Tcl_Channel) NULL; 195+ } 196+ 197+ 198+ chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel)); 199+ chanPtr->flags = mask; 200+ 201+ /* 202+ * Set the channel up initially in no Input translation mode and 203+ * no Output translation mode. 204+ */ 205+ 206+ chanPtr->inputTranslation = TCL_TRANSLATE_LF; 207+ chanPtr->outputTranslation = TCL_TRANSLATE_LF; 208+ chanPtr->inEofChar = 0; 209+ chanPtr->outEofChar = 0; 210+ 211+ chanPtr->unreportedError = 0; 212+ chanPtr->instanceData = instanceData; 213+ chanPtr->typePtr = typePtr; 214+ chanPtr->refCount = 0; 215+ chanPtr->closeCbPtr = (CloseCallback *) NULL; 216+ chanPtr->curOutPtr = (ChannelBuffer *) NULL; 217+ chanPtr->outQueueHead = (ChannelBuffer *) NULL; 218+ chanPtr->outQueueTail = (ChannelBuffer *) NULL; 219+ chanPtr->saveInBufPtr = (ChannelBuffer *) NULL; 220+ chanPtr->inQueueHead = (ChannelBuffer *) NULL; 221+ chanPtr->inQueueTail = (ChannelBuffer *) NULL; 222+ chanPtr->chPtr = (ChannelHandler *) NULL; 223+ chanPtr->interestMask = 0; 224+ chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL; 225+ chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; 226+ chanPtr->timer = NULL; 227+ chanPtr->csPtr = NULL; 228+ 229+ chanPtr->supercedes = (Channel*) prevChan; 230+ 231+ chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1); 232+ strcpy (chanPtr->channelName, pt->channelName); 233+ 234+ if (prevPt) { 235+ prevPt->nextChanPtr = chanPtr; 236+ } else { 237+ firstChanPtr = chanPtr; 238+ } 239+ 240+ chanPtr->nextChanPtr = pt->nextChanPtr; 241+ 242+ 243+ Tcl_RegisterChannel (interp, (Tcl_Channel) chanPtr); 244+ 245+ /* The superceded channel is effectively unregistered */ 246+ /*chanPtr->supercedes->refCount --;*/ 247+ 248+ return (Tcl_Channel) chanPtr; 249+ } 250+ 251+ /* 252+ *---------------------------------------------------------------------- 253+ * 254+ * Tcl_UndoReplaceChannel -- 255+ * 256+ * Unstacks an entry in the hash table for a Tcl_Channel 257+ * record. 258+ * 259+ * Results: 260+ * Returns the old Tcl_Channel, i.e. the one which was stacked over. 261+ * 262+ * Side effects: 263+ * Replaces a Tcl_Channel instance into the hash table. 264+ * 265+ *---------------------------------------------------------------------- 266+ */ 267+ 268+ void 269+ Tcl_UndoReplaceChannel (interp, chan) 270+ Tcl_Interp* interp; /* The interpreter we are working in */ 271+ Tcl_Channel chan; /* The channel to unstack */ 272+ { 273+ Channel* chanPtr = (Channel*) chan; 274+ 275+ if (chanPtr->supercedes != (Channel*) NULL) { 276+ Tcl_HashTable *hTblPtr; /* Hash table of channels. */ 277+ Tcl_HashEntry *hPtr; /* Search variable. */ 278+ int new; /* Is the hash entry new or does it exist? */ 279+ 280+ /* 281+ * Insert the channel we were stacked upon back into 282+ * the list of open channels. Place it back into the hashtable too. 283+ * Correct 'refCount', as this actually unregisters 'chan'. 284+ */ 285+ 286+ chanPtr->supercedes->nextChanPtr = firstChanPtr; 287+ firstChanPtr = chanPtr->supercedes; 288+ 289+ hTblPtr = GetChannelTable (interp); 290+ hPtr = Tcl_CreateHashEntry (hTblPtr, chanPtr->channelName, &new); 291+ 292+ Tcl_SetHashValue(hPtr, (ClientData) chanPtr->supercedes); 293+ chanPtr->refCount --; 294+ 295+ /* The superceded channel is effectively registered again */ 296+ /*chanPtr->supercedes->refCount ++;*/ 297+ } 298+ 299+ /* 300+ * Disconnect the channels, then do a regular close upon the 301+ * stacked one. This may cause flushing of data into the 302+ * superceded channel (if 'chan' remembered its parent in itself). 303+ */ 304+ 305+ chanPtr->supercedes = NULL; 306+ 307+ if (chanPtr->refCount == 0) { 308+ Tcl_Close (interp, chan); 309+ } 310+ } 311+ 312 /* 313 *---------------------------------------------------------------------- 314 * 315*************** 316*** 1863,1868 **** 317--- 2098,2138 ---- 318 if (errorCode != 0) { 319 Tcl_SetErrno(errorCode); 320 } 321+ } 322+ 323+ /* Andreas Kupries <a.kupries@westend.com>, 05/31/1997. 324+ * "Trf-Patch for filtering channels" 325+ * 326+ * This is the change to 'CloseChannel'. 327+ * 328+ * Explanation 329+ * Closing a filtering channel closes the one it 330+ * superceded too. This basically ripples through 331+ * the whole chain of filters until it reaches 332+ * the underlying normal channel. 333+ * 334+ * This is done by reintegrating the superceded 335+ * channel into the (thread) global list of open 336+ * channels and then invoking a regular close. 337+ * There is no need to handle the complexities of 338+ * this process by ourselves. 339+ * 340+ * *Note* 341+ * This has to be done after the call to the 342+ * 'closeProc' of the filtering channel to allow 343+ * that one the flushing of internal buffers into 344+ * the underlying channel. 345+ */ 346+ 347+ if (chanPtr->supercedes != (Channel*) NULL) { 348+ /* Insert the channel we were stacked upon back into 349+ * the list of open channels, then do a regular close. 350+ */ 351+ 352+ chanPtr->supercedes->nextChanPtr = firstChanPtr; 353+ firstChanPtr = chanPtr->supercedes; 354+ chanPtr->supercedes->refCount --; /* is deregistered */ 355+ Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes); 356 } 357 358 /* 359