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);
}
/*
|