File: standard.patch

package info (click to toggle)
tcltrf 2.1.4-dfsg3-8
  • links: PTS
  • area: main
  • in suites: forky, sid, trixie
  • size: 9,656 kB
  • sloc: ansic: 73,139; sh: 3,155; tcl: 1,343; makefile: 182; exp: 22
file content (324 lines) | stat: -rw-r--r-- 10,305 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
*** tcl.h.orig	Fri Jun 12 15:52:49 1998
--- tcl.h	Sat Jun 13 21:11:47 1998
***************
*** 1795,1799 ****
--- 1795,1813 ----
  EXTERN void		Tcl_WrongNumArgs _ANSI_ARGS_((Tcl_Interp *interp,
  			    int objc, Tcl_Obj *CONST objv[], char *message));
  
+ /* Andreas Kupries <andreas_kupries@users.sourceforge.net>, 05/31/1997.
+  * Support for Tcl-Trf (channel interceptors).
+  */
+ 
+ EXTERN Tcl_Channel Tcl_ReplaceChannel _ANSI_ARGS_ ((Tcl_Interp*      interp,
+ 						    Tcl_ChannelType* typePtr,
+ 						    ClientData  instanceData,
+ 						    int         mask,
+ 						    Tcl_Channel prevChan));
+ 
+ EXTERN void Tcl_UndoReplaceChannel _ANSI_ARGS_ ((Tcl_Interp* interp,
+ 						 Tcl_Channel chan));
+ 
+ 
  #endif /* RESOURCE_INCLUDED */
  #endif /* _TCL */
*** tclIO.c.orig	Fri Jun 12 15:52:49 1998
--- tclIO.c	Sat Jun 13 21:11:47 1998
***************
*** 201,206 ****
--- 201,213 ----
      int bufSize;		/* What size buffers to allocate? */
      Tcl_TimerToken timer;	/* Handle to wakeup timer for this channel. */
      CopyState *csPtr;		/* State of background copy, or NULL. */
+ 
+   /* Andreas Kupries <andreas_kupries@users.sourceforge.net>, 05/31/1997.
+    * Support for Tcl-Trf (channel interceptors).
+    */
+ 
+   struct Channel* supercedes; /* Refers to channel this one was stacked upon */
+ 
  } Channel;
      
  /*
***************
*** 1036,1043 ****
          if (new == 0) {
              if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
                  return;
!             }
!             panic("Tcl_RegisterChannel: duplicate channel names");
          }
          Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
      }
--- 1043,1053 ----
          if (new == 0) {
              if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
                  return;
!             } 
! 	    /* Andreas Kupries <andreas_kupries@users.sourceforge.net>, 05/31/1997.
! 	     * Support for Tcl-Trf (channel interceptors).
! 	     */
! 	    /* panic("Tcl_RegisterChannel: duplicate channel names"); */
          }
          Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
      }
***************
*** 1296,1301 ****
--- 1306,1318 ----
      chanPtr->timer = NULL;
      chanPtr->csPtr = NULL;
  
+     /* Andreas Kupries <andreas_kupries@users.sourceforge.net>, 05/31/1997.
+      * Support for Tcl-Trf (channel interceptors).
+      */
+ 
+     chanPtr->supercedes = (Channel*) NULL;
+ 
+ 
      chanPtr->outputStage = NULL;
      if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
  	chanPtr->outputStage = (char *)
***************
*** 1329,1334 ****
--- 1346,1558 ----
      return (Tcl_Channel) chanPtr;
  }
  
