1*** ./tcl.decls.orig Fri May 7 20:30:02 1999 2--- ./tcl.decls Fri May 7 20:33:35 1999 3*************** 4*** 967,977 **** 5 void Tcl_InitMemory(Tcl_Interp *interp) 6 } 7 8 # Reserved for future use (8.0.x vs. 8.1) 9- # declare 281 generic { 10- # } 11- # declare 282 generic { 12- # } 13 # declare 283 generic { 14 # } 15 # declare 284 generic { 16--- 967,996 ---- 17 void Tcl_InitMemory(Tcl_Interp *interp) 18 } 19 20+ # Andreas Kupries <a.kupries@westend.com>, 03/21/1999 21+ # "Trf-Patch for filtering channels" 22+ # 23+ # C-Level API for (un)stacking of channels. This allows the introduction 24+ # of filtering channels with relatively little changes to the core. 25+ # This patch was created in cooperation with Jan Nijtmans <nijtmans@wxs.nl> 26+ # and is therefore part of his plus-patches too. 27+ # 28+ # It would have been possible to place the following definitions according 29+ # to the alphabetical order used elsewhere in this file, but I decided 30+ # against that to ease the maintenance of the patch across new tcl versions 31+ # (patch usually has no problems to integrate the patch file for the last 32+ # version into the new one). 33+ 34+ declare 281 generic { 35+ Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, \ 36+ Tcl_ChannelType *typePtr, ClientData instanceData, \ 37+ int mask, Tcl_Channel prevChan) 38+ } 39+ declare 282 generic { 40+ void Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan) 41+ } 42+ 43 # Reserved for future use (8.0.x vs. 8.1) 44 # declare 283 generic { 45 # } 46 # declare 284 generic { 47*** ./tclDecls.h.orig Fri May 7 20:30:02 1999 48--- ./tclDecls.h Fri May 7 20:33:35 1999 49*************** 50*** 875,882 **** 51 int * patchLevel, int * type)); 52 /* 280 */ 53 EXTERN void Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp * interp)); 54! /* Slot 281 is reserved */ 55! /* Slot 282 is reserved */ 56 /* Slot 283 is reserved */ 57 /* Slot 284 is reserved */ 58 /* Slot 285 is reserved */ 59--- 875,888 ---- 60 int * patchLevel, int * type)); 61 /* 280 */ 62 EXTERN void Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp * interp)); 63! /* 281 */ 64! EXTERN Tcl_Channel Tcl_StackChannel _ANSI_ARGS_((Tcl_Interp * interp, 65! Tcl_ChannelType * typePtr, 66! ClientData instanceData, int mask, 67! Tcl_Channel prevChan)); 68! /* 282 */ 69! EXTERN void Tcl_UnstackChannel _ANSI_ARGS_(( 70! Tcl_Interp * interp, Tcl_Channel chan)); 71 /* Slot 283 is reserved */ 72 /* Slot 284 is reserved */ 73 /* Slot 285 is reserved */ 74*************** 75*** 1439,1446 **** 76 void (*tcl_PanicVA) _ANSI_ARGS_((char * format, va_list argList)); /* 278 */ 77 void (*tcl_GetVersion) _ANSI_ARGS_((int * major, int * minor, int * patchLevel, int * type)); /* 279 */ 78 void (*tcl_InitMemory) _ANSI_ARGS_((Tcl_Interp * interp)); /* 280 */ 79! void *reserved281; 80! void *reserved282; 81 void *reserved283; 82 void *reserved284; 83 void *reserved285; 84--- 1445,1452 ---- 85 void (*tcl_PanicVA) _ANSI_ARGS_((char * format, va_list argList)); /* 278 */ 86 void (*tcl_GetVersion) _ANSI_ARGS_((int * major, int * minor, int * patchLevel, int * type)); /* 279 */ 87 void (*tcl_InitMemory) _ANSI_ARGS_((Tcl_Interp * interp)); /* 280 */ 88! Tcl_Channel (*tcl_StackChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_ChannelType * typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan)); /* 281 */ 89! void (*tcl_UnstackChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 282 */ 90 void *reserved283; 91 void *reserved284; 92 void *reserved285; 93*************** 94*** 2670,2677 **** 95 #define Tcl_InitMemory \ 96 (tclStubsPtr->tcl_InitMemory) /* 280 */ 97 #endif 98! /* Slot 281 is reserved */ 99! /* Slot 282 is reserved */ 100 /* Slot 283 is reserved */ 101 /* Slot 284 is reserved */ 102 /* Slot 285 is reserved */ 103--- 2676,2689 ---- 104 #define Tcl_InitMemory \ 105 (tclStubsPtr->tcl_InitMemory) /* 280 */ 106 #endif 107! #ifndef Tcl_StackChannel 108! #define Tcl_StackChannel \ 109! (tclStubsPtr->tcl_StackChannel) /* 281 */ 110! #endif 111! #ifndef Tcl_UnstackChannel 112! #define Tcl_UnstackChannel \ 113! (tclStubsPtr->tcl_UnstackChannel) /* 282 */ 114! #endif 115 /* Slot 283 is reserved */ 116 /* Slot 284 is reserved */ 117 /* Slot 285 is reserved */ 118*** ./tclIO.c.orig Fri May 7 20:30:02 1999 119--- ./tclIO.c Fri May 7 20:33:35 1999 120*************** 121*** 202,207 **** 122--- 202,229 ---- 123 int bufSize; /* What size buffers to allocate? */ 124 Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */ 125 CopyState *csPtr; /* State of background copy, or NULL. */ 126+ 127+ /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998 128+ * "Trf-Patch for filtering channels" 129+ * 130+ * The single change to the internal datastructures of the core. Every 131+ * channel now maintains a reference to the channel he is stacked upon. 132+ * This reference is NULL for normal channels. Only the two exported 133+ * procedures (Tcl_StackChannel and Tcl_UnstackChannel, see at the 134+ * end of 'tcl.h') use this field in a non-trivial way. 135+ * 136+ * Of the existing procedures the only following are affected by this 137+ * change: 138+ * 139+ * - Tcl_RegisterChannel 140+ * - Tcl_CreateChannel 141+ * - CloseChannel 142+ * 143+ * The why is explained at the changed locations. 144+ */ 145+ 146+ struct Channel* supercedes; /* Refers to channel this one was stacked upon */ 147+ 148 } Channel; 149 150 /* 151*************** 152*** 1038,1044 **** 153 if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) { 154 return; 155 } 156! panic("Tcl_RegisterChannel: duplicate channel names"); 157 } 158 Tcl_SetHashValue(hPtr, (ClientData) chanPtr); 159 } 160--- 1060,1080 ---- 161 if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) { 162 return; 163 } 164! 165! /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998 166! * "Trf-Patch for filtering channels" 167! * 168! * This is the change to 'Tcl_RegisterChannel'. 169! * 170! * Explanation: 171! * The moment a channel is stacked upon another he 172! * takes the identity of the channel he supercedes, 173! * i.e. he gets the *same* name. Because of this we 174! * cannot check for duplicate names anymore, they 175! * have to be allowed now. 176! */ 177! 178! /* panic("Tcl_RegisterChannel: duplicate channel names"); */ 179 } 180 Tcl_SetHashValue(hPtr, (ClientData) chanPtr); 181 } 182*************** 183*** 1297,1302 **** 184--- 1333,1352 ---- 185 chanPtr->timer = NULL; 186 chanPtr->csPtr = NULL; 187 188+ /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998 189+ * "Trf-Patch for filtering channels" 190+ * 191+ * This is the change to 'Tcl_CreateChannel'. 192+ * 193+ * Explanation: 194+ * It is of course necessary to initialize the new field 195+ * in the Channel structure. The chosen value indicates 196+ * that the created channel is a normal one, and not 197+ * stacked upon another. 198+ */ 199+ 200+ chanPtr->supercedes = (Channel*) NULL; 201+ 202 chanPtr->outputStage = NULL; 203 if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) { 204 chanPtr->outputStage = (char *) 205*************** 206*** 1330,1335 **** 207--- 1380,1622 ---- 208 return (Tcl_Channel) chanPtr; 209 } 210 211+ /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998 212+ * "Trf-Patch for filtering channels" 213+ * 214+ * The following two procedures are the new, exported ones. They 215+ * - create a channel stacked upon an existing one and 216+ * - pop a stacked channel off, thus revealing the superceded one. 217+ * 218+ * Please read the following completely. 219+ */ 220+ 221+ /* 222+ *---------------------------------------------------------------------- 223+ * 224+ * Tcl_StackChannel -- 225+ * 226+ * Replaces an entry in the hash table for a Tcl_Channel 227+ * record. The replacement is a new channel with same name, 228+ * it supercedes the replaced channel. Input and output of 229+ * the superceded channel is now going through the newly 230+ * created channel and allows the arbitrary filtering/manipulation 231+ * of the dataflow. 232+ * 233+ * Results: 234+ * Returns the new Tcl_Channel. 235+ * 236+ * Side effects: 237+ * See above. 238+ * 239+ *---------------------------------------------------------------------- 240+ */ 241+ 242+ Tcl_Channel 243+ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan) 244+ Tcl_Interp* interp; /* The interpreter we are working in */ 245+ Tcl_ChannelType *typePtr; /* The channel type record for the new 246+ * channel. */ 247+ ClientData instanceData; /* Instance specific data for the new 248+ * channel. */ 249+ int mask; /* TCL_READABLE & TCL_WRITABLE to indicate 250+ * if the channel is readable, writable. */ 251+ Tcl_Channel prevChan; /* The channel structure to replace */ 252+ { 253+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); 254+ Channel *chanPtr, *pt, *prevPt; 255+ 256+ /* 257+ * Find the given channel in the list of all channels, compute enough 258+ * information to allow easy removal after the conditions are met. 259+ */ 260+ 261+ prevPt = (Channel*) NULL; 262+ pt = (Channel*) tsdPtr->firstChanPtr; 263+ 264+ while (pt != (Channel *) prevChan) { 265+ prevPt = pt; 266+ pt = pt->nextChanPtr; 267+ } 268+ 269+ /* 270+ * 'pt == prevChan' now 271+ */ 272+ 273+ if (!pt) { 274+ return (Tcl_Channel) NULL; 275+ } 276+ 277+ /* 278+ * Here we check if the given "mask" matches the "flags" 279+ * of the already existing channel. 280+ * 281+ * | - | R | W | RW | 282+ * --+---+---+---+----+ <=> 0 != (chan->mask & prevChan->mask) 283+ * - | | | | | 284+ * R | | + | | + | The superceding channel is allowed to 285+ * W | | | + | + | restrict the capabilities of the 286+ * RW| | + | + | + | superceded one ! 287+ * --+---+---+---+----+ 288+ */ 289+ 290+ if ((mask & Tcl_GetChannelMode (prevChan)) == 0) { 291+ return (Tcl_Channel) NULL; 292+ } 293+ 294+ 295+ chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel)); 296+ chanPtr->flags = mask; 297+ 298+ /* 299+ * Set the channel up initially in no Input translation mode and 300+ * no Output translation mode. 301+ */ 302+ 303+ chanPtr->inputTranslation = TCL_TRANSLATE_LF; 304+ chanPtr->outputTranslation = TCL_TRANSLATE_LF; 305+ chanPtr->inEofChar = 0; 306+ chanPtr->outEofChar = 0; 307+ 308+ chanPtr->unreportedError = 0; 309+ chanPtr->instanceData = instanceData; 310+ chanPtr->typePtr = typePtr; 311+ chanPtr->refCount = 0; 312+ chanPtr->closeCbPtr = (CloseCallback *) NULL; 313+ chanPtr->curOutPtr = (ChannelBuffer *) NULL; 314+ chanPtr->outQueueHead = (ChannelBuffer *) NULL; 315+ chanPtr->outQueueTail = (ChannelBuffer *) NULL; 316+ chanPtr->saveInBufPtr = (ChannelBuffer *) NULL; 317+ chanPtr->inQueueHead = (ChannelBuffer *) NULL; 318+ chanPtr->inQueueTail = (ChannelBuffer *) NULL; 319+ chanPtr->chPtr = (ChannelHandler *) NULL; 320+ chanPtr->interestMask = 0; 321+ chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL; 322+ chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; 323+ chanPtr->timer = NULL; 324+ chanPtr->csPtr = NULL; 325+ 326+ /* 06/12/1998: New for Tcl 8.1 327+ * 328+ * Take over the encoding from the superceded channel, so that it will be 329+ * executed in the future despite the replacement, and at the proper time 330+ * (*after* / *before* our transformation, depending on the direction of 331+ * the dataflow). 332+ * 333+ * *Important* 334+ * The I/O functionality of the filtering channel has to use 'Tcl_Read' to 335+ * get at the underlying information. This will circumvent the de/encoder 336+ * stage [*] in the superceded channel and removes the need to trouble 337+ * ourselves with 'ByteArray's too. 338+ * 339+ * [*] I'm talking about the conversion between UNICODE and other 340+ * representations, like ASCII. 341+ */ 342+ 343+ chanPtr->encoding=Tcl_GetEncoding(interp,Tcl_GetEncodingName(pt->encoding)); 344+ chanPtr->inputEncodingState = pt->inputEncodingState; 345+ chanPtr->inputEncodingFlags = pt->inputEncodingFlags; 346+ chanPtr->outputEncodingState = pt->outputEncodingState; 347+ chanPtr->outputEncodingFlags = pt->outputEncodingFlags; 348+ 349+ chanPtr->outputStage = NULL; 350+ 351+ if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) { 352+ chanPtr->outputStage = (char *) 353+ ckalloc((unsigned) (chanPtr->bufSize + 2)); 354+ } 355+ 356+ chanPtr->supercedes = (Channel*) prevChan; 357+ 358+ chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1); 359+ strcpy (chanPtr->channelName, pt->channelName); 360+ 361+ if (prevPt) { 362+ prevPt->nextChanPtr = chanPtr; 363+ } else { 364+ tsdPtr->firstChanPtr = chanPtr; 365+ } 366+ 367+ chanPtr->nextChanPtr = pt->nextChanPtr; 368+ 369+ Tcl_RegisterChannel (interp, (Tcl_Channel) chanPtr); 370+ 371+ /* 372+ * The superceded channel is effectively unregistered 373+ */ 374+ 375+ /*chanPtr->supercedes->refCount --;*/ 376+ 377+ return (Tcl_Channel) chanPtr; 378+ } 379+ 380+ /* 381+ *---------------------------------------------------------------------- 382+ * 383+ * Tcl_UnstackChannel -- 384+ * 385+ * Unstacks an entry in the hash table for a Tcl_Channel 386+ * record. This is the reverse to 'Tcl_StackChannel'. 387+ * The old, superceded channel is uncovered and re-registered 388+ * in the appropriate datastructures. 389+ * 390+ * Results: 391+ * Returns the old Tcl_Channel, i.e. the one which was stacked over. 392+ * 393+ * Side effects: 394+ * See above. 395+ * 396+ *---------------------------------------------------------------------- 397+ */ 398+ 399+ void 400+ Tcl_UnstackChannel (interp, chan) 401+ Tcl_Interp* interp; /* The interpreter we are working in */ 402+ Tcl_Channel chan; /* The channel to unstack */ 403+ { 404+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); 405+ Channel* chanPtr = (Channel*) chan; 406+ 407+ if (chanPtr->supercedes != (Channel*) NULL) { 408+ Tcl_HashTable *hTblPtr; /* Hash table of channels. */ 409+ Tcl_HashEntry *hPtr; /* Search variable. */ 410+ int new; /* Is the hash entry new or does it exist? */ 411+ 412+ /* 413+ * Insert the channel we were stacked upon back into 414+ * the list of open channels. Place it back into the hashtable too. 415+ * Correct 'refCount', as this actually unregisters 'chan'. 416+ */ 417+ 418+ chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr; 419+ tsdPtr->firstChanPtr = chanPtr->supercedes; 420+ 421+ hTblPtr = GetChannelTable (interp); 422+ hPtr = Tcl_CreateHashEntry (hTblPtr, chanPtr->channelName, &new); 423+ 424+ Tcl_SetHashValue(hPtr, (ClientData) chanPtr->supercedes); 425+ chanPtr->refCount --; 426+ 427+ /* 428+ * The superceded channel is effectively registered again 429+ */ 430+ 431+ /*chanPtr->supercedes->refCount ++;*/ 432+ } 433+ 434+ /* 435+ * Disconnect the channels, then do a regular close upon the 436+ * stacked one, the filtering channel. This may cause flushing 437+ * of data into the superceded channel (if the filtering channel 438+ * ('chan') remembered its parent in itself). 439+ */ 440+ 441+ chanPtr->supercedes = NULL; 442+ 443+ if (chanPtr->refCount == 0) { 444+ Tcl_Close (interp, chan); 445+ } 446+ } 447+ 448 /* 449 *---------------------------------------------------------------------- 450 * 451*************** 452*** 2003,2008 **** 453--- 2290,2330 ---- 454 if (errorCode != 0) { 455 Tcl_SetErrno(errorCode); 456 } 457+ } 458+ 459+ /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998 460+ * "Trf-Patch for filtering channels" 461+ * 462+ * This is the change to 'CloseChannel'. 463+ * 464+ * Explanation 465+ * Closing a filtering channel closes the one it 466+ * superceded too. This basically ripples through 467+ * the whole chain of filters until it reaches 468+ * the underlying normal channel. 469+ * 470+ * This is done by reintegrating the superceded 471+ * channel into the (thread) global list of open 472+ * channels and then invoking a regular close. 473+ * There is no need to handle the complexities of 474+ * this process by ourselves. 475+ * 476+ * *Note* 477+ * This has to be done after the call to the 478+ * 'closeProc' of the filtering channel to allow 479+ * that one the flushing of internal buffers into 480+ * the underlying channel. 481+ */ 482+ 483+ if (chanPtr->supercedes != (Channel*) NULL) { 484+ /* Insert the channel we were stacked upon back into 485+ * the list of open channels, then do a regular close. 486+ */ 487+ 488+ chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr; 489+ tsdPtr->firstChanPtr = chanPtr->supercedes; 490+ chanPtr->supercedes->refCount --; /* is deregistered */ 491+ Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes); 492 } 493 494 /* 495*** ./tclStubInit.c.orig Fri May 7 20:30:02 1999 496--- ./tclStubInit.c Fri May 7 20:33:35 1999 497*************** 498*** 593,600 **** 499 Tcl_PanicVA, /* 278 */ 500 Tcl_GetVersion, /* 279 */ 501 Tcl_InitMemory, /* 280 */ 502! NULL, /* 281 */ 503! NULL, /* 282 */ 504 NULL, /* 283 */ 505 NULL, /* 284 */ 506 NULL, /* 285 */ 507--- 593,600 ---- 508 Tcl_PanicVA, /* 278 */ 509 Tcl_GetVersion, /* 279 */ 510 Tcl_InitMemory, /* 280 */ 511! Tcl_StackChannel, /* 281 */ 512! Tcl_UnstackChannel, /* 282 */ 513 NULL, /* 283 */ 514 NULL, /* 284 */ 515 NULL, /* 285 */ 516*** ./tclStubs.c.orig Fri May 7 20:30:02 1999 517--- ./tclStubs.c Fri May 7 20:33:35 1999 518*************** 519*** 3263,3267 **** 520--- 3263,3288 ---- 521 (tclStubsPtr->tcl_ServiceModeHook)(mode); 522 } 523 524+ /* Slot 345 */ 525+ Tcl_Channel 526+ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan) 527+ Tcl_Interp * interp; 528+ Tcl_ChannelType * typePtr; 529+ ClientData instanceData; 530+ int mask; 531+ Tcl_Channel prevChan; 532+ { 533+ return (tclStubsPtr->tcl_StackChannel)(interp, typePtr, instanceData, mask, prevChan); 534+ } 535+ 536+ /* Slot 346 */ 537+ void 538+ Tcl_UnstackChannel(interp, chan) 539+ Tcl_Interp * interp; 540+ Tcl_Channel chan; 541+ { 542+ (tclStubsPtr->tcl_UnstackChannel)(interp, chan); 543+ } 544+ 545 546 /* !END!: Do not edit above this line. */ 547