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