+ /* Andreas Kupries <andreas_kupries@users.sourceforge.net>, 05/31/1997.
+  * Support of Tcl-Trf.
+  */
+ /*
+  *----------------------------------------------------------------------
+  *
+  * Tcl_ReplaceChannel --
+  *
+  *	Replaces an entry in the hash table for a Tcl_Channel
+  *	record.
+  *
+  * Results:
+  *	Returns the new Tcl_Channel.
+  *
+  * Side effects:
+  *	Replaces a Tcl_Channel instance into the hash table.
+  *
+  *----------------------------------------------------------------------
+  */
+ 
+ Tcl_Channel
+ Tcl_ReplaceChannel(interp, typePtr, instanceData, mask, prevChan)
+     Tcl_Interp* interp; /* the interpreter we are working in */
+     Tcl_ChannelType *typePtr;	/* The channel type record. */
+     ClientData instanceData;	/* Instance specific data. */
+     int mask;			/* TCL_READABLE & TCL_WRITABLE to indicate
+                                  * if the channel is readable, writable. */
+     Tcl_Channel prevChan;	/* The channel structure that should
+ 				 * be replaced. */
+ {
+   ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+   Channel *chanPtr, *pt, *prevPt;
+ 
+   /*
+    * Replace the channel into the list of all channels;
+    */
+ 
+   prevPt = (Channel*) NULL;
+   pt     = (Channel*) tsdPtr->firstChanPtr;
+ 
+   while (pt != (Channel *) prevChan) {
+     prevPt = pt;
+     pt     = pt->nextChanPtr;
+   }
+ 
+   /* 'pt == prevChan' now */
+ 
+   if (!pt) {
+     return (Tcl_Channel) NULL;
+   }
+ 
+   /*
+    * Here we check if the "mask" matches the "flags"
+    * of the already existing channel.
+    *
+    *	  | - | R | W | RW |
+    *	--+---+---+---+----+	<=>  0 != (chan->mask & prevChan->mask)
+    *	- |   |   |   |    |
+    *	R |   | + |   | +  |	The superceding channel is allowed to
+    *	W |   |   | + | +  |	restrict the capabilities of the
+    *	RW|   | + | + | +  |	superceded one !
+    *	--+---+---+---+----+
+    */
+ 
+   if ((mask & Tcl_GetChannelMode (prevChan)) == 0) {
+     return (Tcl_Channel) NULL;
+   }
+ 
+ 
+   chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
+   chanPtr->flags = mask;
+ 
+   /*
+    * Set the channel up initially in no Input translation mode and
+    * no Output translation mode.
+    */
+ 
+   chanPtr->inputTranslation = TCL_TRANSLATE_LF;
+   chanPtr->outputTranslation = TCL_TRANSLATE_LF;
+   chanPtr->inEofChar = 0;
+   chanPtr->outEofChar = 0;
+ 
+   chanPtr->unreportedError = 0;
+   chanPtr->instanceData = instanceData;
+   chanPtr->typePtr = typePtr;
+   chanPtr->refCount = 0;
+   chanPtr->closeCbPtr = (CloseCallback *) NULL;
+   chanPtr->curOutPtr = (ChannelBuffer *) NULL;
+   chanPtr->outQueueHead = (ChannelBuffer *) NULL;
+   chanPtr->outQueueTail = (ChannelBuffer *) NULL;
+   chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
+   chanPtr->inQueueHead = (ChannelBuffer *) NULL;
+   chanPtr->inQueueTail = (ChannelBuffer *) NULL;
+   chanPtr->chPtr = (ChannelHandler *) NULL;
+   chanPtr->interestMask = 0;
+   chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
+   chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
+   chanPtr->timer = NULL;
+   chanPtr->csPtr = NULL;
+ 
+   /* 06/12/1998: New for Tcl 8.1
+    *
+    * Take over the encoding from the superceded channel, so that it will be
+    * executed in future despite the replacement, and at the proper time (after
+    * our transformation).
+    *
+    * Tcl-Trf uses 'Tcl_Read' to get at the underlying information, thus
+    * circumventing data de/encoding in the superceded channel. Because of this
+    * there is no need to trouble ourselves with 'ByteArray's too.
+    */
+ 
+   chanPtr->encoding=Tcl_GetEncoding(interp,Tcl_GetEncodingName(pt->encoding));
+   chanPtr->inputEncodingState  = pt->inputEncodingState;
+   chanPtr->inputEncodingFlags  = pt->inputEncodingFlags;
+   chanPtr->outputEncodingState = pt->outputEncodingState;
+   chanPtr->outputEncodingFlags = pt->outputEncodingFlags;
+ 
+ 
+   chanPtr->outputStage = NULL;
+   if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
+     chanPtr->outputStage = (char *)
+       ckalloc((unsigned) (chanPtr->bufSize + 2));
+   }
+ 
+   chanPtr->supercedes = (Channel*) prevChan;
+ 
+   chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1);
+   strcpy (chanPtr->channelName, pt->channelName);
+ 
+   if (prevPt) {
+     prevPt->nextChanPtr = chanPtr;
+   } else {
+     tsdPtr->firstChanPtr = chanPtr;
+   }
+ 
+   chanPtr->nextChanPtr = pt->nextChanPtr;
+ 
+   Tcl_RegisterChannel (interp, (Tcl_Channel) chanPtr);
+ 
+   /* The superceded channel is effectively unregistered */
+   /*chanPtr->supercedes->refCount --;*/
+ 
+   return (Tcl_Channel) chanPtr;
+ }
+ 
+ /*
+  *----------------------------------------------------------------------
+  *
+  * Tcl_UndoReplaceChannel --
+  *
+  *	Unstacks an entry in the hash table for a Tcl_Channel
+  *	record.
+  *
+  * Results:
+  *	Returns the old Tcl_Channel, i.e. the one which was stacked over.
+  *
+  * Side effects:
+  *	Replaces a Tcl_Channel instance into the hash table.
+  *
+  *----------------------------------------------------------------------
+  */
+ 
+ void
+ Tcl_UndoReplaceChannel (interp, chan)
+ Tcl_Interp* interp; /* The interpreter we are working in */
+ Tcl_Channel chan;   /* The channel to unstack */
+ {
+   ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+   Channel* chanPtr = (Channel*) chan;
+ 
+   if (chanPtr->supercedes != (Channel*) NULL) {
+     Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
+     Tcl_HashEntry *hPtr;	/* Search variable. */
+     int new;			/* Is the hash entry new or does it exist? */
+ 
+     /*
+      * Insert the channel we were stacked upon back into
+      * the list of open channels. Place it back into the hashtable too.
+      * Correct 'refCount', as this actually unregisters 'chan'.
+      */
+ 
+     chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr;
+     tsdPtr->firstChanPtr             = chanPtr->supercedes;
+ 
+     hTblPtr = GetChannelTable (interp);
+     hPtr    = Tcl_CreateHashEntry (hTblPtr, chanPtr->channelName, &new);
+ 
+     Tcl_SetHashValue(hPtr, (ClientData) chanPtr->supercedes);
+     chanPtr->refCount --;
+ 
+     /* The superceded channel is effectively registered again */
+     /*chanPtr->supercedes->refCount ++;*/
+   }
+ 
+   /*
+    * Disconnect the channels, then do a regular close upon the
+    * stacked one. This may cause flushing of data into the
+    * superceded channel (if 'chan' remembered its parent in itself).
+    */
+ 
+   chanPtr->supercedes = NULL;
+ 
+   if (chanPtr->refCount == 0) {
+     Tcl_Close (interp, chan);
+   }
+ }
+ 
  /*
   *----------------------------------------------------------------------
   *
***************
*** 2002,2007 ****
--- 2226,2250 ----
          if (errorCode != 0) {
              Tcl_SetErrno(errorCode);
          }
+     }
+ 
+     /* -- CloseChannel --
+      * Andreas Kupries <andreas_kupries@users.sourceforge.net>, 05/31/1997.
+      * Support of Tcl-Trf (channel interceptors).
+      *
+      * Handle stacking of channels. Must be done after 'closeProc'
+      * to allow for flushing of data into the underlying channel.
+      */
+ 
+     if (chanPtr->supercedes != (Channel*) NULL) {
+       /* Insert the channel we were stacked upon back into
+        * the list of open channels, then do a regular close.
+        */
+ 
+       chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr;
+       tsdPtr->firstChanPtr             = chanPtr->supercedes;
+       chanPtr->supercedes->refCount --; /* is deregistered */
+       Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes);
      }
  
      /*