1*** tcl.h.orig Wed Jan 22 17:47:56 1997 2--- tcl.h Sun Jan 26 19:34:33 1997 3*************** 4*** 1380,1384 **** 5--- 1380,1391 ---- 6 EXTERN int Tcl_Write _ANSI_ARGS_((Tcl_Channel chan, 7 char *s, int slen)); 8 9+ EXTERN Tcl_Channel Tcl_ReplaceChannel _ANSI_ARGS_ ((Tcl_Interp* interp, 10+ Tcl_ChannelType* typePtr, ClientData instanceData, 11+ int mask, Tcl_Channel prevChan)); 12+ 13+ EXTERN void Tcl_UndoReplaceChannel _ANSI_ARGS_ ((Tcl_Interp* interp, 14+ Tcl_Channel chan)); 15+ 16 #endif /* RESOURCE_INCLUDED */ 17 #endif /* _TCL */ 18*** tclIO.c.orig Sat Dec 14 00:11:41 1996 19--- tclIO.c Sun Jan 26 19:34:34 1997 20*************** 21*** 161,166 **** 22--- 161,169 ---- 23 * event handlers ("fileevent") on this 24 * channel. */ 25 int bufSize; /* What size buffers to allocate? */ 26+ 27+ struct Channel* supercedes; /* Refers to channel this one was stacked upon */ 28+ 29 } Channel; 30 31 /* 32*************** 33*** 1060,1071 **** 34 if (interp != (Tcl_Interp *) NULL) { 35 hTblPtr = GetChannelTable(interp); 36 hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new); 37! if (new == 0) { 38! if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) { 39! return; 40! } 41! panic("Tcl_RegisterChannel: duplicate channel names"); 42! } 43 Tcl_SetHashValue(hPtr, (ClientData) chanPtr); 44 } 45 chanPtr->refCount++; 46--- 1063,1073 ---- 47 if (interp != (Tcl_Interp *) NULL) { 48 hTblPtr = GetChannelTable(interp); 49 hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new); 50! if (new == 0) { 51! if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) { 52! return; 53! } 54! } 55 Tcl_SetHashValue(hPtr, (ClientData) chanPtr); 56 } 57 chanPtr->refCount++; 58*************** 59*** 1212,1217 **** 60--- 1214,1220 ---- 61 chanPtr->interestMask = 0; 62 chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL; 63 chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; 64+ chanPtr->supercedes = (Channel*) NULL; 65 66 /* 67 * Link the channel into the list of all channels; create an on-exit 68*************** 69*** 1248,1253 **** 70--- 1251,1431 ---- 71 /* 72 *---------------------------------------------------------------------- 73 * 74+ * Tcl_ReplaceChannel -- 75+ * 76+ * Replaces an entry in the hash table for a Tcl_Channel 77+ * record. 78+ * 79+ * Results: 80+ * Returns the new Tcl_Channel. 81+ * 82+ * Side effects: 83+ * Replaces a Tcl_Channel instance into the hash table. 84+ * 85+ *---------------------------------------------------------------------- 86+ */ 87+ 88+ Tcl_Channel 89+ Tcl_ReplaceChannel(interp, typePtr, instanceData, mask, prevChan) 90+ Tcl_Interp* interp; /* the interpreter we are working in */ 91+ Tcl_ChannelType *typePtr; /* The channel type record. */ 92+ ClientData instanceData; /* Instance specific data. */ 93+ int mask; /* TCL_READABLE & TCL_WRITABLE to indicate 94+ * if the channel is readable, writable. */ 95+ Tcl_Channel prevChan; /* The channel structure that should 96+ * be replaced. */ 97+ { 98+ Channel *chanPtr, *pt, *prevPt; 99+ 100+ /* 101+ * Replace the channel into the list of all channels; 102+ */ 103+ 104+ prevPt = (Channel*) NULL; 105+ pt = (Channel*) firstChanPtr; 106+ 107+ while (pt != (Channel *) prevChan) { 108+ prevPt = pt; 109+ pt = pt->nextChanPtr; 110+ } 111+ 112+ if (!pt) { 113+ return (Tcl_Channel) NULL; 114+ } 115+ 116+ /* 117+ * Here we check if the "mask" matches the "flags" 118+ * of the already existing channel. 119+ * 120+ * | - | R | W | RW | 121+ * --+---+---+---+----+ <=> 0 != (chan->mask & prevChan->mask) 122+ * - | | | | | 123+ * R | | + | | + | The superceding channel is allowed to 124+ * W | | | + | + | restrict the capabilities of the 125+ * RW| | + | + | + | superceded one ! 126+ * --+---+---+---+----+ 127+ */ 128+ 129+ if ((mask & Tcl_GetChannelMode (prevChan)) == 0) { 130+ return (Tcl_Channel) NULL; 131+ } 132+ 133+ 134+ chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel)); 135+ chanPtr->flags = mask; 136+ 137+ /* 138+ * Set the channel up initially in no Input translation mode and 139+ * no Output translation mode. 140+ */ 141+ 142+ chanPtr->inputTranslation = TCL_TRANSLATE_LF; 143+ chanPtr->outputTranslation = TCL_TRANSLATE_LF; 144+ chanPtr->inEofChar = 0; 145+ chanPtr->outEofChar = 0; 146+ 147+ chanPtr->unreportedError = 0; 148+ chanPtr->instanceData = instanceData; 149+ chanPtr->typePtr = typePtr; 150+ chanPtr->refCount = 0; 151+ chanPtr->closeCbPtr = (CloseCallback *) NULL; 152+ chanPtr->curOutPtr = (ChannelBuffer *) NULL; 153+ chanPtr->outQueueHead = (ChannelBuffer *) NULL; 154+ chanPtr->outQueueTail = (ChannelBuffer *) NULL; 155+ chanPtr->saveInBufPtr = (ChannelBuffer *) NULL; 156+ chanPtr->inQueueHead = (ChannelBuffer *) NULL; 157+ chanPtr->inQueueTail = (ChannelBuffer *) NULL; 158+ chanPtr->chPtr = (ChannelHandler *) NULL; 159+ chanPtr->interestMask = 0; 160+ chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL; 161+ chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; 162+ 163+ chanPtr->supercedes = (Channel*) prevChan; 164+ 165+ chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1); 166+ strcpy (chanPtr->channelName, pt->channelName); 167+ 168+ if (prevPt) { 169+ prevPt->nextChanPtr = chanPtr; 170+ } else { 171+ firstChanPtr = chanPtr; 172+ } 173+ 174+ chanPtr->nextChanPtr = pt->nextChanPtr; 175+ 176+ 177+ Tcl_RegisterChannel (interp, (Tcl_Channel) chanPtr); 178+ 179+ /* The superceded channel is effectively unregistered */ 180+ chanPtr->supercedes->refCount --; 181+ 182+ return (Tcl_Channel) chanPtr; 183+ } 184+ 185+ /* 186+ *---------------------------------------------------------------------- 187+ * 188+ * Tcl_UndoReplaceChannel -- 189+ * 190+ * Unstacks an entry in the hash table for a Tcl_Channel 191+ * record. 192+ * 193+ * Results: 194+ * Returns the old Tcl_Channel, i.e. the one which was stacked over. 195+ * 196+ * Side effects: 197+ * Replaces a Tcl_Channel instance into the hash table. 198+ * 199+ *---------------------------------------------------------------------- 200+ */ 201+ 202+ void 203+ Tcl_UndoReplaceChannel (interp, chan) 204+ Tcl_Interp* interp; /* The interpreter we are working in */ 205+ Tcl_Channel chan; /* The channel to unstack */ 206+ { 207+ Channel* chanPtr = (Channel*) chan; 208+ 209+ if (chanPtr->supercedes != (Channel*) NULL) { 210+ Tcl_HashTable *hTblPtr; /* Hash table of channels. */ 211+ Tcl_HashEntry *hPtr; /* Search variable. */ 212+ int new; /* Is the hash entry new or does it exist? */ 213+ 214+ /* 215+ * Insert the channel we were stacked upon back into 216+ * the list of open channels. Place it back into the hashtable too. 217+ * Correct 'refCount', as this actually unregisters 'chan'. 218+ */ 219+ 220+ chanPtr->supercedes->nextChanPtr = firstChanPtr; 221+ firstChanPtr = chanPtr->supercedes; 222+ 223+ hTblPtr = GetChannelTable (interp); 224+ hPtr = Tcl_CreateHashEntry (hTblPtr, chanPtr->channelName, &new); 225+ 226+ Tcl_SetHashValue(hPtr, (ClientData) chanPtr->supercedes); 227+ chanPtr->refCount --; 228+ 229+ /* The superceded channel is effectively registered again */ 230+ chanPtr->supercedes->refCount ++; 231+ } 232+ 233+ /* 234+ * Disconnect the channels, then do a regular close upon the 235+ * stacked one. This may cause flushing of data into the 236+ * superceded channel (if 'chan' remembered its parent in itself). 237+ */ 238+ 239+ chanPtr->supercedes = NULL; 240+ 241+ if (chanPtr->refCount == 0) { 242+ Tcl_Close (interp, chan); 243+ } 244+ } 245+ 246+ /* 247+ *---------------------------------------------------------------------- 248+ * 249 * Tcl_GetChannelMode -- 250 * 251 * Computes a mask indicating whether the channel is open for 252*************** 253*** 1840,1845 **** 254--- 2018,2040 ---- 255 Tcl_SetErrno(errorCode); 256 } 257 } 258+ 259+ /* 260+ * Handle stacking of channels. Must be done after 'closeProc' 261+ * to allow for flushing of data into the underlying channel. 262+ */ 263+ 264+ if (chanPtr->supercedes != (Channel*) NULL) { 265+ /* Insert the channel we were stacked upon back into 266+ * the list of open channels, then do a regular close. 267+ */ 268+ 269+ chanPtr->supercedes->nextChanPtr = firstChanPtr; 270+ firstChanPtr = chanPtr->supercedes; 271+ 272+ Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes); 273+ } 274+ 275 276 Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC); 277 278