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