2 * CDE - Common Desktop Environment
4 * Copyright (c) 1993-2012, The Open Group. All rights reserved.
6 * These libraries and programs are free software; you can
7 * redistribute them and/or modify them under the terms of the GNU
8 * Lesser General Public License as published by the Free Software
9 * Foundation; either version 2 of the License, or (at your option)
12 * These libraries and programs are distributed in the hope that
13 * they will be useful, but WITHOUT ANY WARRANTY; without even the
14 * implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
15 * PURPOSE. See the GNU Lesser General Public License for more
18 * You should have received a copy of the GNU Lesser General Public
19 * License along with these librararies and programs; if not, write
20 * to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
21 * Floor, Boston, MA 02110-1301 USA
23 /* $XConsortium: tclIO.c /main/2 1996/08/08 14:44:24 cde-hp $ */
27 * This file provides the generic portions (those that are the same on
28 * all platforms and for all channel types) of Tcl's IO facilities.
30 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
32 * See the file "license.terms" for information on usage and redistribution
33 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
35 * SCCS: @(#) tclIO.c 1.211 96/04/18 09:59:06
42 * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
43 * compile on systems where neither is defined. We want both defined so
44 * that we can test safely for both. In the code we still have to test for
45 * both because there may be systems on which both are defined and have
49 #if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))
50 # define EWOULDBLOCK EAGAIN
52 #if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))
53 # define EAGAIN EWOULDBLOCK
55 #if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
56 error one of EWOULDBLOCK or EAGAIN must be defined
60 * struct ChannelBuffer:
62 * Buffers data being sent to or from a channel.
65 typedef struct ChannelBuffer {
66 int nextAdded; /* The next position into which a character
67 * will be put in the buffer. */
68 int nextRemoved; /* Position of next byte to be removed
70 int bufSize; /* How big is the buffer? */
71 struct ChannelBuffer *nextPtr;
72 /* Next buffer in chain. */
73 char buf[4]; /* Placeholder for real buffer. The real
74 * buffer occuppies this space + bufSize-4
75 * bytes. This must be the last field in
79 #define CHANNELBUFFER_HEADER_SIZE (sizeof(ChannelBuffer) - 4)
82 * The following defines the *default* buffer size for channels.
85 #define CHANNELBUFFER_DEFAULT_SIZE (1024 * 4)
88 * Structure to record a close callback. One such record exists for
89 * each close callback registered for a channel.
92 typedef struct CloseCallback {
93 Tcl_CloseProc *proc; /* The procedure to call. */
94 ClientData clientData; /* Arbitrary one-word data to pass
96 struct CloseCallback *nextPtr; /* For chaining close callbacks. */
100 * Forward declaration of Channel; being used in struct EventScriptRecord,
104 typedef struct Channel *ChanPtr;
107 * The following structure describes the information saved from a call to
108 * "fileevent". This is used later when the event being waited for to
109 * invoke the saved script in the interpreter designed in this record.
112 typedef struct EventScriptRecord {
113 struct Channel *chanPtr; /* The channel for which this script is
114 * registered. This is used only when an
115 * error occurs during evaluation of the
116 * script, to delete the handler. */
117 char *script; /* Script to invoke. */
118 Tcl_Interp *interp; /* In what interpreter to invoke script? */
119 int mask; /* Events must overlap current mask for the
120 * stored script to be invoked. */
121 struct EventScriptRecord *nextPtr;
122 /* Next in chain of records. */
126 * Forward declaration of ChannelHandler; being used in struct Channel,
130 typedef struct ChannelHandler *ChannelHandlerPtr;
135 * One of these structures is allocated for each open channel. It contains data
136 * specific to the channel but which belongs to the generic part of the Tcl
137 * channel mechanism, and it points at an instance specific (and type
138 * specific) * instance data, and at a channel type structure.
141 typedef struct Channel {
142 char *channelName; /* The name of the channel instance in Tcl
143 * commands. Storage is owned by the generic IO
144 * code, is dynamically allocated. */
145 int flags; /* ORed combination of the flags defined
147 Tcl_EolTranslation inputTranslation;
148 /* What translation to apply for end of line
149 * sequences on input? */
150 Tcl_EolTranslation outputTranslation;
151 /* What translation to use for generating
152 * end of line sequences in output? */
153 int inEofChar; /* If nonzero, use this as a signal of EOF
155 int outEofChar; /* If nonzero, append this to the channel
156 * when it is closed if it is open for
158 int unreportedError; /* Non-zero if an error report was deferred
159 * because it happened in the background. The
160 * value is the POSIX error code. */
161 ClientData instanceData; /* Instance specific data. */
162 Tcl_File inFile; /* File to use for input, or NULL. */
163 Tcl_File outFile; /* File to use for output, or NULL. */
164 Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
165 int refCount; /* How many interpreters hold references to
166 * this IO channel? */
167 CloseCallback *closeCbPtr; /* Callbacks registered to be called when the
168 * channel is closed. */
169 ChannelBuffer *curOutPtr; /* Current output buffer being filled. */
170 ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
171 ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */
173 ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates
174 * need to allocate a new buffer for "gets"
175 * that crosses buffer boundaries. */
176 ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
177 ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
179 struct ChannelHandler *chPtr;/* List of channel handlers registered
180 * for this channel. */
181 int interestMask; /* Mask of all events this channel has
183 struct Channel *nextChanPtr;/* Next in list of channels currently open. */
184 EventScriptRecord *scriptRecordPtr;
185 /* Chain of all scripts registered for
186 * event handlers ("fileevent") on this
188 int bufSize; /* What size buffers to allocate? */
192 * Values for the flags field in Channel. Any ORed combination of the
193 * following flags can be stored in the field. These flags record various
194 * options and state bits about the channel. In addition to the flags below,
195 * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
198 #define CHANNEL_NONBLOCKING (1<<3) /* Channel is currently in
199 * nonblocking mode. */
200 #define CHANNEL_LINEBUFFERED (1<<4) /* Output to the channel must be
201 * flushed after every newline. */
202 #define CHANNEL_UNBUFFERED (1<<5) /* Output to the channel must always
203 * be flushed immediately. */
204 #define BUFFER_READY (1<<6) /* Current output buffer (the
205 * curOutPtr field in the
206 * channel structure) should be
207 * output as soon as possible event
208 * though it may not be full. */
209 #define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the
210 * queued output buffers has been
212 #define CHANNEL_CLOSED (1<<8) /* Channel has been closed. No
213 * further Tcl-level IO on the
214 * channel is allowed. */
215 #define CHANNEL_EOF (1<<9) /* EOF occurred on this channel.
216 * This bit is cleared before every
217 * input operation. */
218 #define CHANNEL_STICKY_EOF (1<<10) /* EOF occurred on this channel because
219 * we saw the input eofChar. This bit
220 * prevents clearing of the EOF bit
221 * before every input operation. */
222 #define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred
223 * on this channel. This bit is
224 * cleared before every input or
225 * output operation. */
226 #define INPUT_SAW_CR (1<<12) /* Channel is in CRLF eol input
227 * translation mode and the last
228 * byte seen was a "\r". */
231 * For each channel handler registered in a call to Tcl_CreateChannelHandler,
232 * there is one record of the following type. All of records for a specific
233 * channel are chained together in a singly linked list which is stored in
234 * the channel structure.
237 typedef struct ChannelHandler {
238 Channel *chanPtr; /* The channel structure for this channel. */
239 int mask; /* Mask of desired events. */
240 Tcl_ChannelProc *proc; /* Procedure to call in the type of
241 * Tcl_CreateChannelHandler. */
242 ClientData clientData; /* Argument to pass to procedure. */
243 struct ChannelHandler *nextPtr;
244 /* Next one in list of registered handlers. */
248 * This structure keeps track of the current ChannelHandler being invoked in
249 * the current invocation of ChannelHandlerEventProc. There is a potential
250 * problem if a ChannelHandler is deleted while it is the current one, since
251 * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
252 * problem, structures of the type below indicate the next handler to be
253 * processed for any (recursively nested) dispatches in progress. The
254 * nextHandlerPtr field is updated if the handler being pointed to is deleted.
255 * The nextPtr field is used to chain together all recursive invocations, so
256 * that Tcl_DeleteChannelHandler can find all the recursively nested
257 * invocations of ChannelHandlerEventProc and compare the handler being
258 * deleted against the NEXT handler to be invoked in that invocation; when it
259 * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
260 * field of the structure to the next handler.
263 typedef struct NextChannelHandler {
264 ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in
265 * this invocation. */
266 struct NextChannelHandler *nestedHandlerPtr;
267 /* Next nested invocation of
268 * ChannelHandlerEventProc. */
269 } NextChannelHandler;
272 * This variable holds the list of nested ChannelHandlerEventProc invocations.
275 static NextChannelHandler *nestedHandlerPtr = (NextChannelHandler *) NULL;
278 * List of all channels currently open.
281 static Channel *firstChanPtr = (Channel *) NULL;
284 * Has a channel exit handler been created yet?
287 static int channelExitHandlerCreated = 0;
290 * Has the channel event source been created and registered with the
294 static int channelEventSourceCreated = 0;
297 * The following structure describes the event that is added to the Tcl
298 * event queue by the channel handler check procedure.
301 typedef struct ChannelHandlerEvent {
302 Tcl_Event header; /* Standard header for all events. */
303 Channel *chanPtr; /* The channel that is ready. */
304 int readyMask; /* Events that have occurred. */
305 } ChannelHandlerEvent;
308 * Static buffer used to sprintf channel option values and return
309 * them to the caller.
312 static char optionVal[128];
315 * Static variables to hold channels for stdin, stdout and stderr.
318 static Tcl_Channel stdinChannel = NULL;
319 static int stdinInitialized = 0;
320 static Tcl_Channel stdoutChannel = NULL;
321 static int stdoutInitialized = 0;
322 static Tcl_Channel stderrChannel = NULL;
323 static int stderrInitialized = 0;
326 * Static functions in this file:
329 static int ChannelEventDeleteProc _ANSI_ARGS_((
330 Tcl_Event *evPtr, ClientData clientData));
331 static void ChannelEventSourceExitProc _ANSI_ARGS_((
333 static int ChannelHandlerEventProc _ANSI_ARGS_((
334 Tcl_Event *evPtr, int flags));
335 static void ChannelHandlerCheckProc _ANSI_ARGS_((
336 ClientData clientData, int flags));
337 static void ChannelHandlerSetupProc _ANSI_ARGS_((
338 ClientData clientData, int flags));
339 static void ChannelEventScriptInvoker _ANSI_ARGS_((
340 ClientData clientData, int flags));
341 static int CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
342 Channel *chanPtr, int errorCode));
343 static void CloseChannelsOnExit _ANSI_ARGS_((ClientData data));
344 static int CopyAndTranslateBuffer _ANSI_ARGS_((
345 Channel *chanPtr, char *result, int space));
346 static void CreateScriptRecord _ANSI_ARGS_((
347 Tcl_Interp *interp, Channel *chanPtr,
348 int mask, char *script));
349 static void DeleteChannelTable _ANSI_ARGS_((
350 ClientData clientData, Tcl_Interp *interp));
351 static void DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
352 Channel *chanPtr, int mask));
353 static void DiscardInputQueued _ANSI_ARGS_((
354 Channel *chanPtr, int discardSavedBuffers));
355 static void DiscardOutputQueued _ANSI_ARGS_((
357 static int FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
358 Channel *chanPtr, int calledFromAsyncFlush));
359 static void FlushEventProc _ANSI_ARGS_((ClientData clientData,
361 static Tcl_HashTable *GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
362 static int GetEOL _ANSI_ARGS_((Channel *chanPtr));
363 static int GetInput _ANSI_ARGS_((Channel *chanPtr));
364 static void RecycleBuffer _ANSI_ARGS_((Channel *chanPtr,
365 ChannelBuffer *bufPtr, int mustDiscard));
366 static void ReturnScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
367 Channel *chanPtr, int mask));
368 static int ScanBufferForEOL _ANSI_ARGS_((Channel *chanPtr,
369 ChannelBuffer *bufPtr,
370 Tcl_EolTranslation translation, int eofChar,
371 int *bytesToEOLPtr, int *crSeenPtr));
372 static int ScanInputForEOL _ANSI_ARGS_((Channel *chanPtr,
373 int *bytesQueuedPtr));
376 *----------------------------------------------------------------------
378 * Tcl_SetStdChannel --
380 * This function is used to change the channels that are used
381 * for stdin/stdout/stderr in new interpreters.
389 *----------------------------------------------------------------------
393 Tcl_SetStdChannel(channel, type)
395 int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
399 stdinInitialized = 1;
400 stdinChannel = channel;
403 stdoutInitialized = 1;
404 stdoutChannel = channel;
407 stderrInitialized = 1;
408 stderrChannel = channel;
414 *----------------------------------------------------------------------
416 * Tcl_GetStdChannel --
418 * Returns the specified standard channel.
421 * Returns the specified standard channel, or NULL.
424 * May cause the creation of a standard channel and the underlying
427 *----------------------------------------------------------------------
431 Tcl_GetStdChannel(type)
432 int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
434 Tcl_Channel channel = NULL;
437 * If the channels were not created yet, create them now and
438 * store them in the static variables. Note that we need to set
439 * stdinInitialized before calling TclGetDefaultStdChannel in order
440 * to avoid recursive loops when TclGetDefaultStdChannel calls
446 if (!stdinInitialized) {
447 stdinInitialized = 1;
448 stdinChannel = TclGetDefaultStdChannel(TCL_STDIN);
450 channel = stdinChannel;
453 if (!stdoutInitialized) {
454 stdoutInitialized = 1;
455 stdoutChannel = TclGetDefaultStdChannel(TCL_STDOUT);
457 channel = stdoutChannel;
460 if (!stderrInitialized) {
461 stderrInitialized = 1;
462 stderrChannel = TclGetDefaultStdChannel(TCL_STDERR);
464 channel = stderrChannel;
471 *----------------------------------------------------------------------
473 * Tcl_CreateCloseHandler
475 * Creates a close callback which will be called when the channel is
482 * Causes the callback to be called in the future when the channel
485 *----------------------------------------------------------------------
489 Tcl_CreateCloseHandler(chan, proc, clientData)
490 Tcl_Channel chan; /* The channel for which to create the
492 Tcl_CloseProc *proc; /* The callback routine to call when the
493 * channel will be closed. */
494 ClientData clientData; /* Arbitrary data to pass to the
498 CloseCallback *cbPtr;
500 chanPtr = (Channel *) chan;
502 cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
504 cbPtr->clientData = clientData;
506 cbPtr->nextPtr = chanPtr->closeCbPtr;
507 chanPtr->closeCbPtr = cbPtr;
511 *----------------------------------------------------------------------
513 * Tcl_DeleteCloseHandler --
515 * Removes a callback that would have been called on closing
516 * the channel. If there is no matching callback then this
517 * function has no effect.
523 * The callback will not be called in the future when the channel
524 * is eventually closed.
526 *----------------------------------------------------------------------
530 Tcl_DeleteCloseHandler(chan, proc, clientData)
531 Tcl_Channel chan; /* The channel for which to cancel the
533 Tcl_CloseProc *proc; /* The procedure for the callback to
535 ClientData clientData; /* The callback data for the callback
539 CloseCallback *cbPtr, *cbPrevPtr;
541 chanPtr = (Channel *) chan;
542 for (cbPtr = chanPtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
543 cbPtr != (CloseCallback *) NULL;
544 cbPtr = cbPtr->nextPtr) {
545 if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
546 if (cbPrevPtr == (CloseCallback *) NULL) {
547 chanPtr->closeCbPtr = cbPtr->nextPtr;
549 cbPrevPtr = cbPtr->nextPtr;
551 ckfree((char *) cbPtr);
560 *----------------------------------------------------------------------
562 * CloseChannelsOnExit --
564 * Closes all the existing channels, on exit. This routine is called
565 * during exit processing.
571 * Closes all channels.
573 *----------------------------------------------------------------------
578 CloseChannelsOnExit(clientData)
579 ClientData clientData; /* NULL - unused. */
581 Channel *chanPtr; /* Iterates over open channels. */
582 Channel *nextChanPtr; /* Iterates over open channels. */
585 for (chanPtr = firstChanPtr; chanPtr != (Channel *) NULL;
586 chanPtr = nextChanPtr) {
587 nextChanPtr = chanPtr->nextChanPtr;
590 * Close it only if the refcount indicates that the channel is not
591 * referenced from any interpreter. If it is, that interpreter will
592 * close the channel when it gets destroyed.
595 if (chanPtr->refCount <= 0) {
598 * Switch the channel back into synchronous mode to ensure that it
602 (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
605 Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
611 *----------------------------------------------------------------------
615 * Gets and potentially initializes the channel table for an
616 * interpreter. If it is initializing the table it also inserts
617 * channels for stdin, stdout and stderr if the interpreter is
621 * A pointer to the hash table created, for use by the caller.
624 * Initializes the channel table for an interpreter. May create
625 * channels for stdin, stdout and stderr.
627 *----------------------------------------------------------------------
630 static Tcl_HashTable *
631 GetChannelTable(interp)
634 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
635 Tcl_Channel stdinChannel, stdoutChannel, stderrChannel;
637 hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
638 if (hTblPtr == (Tcl_HashTable *) NULL) {
639 hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
640 Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
642 (void) Tcl_SetAssocData(interp, "tclIO",
643 (Tcl_InterpDeleteProc *) DeleteChannelTable,
644 (ClientData) hTblPtr);
647 * If the interpreter is trusted (not "safe"), insert channels
648 * for stdin, stdout and stderr (possibly creating them in the
652 if (Tcl_IsSafe(interp) == 0) {
653 stdinChannel = Tcl_GetStdChannel(TCL_STDIN);
654 if (stdinChannel != NULL) {
655 Tcl_RegisterChannel(interp, stdinChannel);
657 stdoutChannel = Tcl_GetStdChannel(TCL_STDOUT);
658 if (stdoutChannel != NULL) {
659 Tcl_RegisterChannel(interp, stdoutChannel);
661 stderrChannel = Tcl_GetStdChannel(TCL_STDERR);
662 if (stderrChannel != NULL) {
663 Tcl_RegisterChannel(interp, stderrChannel);
672 *----------------------------------------------------------------------
674 * DeleteChannelTable --
676 * Deletes the channel table for an interpreter, closing any open
677 * channels whose refcount reaches zero. This procedure is invoked
678 * when an interpreter is deleted, via the AssocData cleanup
685 * Deletes the hash table of channels. May close channels. May flush
686 * output on closed channels. Removes any channeEvent handlers that were
687 * registered in this interpreter.
689 *----------------------------------------------------------------------
693 DeleteChannelTable(clientData, interp)
694 ClientData clientData; /* The per-interpreter data structure. */
695 Tcl_Interp *interp; /* The interpreter being deleted. */
697 Tcl_HashTable *hTblPtr; /* The hash table. */
698 Tcl_HashSearch hSearch; /* Search variable. */
699 Tcl_HashEntry *hPtr; /* Search variable. */
700 Channel *chanPtr; /* Channel being deleted. */
701 EventScriptRecord *sPtr, *prevPtr, *nextPtr;
702 /* Variables to loop over all channel events
703 * registered, to delete the ones that refer
704 * to the interpreter being deleted. */
707 * Delete all the registered channels - this will close channels whose
708 * refcount reaches zero.
711 hTblPtr = (Tcl_HashTable *) clientData;
712 for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
713 hPtr != (Tcl_HashEntry *) NULL;
714 hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
716 chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
719 * Remove any fileevents registered in this interpreter.
722 for (sPtr = chanPtr->scriptRecordPtr,
723 prevPtr = (EventScriptRecord *) NULL;
724 sPtr != (EventScriptRecord *) NULL;
726 nextPtr = sPtr->nextPtr;
727 if (sPtr->interp == interp) {
728 if (prevPtr == (EventScriptRecord *) NULL) {
729 chanPtr->scriptRecordPtr = nextPtr;
731 prevPtr->nextPtr = nextPtr;
734 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
735 ChannelEventScriptInvoker, (ClientData) sPtr);
737 Tcl_EventuallyFree((ClientData) sPtr->script, TCL_DYNAMIC);
738 ckfree((char *) sPtr);
745 * Cannot call Tcl_UnregisterChannel because that procedure calls
746 * Tcl_GetAssocData to get the channel table, which might already
747 * be inaccessible from the interpreter structure. Instead, we
748 * emulate the behavior of Tcl_UnregisterChannel directly here.
751 Tcl_DeleteHashEntry(hPtr);
753 if (chanPtr->refCount <= 0) {
754 chanPtr->flags |= CHANNEL_CLOSED;
755 if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
756 Tcl_Close(interp, (Tcl_Channel) chanPtr);
760 Tcl_DeleteHashTable(hTblPtr);
761 ckfree((char *) hTblPtr);
765 *----------------------------------------------------------------------
767 * Tcl_UnregisterChannel --
769 * Deletes the hash entry for a channel associated with an interpreter.
772 * A standard Tcl result.
775 * Deletes the hash entry for a channel associated with an interpreter.
777 *----------------------------------------------------------------------
781 Tcl_UnregisterChannel(interp, chan)
782 Tcl_Interp *interp; /* Interpreter in which channel is defined. */
783 Tcl_Channel chan; /* Channel to delete. */
785 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
786 Tcl_HashEntry *hPtr; /* Search variable. */
787 Channel *chanPtr; /* The real IO channel. */
789 chanPtr = (Channel *) chan;
790 hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
791 if (hTblPtr == (Tcl_HashTable *) NULL) {
794 hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName);
795 if (hPtr == (Tcl_HashEntry *) NULL) {
798 if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
801 Tcl_DeleteHashEntry(hPtr);
803 if (chanPtr->refCount <= 0) {
804 chanPtr->flags |= CHANNEL_CLOSED;
805 if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
806 if (Tcl_Close(interp, chan) != TCL_OK) {
815 *----------------------------------------------------------------------
817 * Tcl_RegisterChannel --
819 * Adds an already-open channel to the channel table of an interpreter.
825 * May increment the reference count of a channel.
827 *----------------------------------------------------------------------
831 Tcl_RegisterChannel(interp, chan)
832 Tcl_Interp *interp; /* Interpreter in which to add the channel. */
833 Tcl_Channel chan; /* The channel to add to this interpreter
836 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
837 Tcl_HashEntry *hPtr; /* Search variable. */
838 int new; /* Is the hash entry new or does it exist? */
839 Channel *chanPtr; /* The actual channel. */
841 chanPtr = (Channel *) chan;
843 if (chanPtr->channelName == (char *) NULL) {
844 panic("Tcl_RegisterChannel: channel without name");
846 hTblPtr = GetChannelTable(interp);
847 hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new);
849 if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
852 panic("Tcl_RegisterChannel: duplicate channel names");
854 Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
859 *----------------------------------------------------------------------
863 * Finds an existing Tcl_Channel structure by name in a given
864 * interpreter. This function is public because it is used by
865 * channel-type-specific functions.
868 * A Tcl_Channel or NULL on failure. If failed, interp->result
869 * contains an error message. It also returns, in modePtr, the
870 * modes in which the channel is opened.
875 *----------------------------------------------------------------------
879 Tcl_GetChannel(interp, chanName, modePtr)
880 Tcl_Interp *interp; /* Interpreter in which to find or create
882 char *chanName; /* The name of the channel. */
883 int *modePtr; /* Where to store the mode in which the
884 * channel was opened? Will contain an ORed
885 * combination of TCL_READABLE and
886 * TCL_WRITABLE, if non-NULL. */
888 Channel *chanPtr; /* The actual channel. */
889 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
890 Tcl_HashEntry *hPtr; /* Search variable. */
891 char *name; /* Translated name. */
894 * Substitute "stdin", etc. Note that even though we immediately
895 * find the channel using Tcl_GetStdChannel, we still need to look
896 * it up in the specified interpreter to ensure that it is present
897 * in the channel table. Otherwise, safe interpreters would always
898 * have access to the standard channels.
902 if ((chanName[0] == 's') && (chanName[1] == 't')) {
904 if (strcmp(chanName, "stdin") == 0) {
905 chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDIN);
906 } else if (strcmp(chanName, "stdout") == 0) {
907 chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDOUT);
908 } else if (strcmp(chanName, "stderr") == 0) {
909 chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDERR);
911 if (chanPtr != NULL) {
912 name = chanPtr->channelName;
916 hTblPtr = GetChannelTable(interp);
917 hPtr = Tcl_FindHashEntry(hTblPtr, name);
918 if (hPtr == (Tcl_HashEntry *) NULL) {
919 Tcl_AppendResult(interp, "can not find channel named \"",
920 chanName, "\"", (char *) NULL);
924 chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
925 if (modePtr != NULL) {
926 *modePtr = (chanPtr->flags & (TCL_READABLE|TCL_WRITABLE));
929 return (Tcl_Channel) chanPtr;
933 *----------------------------------------------------------------------
935 * Tcl_CreateChannel --
937 * Creates a new entry in the hash table for a Tcl_Channel
941 * Returns the new Tcl_Channel.
944 * Creates a new Tcl_Channel instance and inserts it into the
947 *----------------------------------------------------------------------
951 Tcl_CreateChannel(typePtr, chanName, inFile, outFile, instanceData)
952 Tcl_ChannelType *typePtr; /* The channel type record. */
953 char *chanName; /* Name of channel to record. */
954 Tcl_File inFile; /* File to use for input, or NULL. */
955 Tcl_File outFile; /* File to use for output, or NULL. */
956 ClientData instanceData; /* Instance specific data. */
958 Channel *chanPtr; /* The channel structure newly created. */
960 chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
962 if (chanName != (char *) NULL) {
963 chanPtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));
964 strcpy(chanPtr->channelName, chanName);
966 panic("Tcl_CreateChannel: NULL channel name");
970 if (inFile != (Tcl_File) NULL) {
971 chanPtr->flags |= TCL_READABLE;
973 if (outFile != (Tcl_File) NULL) {
974 chanPtr->flags |= TCL_WRITABLE;
978 * Set the channel up initially in AUTO input translation mode to
979 * accept "\n", "\r" and "\r\n". Output translation mode is set to
980 * a platform specific default value. The eofChar is set to 0 for both
981 * input and output, so that Tcl does not look for an in-file EOF
982 * indicator (e.g. ^Z) and does not append an EOF indicator to files.
985 chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
986 chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
987 chanPtr->inEofChar = 0;
988 chanPtr->outEofChar = 0;
990 chanPtr->unreportedError = 0;
991 chanPtr->instanceData = instanceData;
992 chanPtr->inFile = inFile;
993 chanPtr->outFile = outFile;
994 chanPtr->typePtr = typePtr;
995 chanPtr->refCount = 0;
996 chanPtr->closeCbPtr = (CloseCallback *) NULL;
997 chanPtr->curOutPtr = (ChannelBuffer *) NULL;
998 chanPtr->outQueueHead = (ChannelBuffer *) NULL;
999 chanPtr->outQueueTail = (ChannelBuffer *) NULL;
1000 chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
1001 chanPtr->inQueueHead = (ChannelBuffer *) NULL;
1002 chanPtr->inQueueTail = (ChannelBuffer *) NULL;
1003 chanPtr->chPtr = (ChannelHandler *) NULL;
1004 chanPtr->interestMask = 0;
1005 chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
1006 chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
1009 * Link the channel into the list of all channels; create an on-exit
1010 * handler if there is not one already, to close off all the channels
1011 * in the list on exit.
1014 chanPtr->nextChanPtr = firstChanPtr;
1015 firstChanPtr = chanPtr;
1017 if (!channelExitHandlerCreated) {
1018 channelExitHandlerCreated = 1;
1019 Tcl_CreateExitHandler(CloseChannelsOnExit, (ClientData) NULL);
1023 * Install this channel in the first empty standard channel slot.
1026 if (Tcl_GetStdChannel(TCL_STDIN) == NULL) {
1027 Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDIN);
1028 } else if (Tcl_GetStdChannel(TCL_STDOUT) == NULL) {
1029 Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDOUT);
1030 } else if (Tcl_GetStdChannel(TCL_STDERR) == NULL) {
1031 Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDERR);
1034 return (Tcl_Channel) chanPtr;
1038 *----------------------------------------------------------------------
1040 * Tcl_GetChannelName --
1042 * Returns the string identifying the channel name.
1045 * The string containing the channel name. This memory is
1046 * owned by the generic layer and should not be modified by
1052 *----------------------------------------------------------------------
1056 Tcl_GetChannelName(chan)
1057 Tcl_Channel chan; /* The channel for which to return the name. */
1059 Channel *chanPtr; /* The actual channel. */
1061 chanPtr = (Channel *) chan;
1062 return chanPtr->channelName;
1066 *----------------------------------------------------------------------
1068 * Tcl_GetChannelType --
1070 * Given a channel structure, returns the channel type structure.
1073 * Returns a pointer to the channel type structure.
1078 *----------------------------------------------------------------------
1082 Tcl_GetChannelType(chan)
1083 Tcl_Channel chan; /* The channel to return type for. */
1085 Channel *chanPtr; /* The actual channel. */
1087 chanPtr = (Channel *) chan;
1088 return chanPtr->typePtr;
1092 *----------------------------------------------------------------------
1094 * Tcl_GetChannelFile --
1096 * Returns a file associated with a channel.
1099 * The file or NULL if failed (e.g. the channel is not open for the
1100 * requested direction).
1105 *----------------------------------------------------------------------
1109 Tcl_GetChannelFile(chan, direction)
1110 Tcl_Channel chan; /* The channel to get file from. */
1111 int direction; /* TCL_WRITABLE or TCL_READABLE. */
1113 Channel *chanPtr; /* The actual channel. */
1115 chanPtr = (Channel *) chan;
1116 switch (direction) {
1118 return chanPtr->outFile;
1120 return chanPtr->inFile;
1127 *----------------------------------------------------------------------
1129 * Tcl_GetChannelInstanceData --
1131 * Returns the client data associated with a channel.
1139 *----------------------------------------------------------------------
1143 Tcl_GetChannelInstanceData(chan)
1144 Tcl_Channel chan; /* Channel for which to return client data. */
1146 Channel *chanPtr; /* The actual channel. */
1148 chanPtr = (Channel *) chan;
1149 return chanPtr->instanceData;
1153 *----------------------------------------------------------------------
1157 * Helper function to recycle input and output buffers. Ensures
1158 * that two input buffers are saved (one in the input queue and
1159 * another in the saveInBufPtr field) and that curOutPtr is set
1160 * to a buffer. Only if these conditions are met is the buffer
1167 * May free a buffer to the OS.
1169 *----------------------------------------------------------------------
1173 RecycleBuffer(chanPtr, bufPtr, mustDiscard)
1174 Channel *chanPtr; /* Channel for which to recycle buffers. */
1175 ChannelBuffer *bufPtr; /* The buffer to recycle. */
1176 int mustDiscard; /* If nonzero, free the buffer to the
1180 * Do we have to free the buffer to the OS?
1184 ckfree((char *) bufPtr);
1189 * Only save buffers for the input queue if the channel is readable.
1192 if (chanPtr->flags & TCL_READABLE) {
1193 if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
1194 chanPtr->inQueueHead = bufPtr;
1195 chanPtr->inQueueTail = bufPtr;
1198 if (chanPtr->saveInBufPtr == (ChannelBuffer *) NULL) {
1199 chanPtr->saveInBufPtr = bufPtr;
1205 * Only save buffers for the output queue if the channel is writable.
1208 if (chanPtr->flags & TCL_WRITABLE) {
1209 if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
1210 chanPtr->curOutPtr = bufPtr;
1216 * If we reached this code we return the buffer to the OS.
1219 ckfree((char *) bufPtr);
1223 bufPtr->nextRemoved = 0;
1224 bufPtr->nextAdded = 0;
1225 bufPtr->nextPtr = (ChannelBuffer *) NULL;
1229 *----------------------------------------------------------------------
1231 * DiscardOutputQueued --
1233 * Discards all output queued in the output queue of a channel.
1241 *----------------------------------------------------------------------
1245 DiscardOutputQueued(chanPtr)
1246 Channel *chanPtr; /* The channel for which to discard output. */
1248 ChannelBuffer *bufPtr;
1250 while (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
1251 bufPtr = chanPtr->outQueueHead;
1252 chanPtr->outQueueHead = bufPtr->nextPtr;
1253 RecycleBuffer(chanPtr, bufPtr, 0);
1255 chanPtr->outQueueHead = (ChannelBuffer *) NULL;
1256 chanPtr->outQueueTail = (ChannelBuffer *) NULL;
1260 *----------------------------------------------------------------------
1264 * This function flushes as much of the queued output as is possible
1265 * now. If calledFromAsyncFlush is nonzero, it is being called in an
1266 * event handler to flush channel output asynchronously.
1269 * 0 if successful, else the error code that was returned by the
1270 * channel type operation.
1273 * May produce output on a channel. May block indefinitely if the
1274 * channel is synchronous. May schedule an async flush on the channel.
1275 * May recycle memory for buffers in the output queue.
1277 *----------------------------------------------------------------------
1281 FlushChannel(interp, chanPtr, calledFromAsyncFlush)
1282 Tcl_Interp *interp; /* For error reporting during close. */
1283 Channel *chanPtr; /* The channel to flush on. */
1284 int calledFromAsyncFlush; /* If nonzero then we are being
1285 * called from an asynchronous
1286 * flush callback. */
1288 ChannelBuffer *bufPtr; /* Iterates over buffered output
1290 int toWrite; /* Amount of output data in current
1291 * buffer available to be written. */
1292 int written; /* Amount of output data actually
1293 * written in current round. */
1294 int errorCode; /* Stores POSIX error codes from
1295 * channel driver operations. */
1300 * Loop over the queued buffers and attempt to flush as
1301 * much as possible of the queued output to the channel.
1307 * If the queue is empty and there is a ready current buffer, OR if
1308 * the current buffer is full, then move the current buffer to the
1312 if (((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
1313 (chanPtr->curOutPtr->nextAdded == chanPtr->curOutPtr->bufSize))
1314 || ((chanPtr->flags & BUFFER_READY) &&
1315 (chanPtr->outQueueHead == (ChannelBuffer *) NULL))) {
1316 chanPtr->flags &= (~(BUFFER_READY));
1317 chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
1318 if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
1319 chanPtr->outQueueHead = chanPtr->curOutPtr;
1321 chanPtr->outQueueTail->nextPtr = chanPtr->curOutPtr;
1323 chanPtr->outQueueTail = chanPtr->curOutPtr;
1324 chanPtr->curOutPtr = (ChannelBuffer *) NULL;
1326 bufPtr = chanPtr->outQueueHead;
1329 * If we are not being called from an async flush and an async
1330 * flush is active, we just return without producing any output.
1333 if ((!calledFromAsyncFlush) &&
1334 (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
1339 * If the output queue is still empty, break out of the while loop.
1342 if (bufPtr == (ChannelBuffer *) NULL) {
1343 break; /* Out of the "while (1)". */
1347 * Produce the output on the channel.
1350 toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
1351 written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
1352 chanPtr->outFile, bufPtr->buf + bufPtr->nextRemoved,
1353 toWrite, &errorCode);
1356 * If the write failed completely attempt to start the asynchronous
1357 * flush mechanism and break out of this loop - do not attempt to
1358 * write any more output at this time.
1364 * If the last attempt to write was interrupted, simply retry.
1367 if (errorCode == EINTR) {
1372 * If we would have blocked, attempt to set up an asynchronous
1373 * background flushing for this channel if the channel is
1374 * nonblocking, or block until more output can be written if
1375 * the channel is blocking.
1378 if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
1379 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
1380 if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
1381 Tcl_CreateFileHandler(chanPtr->outFile,
1382 TCL_WRITABLE, FlushEventProc,
1383 (ClientData) chanPtr);
1385 chanPtr->flags |= BG_FLUSH_SCHEDULED;
1387 break; /* Out of the "while (1)" loop. */
1391 * If the device driver did not emulate blocking behavior
1392 * then we must do it it here.
1395 TclWaitForFile(chanPtr->outFile, TCL_WRITABLE, -1);
1401 * Decide whether to report the error upwards or defer it. If
1402 * we got an error during async flush we discard all queued
1406 if (calledFromAsyncFlush) {
1407 if (chanPtr->unreportedError == 0) {
1408 chanPtr->unreportedError = errorCode;
1411 Tcl_SetErrno(errorCode);
1415 * When we get an error we throw away all the output
1419 DiscardOutputQueued(chanPtr);
1423 bufPtr->nextRemoved += written;
1426 * If this buffer is now empty, recycle it.
1429 if (bufPtr->nextRemoved == bufPtr->nextAdded) {
1430 chanPtr->outQueueHead = bufPtr->nextPtr;
1431 if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
1432 chanPtr->outQueueTail = (ChannelBuffer *) NULL;
1434 RecycleBuffer(chanPtr, bufPtr, 0);
1436 } /* Closes "while (1)". */
1439 * If the queue became empty and we have an asynchronous flushing
1440 * mechanism active, cancel the asynchronous flushing.
1443 if ((chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
1444 (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
1445 chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
1446 if (chanPtr->outFile != (Tcl_File) NULL) {
1447 Tcl_DeleteFileHandler(chanPtr->outFile);
1452 * If the channel is flagged as closed, delete it when the refcount
1453 * drops to zero, the output queue is empty and there is no output
1454 * in the current output buffer.
1457 if ((chanPtr->flags & CHANNEL_CLOSED) && (chanPtr->refCount <= 0) &&
1458 (chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
1459 ((chanPtr->curOutPtr == (ChannelBuffer *) NULL) ||
1460 (chanPtr->curOutPtr->nextAdded ==
1461 chanPtr->curOutPtr->nextRemoved))) {
1462 return CloseChannel(interp, chanPtr, errorCode);
1468 *----------------------------------------------------------------------
1472 * Utility procedure to close a channel and free its associated
1476 * 0 on success or a POSIX error code if the operation failed.
1479 * May close the actual channel; may free memory.
1481 *----------------------------------------------------------------------
1485 CloseChannel(interp, chanPtr, errorCode)
1486 Tcl_Interp *interp; /* For error reporting. */
1487 Channel *chanPtr; /* The channel to close. */
1488 int errorCode; /* Status of operation so far. */
1490 int result; /* Of calling driver close
1492 Channel *prevChanPtr; /* Preceding channel in list of
1493 * all channels - used to splice a
1494 * channel out of the list on close. */
1497 * No more input can be consumed so discard any leftover input.
1500 DiscardInputQueued(chanPtr, 1);
1503 * Discard a leftover buffer in the current output buffer field.
1506 if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
1507 ckfree((char *) chanPtr->curOutPtr);
1508 chanPtr->curOutPtr = (ChannelBuffer *) NULL;
1512 * The caller guarantees that there are no more buffers
1513 * queued for output.
1516 if (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
1517 panic("TclFlush, closed channel: queued output left");
1521 * If the EOF character is set in the channel, append that to the
1525 if ((chanPtr->outEofChar != 0) && (chanPtr->outFile != NULL)) {
1529 c = (char) chanPtr->outEofChar;
1530 (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
1531 chanPtr->outFile, &c, 1, &dummy);
1535 * Remove TCL_READABLE and TCL_WRITABLE from chanPtr->flags, so
1536 * that close callbacks can not do input or output (assuming they
1537 * squirreled the channel away in their clientData). This also
1538 * prevents infinite loops if the callback calls any C API that
1539 * could call FlushChannel.
1542 chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));
1545 * Splice this channel out of the list of all channels.
1548 if (chanPtr == firstChanPtr) {
1549 firstChanPtr = chanPtr->nextChanPtr;
1551 for (prevChanPtr = firstChanPtr;
1552 (prevChanPtr != (Channel *) NULL) &&
1553 (prevChanPtr->nextChanPtr != chanPtr);
1554 prevChanPtr = prevChanPtr->nextChanPtr) {
1555 /* Empty loop body. */
1557 if (prevChanPtr == (Channel *) NULL) {
1558 panic("FlushChannel: damaged channel list");
1560 prevChanPtr->nextChanPtr = chanPtr->nextChanPtr;
1563 if (chanPtr->channelName != (char *) NULL) {
1564 ckfree(chanPtr->channelName);
1568 * OK, close the channel itself.
1571 result = (chanPtr->typePtr->closeProc) (chanPtr->instanceData, interp,
1572 chanPtr->inFile, chanPtr->outFile);
1575 * If we are being called synchronously, report either
1576 * any latent error on the channel or the current error.
1579 if (chanPtr->unreportedError != 0) {
1580 errorCode = chanPtr->unreportedError;
1582 if (errorCode == 0) {
1584 if (errorCode != 0) {
1585 Tcl_SetErrno(errorCode);
1589 Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
1595 *----------------------------------------------------------------------
1602 * A standard Tcl result.
1605 * Closes the channel if this is the last reference.
1608 * Tcl_Close removes the channel as far as the user is concerned.
1609 * However, it may continue to exist for a while longer if it has
1610 * a background flush scheduled. The device itself is eventually
1611 * closed and the channel record removed, in CloseChannel, above.
1613 *----------------------------------------------------------------------
1618 Tcl_Close(interp, chan)
1619 Tcl_Interp *interp; /* Interpreter for errors. */
1620 Tcl_Channel chan; /* The channel being closed. Must
1621 * not be referenced in any
1624 ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */
1625 CloseCallback *cbPtr; /* Iterate over close callbacks
1626 * for this channel. */
1627 EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */
1628 Channel *chanPtr; /* The real IO channel. */
1629 int result; /* Of calling FlushChannel. */
1631 chanPtr = (Channel *) chan;
1633 if (chanPtr->refCount > 0) {
1634 panic("called Tcl_Close on channel with refcount > 0");
1638 * Remove the channel from the standard channel table.
1641 if (Tcl_GetStdChannel(TCL_STDIN) == chan) {
1642 Tcl_SetStdChannel(NULL, TCL_STDIN);
1643 } else if (Tcl_GetStdChannel(TCL_STDOUT) == chan) {
1644 Tcl_SetStdChannel(NULL, TCL_STDOUT);
1645 } else if (Tcl_GetStdChannel(TCL_STDERR) == chan) {
1646 Tcl_SetStdChannel(NULL, TCL_STDERR);
1650 * Remove all the channel handler records attached to the channel
1654 for (chPtr = chanPtr->chPtr;
1655 chPtr != (ChannelHandler *) NULL;
1657 chNext = chPtr->nextPtr;
1658 ckfree((char *) chPtr);
1660 chanPtr->chPtr = (ChannelHandler *) NULL;
1663 * Must set the interest mask now to 0, otherwise infinite loops
1664 * will occur if Tcl_DoOneEvent is called before the channel is
1665 * finally deleted in FlushChannel. This can happen if the channel
1666 * has a background flush active.
1669 chanPtr->interestMask = 0;
1672 * Remove any EventScript records for this channel.
1675 for (ePtr = chanPtr->scriptRecordPtr;
1676 ePtr != (EventScriptRecord *) NULL;
1678 eNextPtr = ePtr->nextPtr;
1679 Tcl_EventuallyFree((ClientData)ePtr->script, TCL_DYNAMIC);
1680 ckfree((char *) ePtr);
1682 chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
1685 * Invoke the registered close callbacks and delete their records.
1688 while (chanPtr->closeCbPtr != (CloseCallback *) NULL) {
1689 cbPtr = chanPtr->closeCbPtr;
1690 chanPtr->closeCbPtr = cbPtr->nextPtr;
1691 (cbPtr->proc) (cbPtr->clientData);
1692 ckfree((char *) cbPtr);
1696 * And remove any events for this channel from the event queue.
1699 Tcl_DeleteEvents(ChannelEventDeleteProc, (ClientData) chanPtr);
1702 * Ensure that the last output buffer will be flushed.
1705 if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
1706 (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
1707 chanPtr->flags |= BUFFER_READY;
1711 * The call to FlushChannel will flush any queued output and invoke
1712 * the close function of the channel driver, or it will set up the
1713 * channel to be flushed and closed asynchronously.
1716 chanPtr->flags |= CHANNEL_CLOSED;
1717 result = FlushChannel(interp, chanPtr, 0);
1726 *----------------------------------------------------------------------
1728 * ChannelEventDeleteProc --
1730 * This procedure returns 1 if the event passed in is for the
1731 * channel passed in as the second argument. This procedure is
1732 * used as a filter for events to delete in a call to
1733 * Tcl_DeleteEvents in CloseChannel.
1736 * 1 if matching, 0 otherwise.
1741 *----------------------------------------------------------------------
1745 ChannelEventDeleteProc(evPtr, clientData)
1746 Tcl_Event *evPtr; /* The event to check for a match. */
1747 ClientData clientData; /* The channel to check for. */
1749 ChannelHandlerEvent *cEvPtr;
1752 if (evPtr->proc != ChannelHandlerEventProc) {
1755 cEvPtr = (ChannelHandlerEvent *) evPtr;
1756 chanPtr = (Channel *) clientData;
1757 if (cEvPtr->chanPtr != chanPtr) {
1764 *----------------------------------------------------------------------
1768 * Puts a sequence of characters into an output buffer, may queue the
1769 * buffer for output if it gets full, and also remembers whether the
1770 * current buffer is ready e.g. if it contains a newline and we are in
1771 * line buffering mode.
1774 * The number of bytes written or -1 in case of error. If -1,
1775 * Tcl_GetErrno will return the error code.
1778 * May buffer up output and may cause output to be produced on the
1781 *----------------------------------------------------------------------
1785 Tcl_Write(chan, srcPtr, slen)
1786 Tcl_Channel chan; /* The channel to buffer output for. */
1787 char *srcPtr; /* Output to buffer. */
1788 int slen; /* Its length. Negative means
1789 * the output is null terminated
1790 * and we must compute its length. */
1792 Channel *chanPtr; /* The actual channel. */
1793 ChannelBuffer *outBufPtr; /* Current output buffer. */
1794 int foundNewline; /* Did we find a newline in output? */
1795 char *dPtr, *sPtr; /* Search variables for newline. */
1796 int crsent; /* In CRLF eol translation mode,
1797 * remember the fact that a CR was
1798 * output to the channel without
1799 * its following NL. */
1800 int i; /* Loop index for newline search. */
1801 int destCopied; /* How many bytes were used in this
1802 * destination buffer to hold the
1804 int totalDestCopied; /* How many bytes total were
1805 * copied to the channel buffer? */
1806 int srcCopied; /* How many bytes were copied from
1807 * the source string? */
1808 char *destPtr; /* Where in line to copy to? */
1810 chanPtr = (Channel *) chan;
1813 * Check for unreported error.
1816 if (chanPtr->unreportedError != 0) {
1817 Tcl_SetErrno(chanPtr->unreportedError);
1818 chanPtr->unreportedError = 0;
1823 * If the channel is not open for writing punt.
1826 if (!(chanPtr->flags & TCL_WRITABLE)) {
1827 Tcl_SetErrno(EACCES);
1832 * If length passed is negative, assume that the output is null terminated
1833 * and compute its length.
1837 slen = strlen(srcPtr);
1841 * If we are in network (or windows) translation mode, record the fact
1842 * that we have not yet sent a CR to the channel.
1848 * Loop filling buffers and flushing them until all output has been
1853 totalDestCopied = 0;
1858 * Make sure there is a current output buffer to accept output.
1861 if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
1862 chanPtr->curOutPtr = (ChannelBuffer *) ckalloc((unsigned)
1863 (CHANNELBUFFER_HEADER_SIZE + chanPtr->bufSize));
1864 chanPtr->curOutPtr->nextAdded = 0;
1865 chanPtr->curOutPtr->nextRemoved = 0;
1866 chanPtr->curOutPtr->bufSize = chanPtr->bufSize;
1867 chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
1870 outBufPtr = chanPtr->curOutPtr;
1872 destCopied = outBufPtr->bufSize - outBufPtr->nextAdded;
1873 if (destCopied > slen) {
1877 destPtr = outBufPtr->buf + outBufPtr->nextAdded;
1878 switch (chanPtr->outputTranslation) {
1879 case TCL_TRANSLATE_LF:
1880 srcCopied = destCopied;
1881 memcpy((VOID *) destPtr, (VOID *) srcPtr, (size_t) destCopied);
1883 case TCL_TRANSLATE_CR:
1884 srcCopied = destCopied;
1885 memcpy((VOID *) destPtr, (VOID *) srcPtr, (size_t) destCopied);
1886 for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
1887 if (*dPtr == '\n') {
1892 case TCL_TRANSLATE_CRLF:
1893 for (srcCopied = 0, dPtr = destPtr, sPtr = srcPtr;
1894 dPtr < destPtr + destCopied;
1895 dPtr++, sPtr++, srcCopied++) {
1896 if (*sPtr == '\n') {
1903 sPtr--, srcCopied--;
1910 case TCL_TRANSLATE_AUTO:
1911 panic("Tcl_Write: AUTO output translation mode not supported");
1913 panic("Tcl_Write: unknown output translation mode");
1917 * The current buffer is ready for output if it is full, or if it
1918 * contains a newline and this channel is line-buffered, or if it
1919 * contains any output and this channel is unbuffered.
1922 outBufPtr->nextAdded += destCopied;
1923 if (!(chanPtr->flags & BUFFER_READY)) {
1924 if (outBufPtr->nextAdded == outBufPtr->bufSize) {
1925 chanPtr->flags |= BUFFER_READY;
1926 } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
1927 for (sPtr = srcPtr, i = 0, foundNewline = 0;
1928 (i < srcCopied) && (!foundNewline);
1930 if (*sPtr == '\n') {
1936 chanPtr->flags |= BUFFER_READY;
1938 } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
1939 chanPtr->flags |= BUFFER_READY;
1943 totalDestCopied += srcCopied;
1944 srcPtr += srcCopied;
1947 if (chanPtr->flags & BUFFER_READY) {
1948 if (FlushChannel(NULL, chanPtr, 0) != 0) {
1952 } /* Closes "while" */
1954 return totalDestCopied;
1958 *----------------------------------------------------------------------
1962 * Flushes output data on a channel.
1965 * A standard Tcl result.
1968 * May flush output queued on this channel.
1970 *----------------------------------------------------------------------
1975 Tcl_Channel chan; /* The Channel to flush. */
1977 int result; /* Of calling FlushChannel. */
1978 Channel *chanPtr; /* The actual channel. */
1980 chanPtr = (Channel *) chan;
1983 * Check for unreported error.
1986 if (chanPtr->unreportedError != 0) {
1987 Tcl_SetErrno(chanPtr->unreportedError);
1988 chanPtr->unreportedError = 0;
1993 * If the channel is not open for writing punt.
1996 if (!(chanPtr->flags & TCL_WRITABLE)) {
1997 Tcl_SetErrno(EACCES);
2002 * Force current output buffer to be output also.
2005 if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
2006 (chanPtr->curOutPtr->nextAdded > 0)) {
2007 chanPtr->flags |= BUFFER_READY;
2010 result = FlushChannel(NULL, chanPtr, 0);
2019 *----------------------------------------------------------------------
2021 * DiscardInputQueued --
2023 * Discards any input read from the channel but not yet consumed
2024 * by Tcl reading commands.
2030 * May discard input from the channel. If discardLastBuffer is zero,
2031 * leaves one buffer in place for back-filling.
2033 *----------------------------------------------------------------------
2037 DiscardInputQueued(chanPtr, discardSavedBuffers)
2038 Channel *chanPtr; /* Channel on which to discard
2039 * the queued input. */
2040 int discardSavedBuffers; /* If non-zero, discard all buffers including
2043 ChannelBuffer *bufPtr, *nxtPtr; /* Loop variables. */
2045 bufPtr = chanPtr->inQueueHead;
2046 chanPtr->inQueueHead = (ChannelBuffer *) NULL;
2047 chanPtr->inQueueTail = (ChannelBuffer *) NULL;
2048 for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
2049 nxtPtr = bufPtr->nextPtr;
2050 RecycleBuffer(chanPtr, bufPtr, discardSavedBuffers);
2054 * If discardSavedBuffers is nonzero, must also discard any previously
2055 * saved buffer in the saveInBufPtr field.
2058 if (discardSavedBuffers) {
2059 if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
2060 ckfree((char *) chanPtr->saveInBufPtr);
2061 chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
2067 *----------------------------------------------------------------------
2071 * Reads input data from a device or file into an input buffer.
2074 * A Posix error code or 0.
2077 * Reads from the underlying device.
2079 *----------------------------------------------------------------------
2084 Channel *chanPtr; /* Channel to read input from. */
2086 int toRead; /* How much to read? */
2087 int result; /* Of calling driver. */
2088 int nread; /* How much was read from channel? */
2089 ChannelBuffer *bufPtr; /* New buffer to add to input queue. */
2092 * See if we can fill an existing buffer. If we can, read only
2093 * as much as will fit in it. Otherwise allocate a new buffer,
2094 * add it to the input queue and attempt to fill it to the max.
2097 if ((chanPtr->inQueueTail != (ChannelBuffer *) NULL) &&
2098 (chanPtr->inQueueTail->nextAdded < chanPtr->inQueueTail->bufSize)) {
2099 bufPtr = chanPtr->inQueueTail;
2100 toRead = bufPtr->bufSize - bufPtr->nextAdded;
2102 if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
2103 bufPtr = chanPtr->saveInBufPtr;
2104 chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
2106 bufPtr = (ChannelBuffer *) ckalloc(
2107 ((unsigned) CHANNELBUFFER_HEADER_SIZE + chanPtr->bufSize));
2108 bufPtr->bufSize = chanPtr->bufSize;
2110 bufPtr->nextRemoved = 0;
2111 bufPtr->nextAdded = 0;
2112 toRead = bufPtr->bufSize;
2113 if (chanPtr->inQueueTail == (ChannelBuffer *) NULL) {
2114 chanPtr->inQueueHead = bufPtr;
2116 chanPtr->inQueueTail->nextPtr = bufPtr;
2118 chanPtr->inQueueTail = bufPtr;
2119 bufPtr->nextPtr = (ChannelBuffer *) NULL;
2125 * If EOF is set, we should avoid calling the driver because on some
2126 * platforms it is impossible to read from a device after EOF.
2129 if (chanPtr->flags & CHANNEL_EOF) {
2132 nread = (chanPtr->typePtr->inputProc) (chanPtr->instanceData,
2133 chanPtr->inFile, bufPtr->buf + bufPtr->nextAdded,
2136 chanPtr->flags |= CHANNEL_EOF;
2138 } else if (nread < 0) {
2139 if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
2140 chanPtr->flags |= CHANNEL_BLOCKED;
2142 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
2143 Tcl_SetErrno(result);
2148 * If the device driver did not emulate blocking behavior
2149 * then we have to do it here.
2152 TclWaitForFile(chanPtr->inFile, TCL_READABLE, -1);
2155 Tcl_SetErrno(result);
2159 bufPtr->nextAdded += nread;
2162 * If we get a short read, signal up that we may be BLOCKED. We
2163 * should avoid calling the driver because on some platforms we
2164 * will block in the low level reading code even though the
2165 * channel is set into nonblocking mode.
2168 if (nread < toRead) {
2169 chanPtr->flags |= CHANNEL_BLOCKED;
2179 *----------------------------------------------------------------------
2181 * CopyAndTranslateBuffer --
2183 * Copy at most one buffer of input to the result space, doing
2184 * eol translations according to mode in effect currently.
2187 * Number of characters (as opposed to bytes) copied. May return
2188 * zero if no input is available to be translated.
2191 * Consumes buffered input. May deallocate one buffer.
2193 *----------------------------------------------------------------------
2197 CopyAndTranslateBuffer(chanPtr, result, space)
2198 Channel *chanPtr; /* The channel from which to read input. */
2199 char *result; /* Where to store the copied input. */
2200 int space; /* How many bytes are available in result
2201 * to store the copied input? */
2203 int bytesInBuffer; /* How many bytes are available to be
2204 * copied in the current input buffer? */
2205 int copied; /* How many characters were already copied
2206 * into the destination space? */
2207 ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
2208 char curByte; /* The byte we are currently translating. */
2209 int i; /* Iterates over the copied input looking
2210 * for the input eofChar. */
2213 * If there is no input at all, return zero. The invariant is that either
2214 * there is no buffer in the queue, or if the first buffer is empty, it
2215 * is also the last buffer (and thus there is no input in the queue).
2216 * Note also that if the buffer is empty, we leave it in the queue.
2219 if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
2222 bufPtr = chanPtr->inQueueHead;
2223 bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
2224 if (bytesInBuffer < space) {
2225 space = bytesInBuffer;
2228 switch (chanPtr->inputTranslation) {
2229 case TCL_TRANSLATE_LF:
2236 * Copy the current chunk into the result buffer.
2239 memcpy((VOID *) result,
2240 (VOID *)(bufPtr->buf + bufPtr->nextRemoved),
2242 bufPtr->nextRemoved += space;
2246 case TCL_TRANSLATE_CR:
2253 * Copy the current chunk into the result buffer, then
2254 * replace all \r with \n.
2257 memcpy((VOID *) result,
2258 (VOID *)(bufPtr->buf + bufPtr->nextRemoved),
2260 bufPtr->nextRemoved += space;
2261 for (copied = 0; copied < space; copied++) {
2262 if (result[copied] == '\r') {
2263 result[copied] = '\n';
2268 case TCL_TRANSLATE_CRLF:
2271 * If there is a held-back "\r" at EOF, produce it now.
2275 if ((chanPtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
2276 (INPUT_SAW_CR | CHANNEL_EOF)) {
2278 chanPtr->flags &= (~(INPUT_SAW_CR));
2285 * Copy the current chunk and replace "\r\n" with "\n"
2286 * (but not standalone "\r"!).
2291 (bufPtr->nextRemoved < bufPtr->nextAdded);
2293 curByte = bufPtr->buf[bufPtr->nextRemoved];
2294 bufPtr->nextRemoved++;
2295 if (curByte == '\r') {
2296 if (chanPtr->flags & INPUT_SAW_CR) {
2297 result[copied] = '\r';
2299 chanPtr->flags |= INPUT_SAW_CR;
2302 } else if (curByte == '\n') {
2303 chanPtr->flags &= (~(INPUT_SAW_CR));
2304 result[copied] = '\n';
2306 if (chanPtr->flags & INPUT_SAW_CR) {
2307 chanPtr->flags &= (~(INPUT_SAW_CR));
2308 result[copied] = '\r';
2311 result[copied] = curByte;
2316 case TCL_TRANSLATE_AUTO:
2323 * Loop over the current buffer, converting "\r" and "\r\n"
2329 (bufPtr->nextRemoved < bufPtr->nextAdded); ) {
2330 curByte = bufPtr->buf[bufPtr->nextRemoved];
2331 bufPtr->nextRemoved++;
2332 if (curByte == '\r') {
2333 result[copied] = '\n';
2335 if (bufPtr->nextRemoved < bufPtr->nextAdded) {
2336 if (bufPtr->buf[bufPtr->nextRemoved] == '\n') {
2337 bufPtr->nextRemoved++;
2339 chanPtr->flags &= (~(INPUT_SAW_CR));
2341 chanPtr->flags |= INPUT_SAW_CR;
2344 if (curByte == '\n') {
2345 if (!(chanPtr->flags & INPUT_SAW_CR)) {
2346 result[copied] = '\n';
2350 result[copied] = curByte;
2353 chanPtr->flags &= (~(INPUT_SAW_CR));
2359 panic("unknown eol translation mode");
2363 * If an in-stream EOF character is set for this channel,, check that
2364 * the input we copied so far does not contain the EOF char. If it does,
2365 * copy only up to and excluding that character.
2368 if (chanPtr->inEofChar != 0) {
2369 for (i = 0; i < copied; i++) {
2370 if (result[i] == (char) chanPtr->inEofChar) {
2377 * Set sticky EOF so that no further input is presented
2381 chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
2384 * Reset the start of valid data in the input buffer to the
2385 * position of the eofChar, so that subsequent reads will
2386 * encounter it immediately. First we set it to the position
2387 * of the last byte consumed if all result bytes were the
2388 * product of one input byte; since it is possible that "\r\n"
2389 * contracted to "\n" in the result, we have to search back
2390 * from that position until we find the eofChar, because it
2391 * is possible that its actual position in the buffer is n
2392 * bytes further back (n is the number of "\r\n" sequences
2393 * that were contracted to "\n" in the result).
2396 bufPtr->nextRemoved -= (copied - i);
2397 while ((bufPtr->nextRemoved > 0) &&
2398 (bufPtr->buf[bufPtr->nextRemoved] !=
2399 (char) chanPtr->inEofChar)) {
2400 bufPtr->nextRemoved--;
2407 * If the current buffer is empty recycle it.
2410 if (bufPtr->nextRemoved == bufPtr->nextAdded) {
2411 chanPtr->inQueueHead = bufPtr->nextPtr;
2412 if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
2413 chanPtr->inQueueTail = (ChannelBuffer *) NULL;
2415 RecycleBuffer(chanPtr, bufPtr, 0);
2419 * Return the number of characters copied into the result buffer.
2420 * This may be different from the number of bytes consumed, because
2421 * of EOL translations.
2428 *----------------------------------------------------------------------
2430 * ScanBufferForEOL --
2432 * Scans one buffer for EOL according to the specified EOL
2433 * translation mode. If it sees the input eofChar for the channel
2437 * TRUE if EOL is found, FALSE otherwise. Also sets output parameter
2438 * bytesToEOLPtr to the number of bytes so far to EOL, and crSeenPtr
2439 * to whether a "\r" was seen.
2444 *----------------------------------------------------------------------
2448 ScanBufferForEOL(chanPtr, bufPtr, translation, eofChar, bytesToEOLPtr,
2451 ChannelBuffer *bufPtr; /* Buffer to scan for EOL. */
2452 Tcl_EolTranslation translation; /* Translation mode to use. */
2453 int eofChar; /* EOF char to look for. */
2454 int *bytesToEOLPtr; /* Running counter. */
2455 int *crSeenPtr; /* Has "\r" been seen? */
2457 char *rPtr; /* Iterates over input string. */
2458 char *sPtr; /* Where to stop search? */
2462 for (EOLFound = 0, rPtr = bufPtr->buf + bufPtr->nextRemoved,
2463 sPtr = bufPtr->buf + bufPtr->nextAdded,
2464 bytesToEOL = *bytesToEOLPtr;
2465 (!EOLFound) && (rPtr < sPtr);
2467 switch (translation) {
2468 case TCL_TRANSLATE_AUTO:
2469 if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
2470 chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
2472 } else if (*rPtr == '\n') {
2475 * CopyAndTranslateBuffer wants to know the length
2476 * of the result, not the input. The input is one
2477 * larger because "\r\n" shrinks to "\n".
2480 if (!(*crSeenPtr)) {
2486 * This is a lf at the begining of a buffer
2487 * where the previous buffer ended in a cr.
2488 * Consume this lf because we've already emitted
2489 * the newline for this crlf sequence. ALSO, if
2490 * bytesToEOL is 0 (which means that we are at the
2491 * first character of the scan), unset the
2492 * INPUT_SAW_CR flag in the channel, because we
2493 * already handled it; leaving it set would cause
2494 * CopyAndTranslateBuffer to potentially consume
2495 * another lf if one follows the current byte.
2498 bufPtr->nextRemoved++;
2500 chanPtr->flags &= (~(INPUT_SAW_CR));
2502 } else if (*rPtr == '\r') {
2510 case TCL_TRANSLATE_LF:
2511 if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
2512 chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
2515 if (*rPtr == '\n') {
2521 case TCL_TRANSLATE_CR:
2522 if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
2523 chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
2526 if (*rPtr == '\r') {
2532 case TCL_TRANSLATE_CRLF:
2533 if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
2534 chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
2536 } else if (*rPtr == '\n') {
2539 * CopyAndTranslateBuffer wants to know the length
2540 * of the result, not the input. The input is one
2541 * larger because crlf shrinks to lf.
2550 if (*rPtr == '\r') {
2559 panic("unknown eol translation mode");
2563 *bytesToEOLPtr = bytesToEOL;
2568 *----------------------------------------------------------------------
2570 * ScanInputForEOL --
2572 * Scans queued input for chanPtr for an end of line (according to the
2573 * current EOL translation mode) and returns the number of bytes
2574 * upto and including the end of line, or -1 if none was found.
2577 * Count of bytes upto and including the end of line if one is present
2578 * or -1 if none was found. Also returns in an output parameter the
2579 * number of bytes queued if no end of line was found.
2584 *----------------------------------------------------------------------
2588 ScanInputForEOL(chanPtr, bytesQueuedPtr)
2589 Channel *chanPtr; /* Channel for which to scan queued
2590 * input for end of line. */
2591 int *bytesQueuedPtr; /* Where to store the number of bytes
2592 * currently queued if no end of line
2595 ChannelBuffer *bufPtr; /* Iterates over queued buffers. */
2596 int bytesToEOL; /* How many bytes to end of line? */
2597 int EOLFound; /* Did we find an end of line? */
2598 int crSeen; /* Did we see a "\r" in CRLF mode? */
2600 *bytesQueuedPtr = 0;
2603 for (bufPtr = chanPtr->inQueueHead,
2604 crSeen = (chanPtr->flags & INPUT_SAW_CR) ? 1 : 0;
2605 (!EOLFound) && (bufPtr != (ChannelBuffer *) NULL);
2606 bufPtr = bufPtr->nextPtr) {
2607 EOLFound = ScanBufferForEOL(chanPtr, bufPtr, chanPtr->inputTranslation,
2608 chanPtr->inEofChar, &bytesToEOL, &crSeen);
2611 if (EOLFound == 0) {
2612 *bytesQueuedPtr = bytesToEOL;
2619 *----------------------------------------------------------------------
2623 * Accumulate input into the channel input buffer queue until an
2624 * end of line has been seen.
2627 * Number of bytes buffered or -1 on failure.
2630 * Consumes input from the channel.
2632 *----------------------------------------------------------------------
2637 Channel *chanPtr; /* Channel to queue input on. */
2639 int result; /* Of getting another buffer from the
2641 int bytesToEOL; /* How many bytes in buffer up to and
2642 * including the end of line? */
2643 int bytesQueued; /* How many bytes are queued currently
2644 * in the input chain of the channel? */
2647 bytesToEOL = ScanInputForEOL(chanPtr, &bytesQueued);
2648 if (bytesToEOL > 0) {
2649 chanPtr->flags &= (~(CHANNEL_BLOCKED));
2652 if (chanPtr->flags & CHANNEL_EOF) {
2654 * Boundary case where cr was at the end of the previous buffer
2655 * and this buffer just has a newline. At EOF our caller wants
2656 * to see -1 for the line length.
2658 return (bytesQueued == 0) ? -1 : bytesQueued ;
2660 if (chanPtr->flags & CHANNEL_BLOCKED) {
2661 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
2664 chanPtr->flags &= (~(CHANNEL_BLOCKED));
2666 result = GetInput(chanPtr);
2668 if (result == EAGAIN) {
2669 chanPtr->flags |= CHANNEL_BLOCKED;
2677 *----------------------------------------------------------------------
2681 * Reads a given number of characters from a channel.
2684 * The number of characters read, or -1 on error. Use Tcl_GetErrno()
2685 * to retrieve the error code for the error that occurred.
2688 * May cause input to be buffered.
2690 *----------------------------------------------------------------------
2694 Tcl_Read(chan, bufPtr, toRead)
2695 Tcl_Channel chan; /* The channel from which to read. */
2696 char *bufPtr; /* Where to store input read. */
2697 int toRead; /* Maximum number of characters to read. */
2699 Channel *chanPtr; /* The real IO channel. */
2700 int copied; /* How many characters were copied into
2701 * the result string? */
2702 int copiedNow; /* How many characters were copied from
2703 * the current input buffer? */
2704 int result; /* Of calling GetInput. */
2706 chanPtr = (Channel *) chan;
2709 * Check for unreported error.
2712 if (chanPtr->unreportedError != 0) {
2713 Tcl_SetErrno(chanPtr->unreportedError);
2714 chanPtr->unreportedError = 0;
2719 * Punt if the channel is not opened for reading.
2722 if (!(chanPtr->flags & TCL_READABLE)) {
2723 Tcl_SetErrno(EACCES);
2728 * If we have not encountered a sticky EOF, clear the EOF bit. Either
2729 * way clear the BLOCKED bit. We want to discover these anew during
2733 if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
2734 chanPtr->flags &= (~(CHANNEL_EOF));
2736 chanPtr->flags &= (~(CHANNEL_BLOCKED));
2738 for (copied = 0; copied < toRead; copied += copiedNow) {
2739 copiedNow = CopyAndTranslateBuffer(chanPtr, bufPtr + copied,
2741 if (copiedNow == 0) {
2742 if (chanPtr->flags & CHANNEL_EOF) {
2745 if (chanPtr->flags & CHANNEL_BLOCKED) {
2746 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
2749 chanPtr->flags &= (~(CHANNEL_BLOCKED));
2751 result = GetInput(chanPtr);
2753 if (result == EAGAIN) {
2760 chanPtr->flags &= (~(CHANNEL_BLOCKED));
2765 *----------------------------------------------------------------------
2769 * Reads a complete line of input from the channel.
2772 * Length of line read or -1 if error, EOF or blocked. If -1, use
2773 * Tcl_GetErrno() to retrieve the POSIX error code for the
2774 * error or condition that occurred.
2777 * May flush output on the channel. May cause input to be
2778 * consumed from the channel.
2780 *----------------------------------------------------------------------
2784 Tcl_Gets(chan, lineRead)
2785 Tcl_Channel chan; /* Channel from which to read. */
2786 Tcl_DString *lineRead; /* The characters of the line read
2787 * (excluding the terminating newline if
2788 * present) will be appended to this
2789 * DString. The caller must have initialized
2790 * it and is responsible for managing the
2793 Channel *chanPtr; /* The channel to read from. */
2794 char *buf; /* Points into DString where data
2795 * will be stored. */
2796 int offset; /* Offset from start of DString at
2797 * which to append the line just read. */
2798 int copiedTotal; /* Accumulates total length of input copied. */
2799 int copiedNow; /* How many bytes were copied from the
2800 * current input buffer? */
2801 int lineLen; /* Length of line read, including the
2802 * translated newline. If this is zero
2803 * and neither EOF nor BLOCKED is set,
2804 * the current line is empty. */
2806 chanPtr = (Channel *) chan;
2809 * Check for unreported error.
2812 if (chanPtr->unreportedError != 0) {
2813 Tcl_SetErrno(chanPtr->unreportedError);
2814 chanPtr->unreportedError = 0;
2819 * Punt if the channel is not opened for reading.
2822 if (!(chanPtr->flags & TCL_READABLE)) {
2823 Tcl_SetErrno(EACCES);
2828 * If we have not encountered a sticky EOF, clear the EOF bit
2829 * (sticky EOF is set if we have seen the input eofChar, to prevent
2830 * reading beyond the eofChar). Also, always clear the BLOCKED bit.
2831 * We want to discover these conditions anew in each operation.
2834 if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
2835 chanPtr->flags &= (~(CHANNEL_EOF));
2837 chanPtr->flags &= (~(CHANNEL_BLOCKED));
2838 lineLen = GetEOL(chanPtr);
2843 if (chanPtr->flags & (CHANNEL_EOF | CHANNEL_BLOCKED)) {
2848 offset = Tcl_DStringLength(lineRead);
2849 Tcl_DStringSetLength(lineRead, lineLen + offset);
2850 buf = Tcl_DStringValue(lineRead) + offset;
2852 for (copiedTotal = 0; copiedTotal < lineLen; copiedTotal += copiedNow) {
2853 copiedNow = CopyAndTranslateBuffer(chanPtr, buf + copiedTotal,
2854 lineLen - copiedTotal);
2856 if ((copiedTotal > 0) && (buf[copiedTotal - 1] == '\n')) {
2859 Tcl_DStringSetLength(lineRead, copiedTotal + offset);
2864 *----------------------------------------------------------------------
2868 * Implements seeking on Tcl Channels. This is a public function
2869 * so that other C facilities may be implemented on top of it.
2872 * The new access point or -1 on error. If error, use Tcl_GetErrno()
2873 * to retrieve the POSIX error code for the error that occurred.
2876 * May flush output on the channel. May discard queued input.
2878 *----------------------------------------------------------------------
2882 Tcl_Seek(chan, offset, mode)
2883 Tcl_Channel chan; /* The channel on which to seek. */
2884 int offset; /* Offset to seek to. */
2885 int mode; /* Relative to which location to seek? */
2887 Channel *chanPtr; /* The real IO channel. */
2888 ChannelBuffer *bufPtr; /* Iterates over queued input
2889 * and output buffers. */
2890 int inputBuffered, outputBuffered;
2891 int result; /* Of device driver operations. */
2892 int curPos; /* Position on the device. */
2893 int wasAsync; /* Was the channel nonblocking before the
2894 * seek operation? If so, must restore to
2895 * nonblocking mode after the seek. */
2897 chanPtr = (Channel *) chan;
2900 * Check for unreported error.
2903 if (chanPtr->unreportedError != 0) {
2904 Tcl_SetErrno(chanPtr->unreportedError);
2905 chanPtr->unreportedError = 0;
2910 * Disallow seek on channels that are open for neither writing nor
2911 * reading (e.g. socket server channels).
2914 if (!(chanPtr->flags & (TCL_WRITABLE|TCL_READABLE))) {
2915 Tcl_SetErrno(EACCES);
2920 * Disallow seek on channels whose type does not have a seek procedure
2921 * defined. This means that the channel does not support seeking.
2924 if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
2925 Tcl_SetErrno(EINVAL);
2930 * Compute how much input and output is buffered. If both input and
2931 * output is buffered, cannot compute the current position.
2934 for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
2935 bufPtr != (ChannelBuffer *) NULL;
2936 bufPtr = bufPtr->nextPtr) {
2937 inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
2939 for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
2940 bufPtr != (ChannelBuffer *) NULL;
2941 bufPtr = bufPtr->nextPtr) {
2942 outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
2944 if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
2945 (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
2946 chanPtr->flags |= BUFFER_READY;
2948 (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
2950 if ((inputBuffered != 0) && (outputBuffered != 0)) {
2951 Tcl_SetErrno(EFAULT);
2956 * If we are seeking relative to the current position, compute the
2957 * corrected offset taking into account the amount of unread input.
2960 if (mode == SEEK_CUR) {
2961 offset -= inputBuffered;
2965 * Discard any queued input - this input should not be read after
2969 DiscardInputQueued(chanPtr, 0);
2972 * Reset EOF and BLOCKED flags. We invalidate them by moving the
2973 * access point. Also clear CR related flags.
2977 (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR));
2980 * If the channel is in asynchronous output mode, switch it back
2981 * to synchronous mode and cancel any async flush that may be
2982 * scheduled. After the flush, the channel will be put back into
2983 * asynchronous output mode.
2987 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
2990 if (chanPtr->typePtr->blockModeProc != NULL) {
2991 result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
2992 chanPtr->inFile, chanPtr->outFile, TCL_MODE_BLOCKING);
2995 Tcl_SetErrno(result);
2998 chanPtr->flags &= (~(CHANNEL_NONBLOCKING));
2999 if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
3000 Tcl_DeleteFileHandler(chanPtr->outFile);
3001 chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
3006 * If the flush fails we cannot recover the original position. In
3007 * that case the seek is not attempted because we do not know where
3008 * the access position is - instead we return the error. FlushChannel
3009 * has already called Tcl_SetErrno() to report the error upwards.
3010 * If the flush succeeds we do the seek also.
3013 if (FlushChannel(NULL, chanPtr, 0) != 0) {
3018 * Now seek to the new position in the channel as requested by the
3022 curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
3023 chanPtr->inFile, chanPtr->outFile, (long) offset,
3026 Tcl_SetErrno(result);
3031 * Restore to nonblocking mode if that was the previous behavior.
3033 * NOTE: Even if there was an async flush active we do not restore
3034 * it now because we already flushed all the queued output, above.
3038 chanPtr->flags |= CHANNEL_NONBLOCKING;
3040 if (chanPtr->typePtr->blockModeProc != NULL) {
3041 result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
3042 chanPtr->inFile, chanPtr->outFile, TCL_MODE_NONBLOCKING);
3045 Tcl_SetErrno(result);
3054 *----------------------------------------------------------------------
3058 * Returns the position of the next character to be read/written on
3062 * A nonnegative integer on success, -1 on failure. If failed,
3063 * use Tcl_GetErrno() to retrieve the POSIX error code for the
3064 * error that occurred.
3069 *----------------------------------------------------------------------
3074 Tcl_Channel chan; /* The channel to return pos for. */
3076 Channel *chanPtr; /* The actual channel to tell on. */
3077 ChannelBuffer *bufPtr; /* Iterates over queued input
3078 * and output buffers. */
3079 int inputBuffered, outputBuffered;
3080 int result; /* Of calling device driver. */
3081 int curPos; /* Position on device. */
3083 chanPtr = (Channel *) chan;
3086 * Check for unreported error.
3089 if (chanPtr->unreportedError != 0) {
3090 Tcl_SetErrno(chanPtr->unreportedError);
3091 chanPtr->unreportedError = 0;
3096 * Disallow tell on channels that are open for neither
3097 * writing nor reading (e.g. socket server channels).
3100 if (!(chanPtr->flags & (TCL_WRITABLE|TCL_READABLE))) {
3101 Tcl_SetErrno(EACCES);
3106 * Disallow tell on channels whose type does not have a seek procedure
3107 * defined. This means that the channel does not support seeking.
3110 if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
3111 Tcl_SetErrno(EINVAL);
3116 * Compute how much input and output is buffered. If both input and
3117 * output is buffered, cannot compute the current position.
3120 for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
3121 bufPtr != (ChannelBuffer *) NULL;
3122 bufPtr = bufPtr->nextPtr) {
3123 inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
3125 for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
3126 bufPtr != (ChannelBuffer *) NULL;
3127 bufPtr = bufPtr->nextPtr) {
3128 outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
3130 if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
3132 (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
3134 if ((inputBuffered != 0) && (outputBuffered != 0)) {
3135 Tcl_SetErrno(EFAULT);
3140 * Get the current position in the device and compute the position
3141 * where the next character will be read or written.
3144 curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
3145 chanPtr->inFile, chanPtr->outFile, (long) 0, SEEK_CUR, &result);
3147 Tcl_SetErrno(result);
3150 if (inputBuffered != 0) {
3151 return (curPos - inputBuffered);
3153 return (curPos + outputBuffered);
3157 *----------------------------------------------------------------------
3161 * Returns 1 if the channel is at EOF, 0 otherwise.
3169 *----------------------------------------------------------------------
3174 Tcl_Channel chan; /* Does this channel have EOF? */
3176 Channel *chanPtr; /* The real channel structure. */
3178 chanPtr = (Channel *) chan;
3179 return ((chanPtr->flags & CHANNEL_STICKY_EOF) ||
3180 ((chanPtr->flags & CHANNEL_EOF) && (Tcl_InputBuffered(chan) == 0)))
3185 *----------------------------------------------------------------------
3187 * Tcl_InputBlocked --
3189 * Returns 1 if input is blocked on this channel, 0 otherwise.
3197 *----------------------------------------------------------------------
3201 Tcl_InputBlocked(chan)
3202 Tcl_Channel chan; /* Is this channel blocked? */
3204 Channel *chanPtr; /* The real channel structure. */
3206 chanPtr = (Channel *) chan;
3207 return (chanPtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
3211 *----------------------------------------------------------------------
3213 * Tcl_InputBuffered --
3215 * Returns the number of bytes of input currently buffered in the
3216 * internal buffer of a channel.
3219 * The number of input bytes buffered, or zero if the channel is not
3225 *----------------------------------------------------------------------
3229 Tcl_InputBuffered(chan)
3230 Tcl_Channel chan; /* The channel to query. */
3234 ChannelBuffer *bufPtr;
3236 chanPtr = (Channel *) chan;
3237 for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;
3238 bufPtr != (ChannelBuffer *) NULL;
3239 bufPtr = bufPtr->nextPtr) {
3240 bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
3242 return bytesBuffered;
3246 *----------------------------------------------------------------------
3248 * Tcl_SetChannelBufferSize --
3250 * Sets the size of buffers to allocate to store input or output
3251 * in the channel. The size must be between 10 bytes and 1 MByte.
3257 * Sets the size of buffers subsequently allocated for this channel.
3259 *----------------------------------------------------------------------
3263 Tcl_SetChannelBufferSize(chan, sz)
3264 Tcl_Channel chan; /* The channel whose buffer size
3266 int sz; /* The size to set. */
3271 sz = CHANNELBUFFER_DEFAULT_SIZE;
3275 * Allow only buffers that are smaller than one megabyte.
3278 if (sz > (1024 * 1024)) {
3279 sz = CHANNELBUFFER_DEFAULT_SIZE;
3282 chanPtr = (Channel *) chan;
3283 chanPtr->bufSize = sz;
3287 *----------------------------------------------------------------------
3289 * Tcl_GetChannelBufferSize --
3291 * Retrieves the size of buffers to allocate for this channel.
3299 *----------------------------------------------------------------------
3303 Tcl_GetChannelBufferSize(chan)
3304 Tcl_Channel chan; /* The channel for which to find the
3309 chanPtr = (Channel *) chan;
3310 return chanPtr->bufSize;
3314 *----------------------------------------------------------------------
3316 * Tcl_GetChannelOption --
3318 * Gets a mode associated with an IO channel. If the optionName arg
3319 * is non NULL, retrieves the value of that option. If the optionName
3320 * arg is NULL, retrieves a list of alternating option names and
3321 * values for the given channel.
3324 * A standard Tcl result. Also sets the supplied DString to the
3325 * string value of the option(s) returned.
3328 * The string returned by this function is in static storage and
3329 * may be reused at any time subsequent to the call.
3331 *----------------------------------------------------------------------
3335 Tcl_GetChannelOption(chan, optionName, dsPtr)
3336 Tcl_Channel chan; /* Channel on which to get option. */
3337 char *optionName; /* Option to get. */
3338 Tcl_DString *dsPtr; /* Where to store value(s). */
3340 Channel *chanPtr; /* The real IO channel. */
3341 size_t len; /* Length of optionName string. */
3343 chanPtr = (Channel *) chan;
3346 * If the optionName is NULL it means that we want a list of all
3347 * options and values.
3350 if (optionName == (char *) NULL) {
3353 len = strlen(optionName);
3356 if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&
3357 (strncmp(optionName, "-blocking", len) == 0))) {
3359 Tcl_DStringAppendElement(dsPtr, "-blocking");
3361 Tcl_DStringAppendElement(dsPtr,
3362 (chanPtr->flags & CHANNEL_NONBLOCKING) ? "0" : "1");
3367 if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
3368 (strncmp(optionName, "-buffering", len) == 0))) {
3370 Tcl_DStringAppendElement(dsPtr, "-buffering");
3372 if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
3373 Tcl_DStringAppendElement(dsPtr, "line");
3374 } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
3375 Tcl_DStringAppendElement(dsPtr, "none");
3377 Tcl_DStringAppendElement(dsPtr, "full");
3383 if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
3384 (strncmp(optionName, "-buffersize", len) == 0))) {
3386 Tcl_DStringAppendElement(dsPtr, "-buffersize");
3388 sprintf(optionVal, "%d", chanPtr->bufSize);
3389 Tcl_DStringAppendElement(dsPtr, optionVal);
3395 ((len > 1) && (optionName[1] == 'e') &&
3396 (strncmp(optionName, "-eofchar", len) == 0))) {
3398 Tcl_DStringAppendElement(dsPtr, "-eofchar");
3400 if ((chanPtr->flags & (TCL_READABLE|TCL_WRITABLE)) ==
3401 (TCL_READABLE|TCL_WRITABLE)) {
3402 Tcl_DStringStartSublist(dsPtr);
3404 if (chanPtr->flags & TCL_READABLE) {
3405 if (chanPtr->inEofChar == 0) {
3406 Tcl_DStringAppendElement(dsPtr, "");
3410 sprintf(buf, "%c", chanPtr->inEofChar);
3411 Tcl_DStringAppendElement(dsPtr, buf);
3414 if (chanPtr->flags & TCL_WRITABLE) {
3415 if (chanPtr->outEofChar == 0) {
3416 Tcl_DStringAppendElement(dsPtr, "");
3420 sprintf(buf, "%c", chanPtr->outEofChar);
3421 Tcl_DStringAppendElement(dsPtr, buf);
3424 if ((chanPtr->flags & (TCL_READABLE|TCL_WRITABLE)) ==
3425 (TCL_READABLE|TCL_WRITABLE)) {
3426 Tcl_DStringEndSublist(dsPtr);
3433 ((len > 1) && (optionName[1] == 't') &&
3434 (strncmp(optionName, "-translation", len) == 0))) {
3436 Tcl_DStringAppendElement(dsPtr, "-translation");
3438 if ((chanPtr->flags & (TCL_READABLE|TCL_WRITABLE)) ==
3439 (TCL_READABLE|TCL_WRITABLE)) {
3440 Tcl_DStringStartSublist(dsPtr);
3442 if (chanPtr->flags & TCL_READABLE) {
3443 if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
3444 Tcl_DStringAppendElement(dsPtr, "auto");
3445 } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
3446 Tcl_DStringAppendElement(dsPtr, "cr");
3447 } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
3448 Tcl_DStringAppendElement(dsPtr, "crlf");
3450 Tcl_DStringAppendElement(dsPtr, "lf");
3453 if (chanPtr->flags & TCL_WRITABLE) {
3454 if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
3455 Tcl_DStringAppendElement(dsPtr, "auto");
3456 } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
3457 Tcl_DStringAppendElement(dsPtr, "cr");
3458 } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
3459 Tcl_DStringAppendElement(dsPtr, "crlf");
3461 Tcl_DStringAppendElement(dsPtr, "lf");
3464 if ((chanPtr->flags & (TCL_READABLE|TCL_WRITABLE)) ==
3465 (TCL_READABLE|TCL_WRITABLE)) {
3466 Tcl_DStringEndSublist(dsPtr);
3472 if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) {
3473 return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
3479 Tcl_SetErrno(EINVAL);
3484 *----------------------------------------------------------------------
3486 * Tcl_SetChannelOption --
3488 * Sets an option on a channel.
3491 * A standard Tcl result. Also sets interp->result on error if
3492 * interp is not NULL.
3495 * May modify an option on a device.
3497 *----------------------------------------------------------------------
3501 Tcl_SetChannelOption(interp, chan, optionName, newValue)
3502 Tcl_Interp *interp; /* For error reporting - can be NULL. */
3503 Tcl_Channel chan; /* Channel on which to set mode. */
3504 char *optionName; /* Which option to set? */
3505 char *newValue; /* New value for option. */
3507 int result; /* Result of channel type operation. */
3508 int newMode; /* New (numeric) mode to sert. */
3509 Channel *chanPtr; /* The real IO channel. */
3510 size_t len; /* Length of optionName string. */
3514 chanPtr = (Channel *) chan;
3516 len = strlen(optionName);
3518 if ((len > 2) && (optionName[1] == 'b') &&
3519 (strncmp(optionName, "-blocking", len) == 0)) {
3520 if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
3524 newMode = TCL_MODE_BLOCKING;
3526 newMode = TCL_MODE_NONBLOCKING;
3529 if (chanPtr->typePtr->blockModeProc != NULL) {
3530 result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
3531 chanPtr->inFile, chanPtr->outFile, newMode);
3534 Tcl_SetErrno(result);
3535 if (interp != (Tcl_Interp *) NULL) {
3536 Tcl_AppendResult(interp, "error setting blocking mode: ",
3537 Tcl_PosixError(interp), (char *) NULL);
3541 if (newMode == TCL_MODE_BLOCKING) {
3542 chanPtr->flags &= (~(CHANNEL_NONBLOCKING));
3543 if (chanPtr->outFile != (Tcl_File) NULL) {
3544 Tcl_DeleteFileHandler(chanPtr->outFile);
3545 chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
3548 chanPtr->flags |= CHANNEL_NONBLOCKING;
3553 if ((len > 7) && (optionName[1] == 'b') &&
3554 (strncmp(optionName, "-buffering", len) == 0)) {
3555 len = strlen(newValue);
3556 if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
3558 (~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));
3559 } else if ((newValue[0] == 'l') &&
3560 (strncmp(newValue, "line", len) == 0)) {
3561 chanPtr->flags &= (~(CHANNEL_UNBUFFERED));
3562 chanPtr->flags |= CHANNEL_LINEBUFFERED;
3563 } else if ((newValue[0] == 'n') &&
3564 (strncmp(newValue, "none", len) == 0)) {
3565 chanPtr->flags &= (~(CHANNEL_LINEBUFFERED));
3566 chanPtr->flags |= CHANNEL_UNBUFFERED;
3568 if (interp != (Tcl_Interp *) NULL) {
3569 Tcl_AppendResult(interp, "bad value for -buffering: ",
3570 "must be one of full, line, or none",
3578 if ((len > 7) && (optionName[1] == 'b') &&
3579 (strncmp(optionName, "-buffersize", len) == 0)) {
3580 chanPtr->bufSize = atoi(newValue);
3581 if ((chanPtr->bufSize < 10) || (chanPtr->bufSize > (1024 * 1024))) {
3582 chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
3587 if ((len > 1) && (optionName[1] == 'e') &&
3588 (strncmp(optionName, "-eofchar", len) == 0)) {
3589 if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
3593 chanPtr->inEofChar = 0;
3594 chanPtr->outEofChar = 0;
3595 } else if (argc == 1) {
3596 if (chanPtr->flags & TCL_WRITABLE) {
3597 chanPtr->outEofChar = (int) argv[0][0];
3599 if (chanPtr->flags & TCL_READABLE) {
3600 chanPtr->inEofChar = (int) argv[0][0];
3602 } else if (argc != 2) {
3603 if (interp != (Tcl_Interp *) NULL) {
3604 Tcl_AppendResult(interp,
3605 "bad value for -eofchar: should be a list of one or",
3606 " two elements", (char *) NULL);
3608 ckfree((char *) argv);
3611 if (chanPtr->flags & TCL_READABLE) {
3612 chanPtr->inEofChar = (int) argv[0][0];
3614 if (chanPtr->flags & TCL_WRITABLE) {
3615 chanPtr->outEofChar = (int) argv[1][0];
3618 if (argv != (char **) NULL) {
3619 ckfree((char *) argv);
3624 if ((len > 1) && (optionName[1] == 't') &&
3625 (strncmp(optionName, "-translation", len) == 0)) {
3626 if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
3630 if (chanPtr->flags & TCL_READABLE) {
3631 chanPtr->flags &= (~(INPUT_SAW_CR));
3632 if (strcmp(argv[0], "auto") == 0) {
3633 chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
3634 } else if (strcmp(argv[0], "binary") == 0) {
3635 chanPtr->inEofChar = 0;
3636 chanPtr->inputTranslation = TCL_TRANSLATE_LF;
3637 } else if (strcmp(argv[0], "lf") == 0) {
3638 chanPtr->inputTranslation = TCL_TRANSLATE_LF;
3639 } else if (strcmp(argv[0], "cr") == 0) {
3640 chanPtr->inputTranslation = TCL_TRANSLATE_CR;
3641 } else if (strcmp(argv[0], "crlf") == 0) {
3642 chanPtr->inputTranslation = TCL_TRANSLATE_CRLF;
3643 } else if (strcmp(argv[0], "platform") == 0) {
3644 chanPtr->inputTranslation = TCL_PLATFORM_TRANSLATION;
3646 if (interp != (Tcl_Interp *) NULL) {
3647 Tcl_AppendResult(interp,
3648 "bad value for -translation: ",
3649 "must be one of auto, binary, cr, lf, crlf,",
3650 " or platform", (char *) NULL);
3652 ckfree((char *) argv);
3656 if (chanPtr->flags & TCL_WRITABLE) {
3657 if (strcmp(argv[0], "auto") == 0) {
3659 * This is a hack to get TCP sockets to produce output
3660 * in CRLF mode if they are being set into AUTO mode.
3661 * A better solution for achieving this effect will be
3665 if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {
3666 chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
3668 chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
3670 } else if (strcmp(argv[0], "binary") == 0) {
3671 chanPtr->outEofChar = 0;
3672 chanPtr->outputTranslation = TCL_TRANSLATE_LF;
3673 } else if (strcmp(argv[0], "lf") == 0) {
3674 chanPtr->outputTranslation = TCL_TRANSLATE_LF;
3675 } else if (strcmp(argv[0], "cr") == 0) {
3676 chanPtr->outputTranslation = TCL_TRANSLATE_CR;
3677 } else if (strcmp(argv[0], "crlf") == 0) {
3678 chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
3679 } else if (strcmp(argv[0], "platform") == 0) {
3680 chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
3682 if (interp != (Tcl_Interp *) NULL) {
3683 Tcl_AppendResult(interp,
3684 "bad value for -translation: ",
3685 "must be one of auto, binary, cr, lf, crlf,",
3686 " or platform", (char *) NULL);
3688 ckfree((char *) argv);
3692 } else if (argc != 2) {
3693 if (interp != (Tcl_Interp *) NULL) {
3694 Tcl_AppendResult(interp,
3695 "bad value for -translation: must be a one or two",
3696 " element list", (char *) NULL);
3698 ckfree((char *) argv);
3701 if (chanPtr->flags & TCL_READABLE) {
3702 if (argv[0][0] == '\0') {
3704 } else if (strcmp(argv[0], "auto") == 0) {
3705 chanPtr->flags &= (~(INPUT_SAW_CR));
3706 chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
3707 } else if (strcmp(argv[0], "binary") == 0) {
3708 chanPtr->inEofChar = 0;
3709 chanPtr->flags &= (~(INPUT_SAW_CR));
3710 chanPtr->inputTranslation = TCL_TRANSLATE_LF;
3711 } else if (strcmp(argv[0], "lf") == 0) {
3712 chanPtr->flags &= (~(INPUT_SAW_CR));
3713 chanPtr->inputTranslation = TCL_TRANSLATE_LF;
3714 } else if (strcmp(argv[0], "cr") == 0) {
3715 chanPtr->flags &= (~(INPUT_SAW_CR));
3716 chanPtr->inputTranslation = TCL_TRANSLATE_CR;
3717 } else if (strcmp(argv[0], "crlf") == 0) {
3718 chanPtr->flags &= (~(INPUT_SAW_CR));
3719 chanPtr->inputTranslation = TCL_TRANSLATE_CRLF;
3720 } else if (strcmp(argv[0], "platform") == 0) {
3721 chanPtr->flags &= (~(INPUT_SAW_CR));
3722 chanPtr->inputTranslation = TCL_PLATFORM_TRANSLATION;
3724 if (interp != (Tcl_Interp *) NULL) {
3725 Tcl_AppendResult(interp,
3726 "bad value for -translation: ",
3727 "must be one of auto, binary, cr, lf, crlf,",
3728 " or platform", (char *) NULL);
3730 ckfree((char *) argv);
3734 if (chanPtr->flags & TCL_WRITABLE) {
3735 if (argv[1][0] == '\0') {
3737 } else if (strcmp(argv[1], "auto") == 0) {
3739 * This is a hack to get TCP sockets to produce output
3740 * in CRLF mode if they are being set into AUTO mode.
3741 * A better solution for achieving this effect will be
3745 if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {
3746 chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
3748 chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
3750 } else if (strcmp(argv[1], "binary") == 0) {
3751 chanPtr->outEofChar = 0;
3752 chanPtr->outputTranslation = TCL_TRANSLATE_LF;
3753 } else if (strcmp(argv[1], "lf") == 0) {
3754 chanPtr->outputTranslation = TCL_TRANSLATE_LF;
3755 } else if (strcmp(argv[1], "cr") == 0) {
3756 chanPtr->outputTranslation = TCL_TRANSLATE_CR;
3757 } else if (strcmp(argv[1], "crlf") == 0) {
3758 chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
3759 } else if (strcmp(argv[1], "platform") == 0) {
3760 chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
3762 if (interp != (Tcl_Interp *) NULL) {
3763 Tcl_AppendResult(interp,
3764 "bad value for -translation: ",
3765 "must be one of auto, binary, cr, lf, crlf,",
3766 " or platform", (char *) NULL);
3768 ckfree((char *) argv);
3773 ckfree((char *) argv);
3777 if (chanPtr->typePtr->setOptionProc != (Tcl_DriverSetOptionProc *) NULL) {
3778 return (chanPtr->typePtr->setOptionProc) (chanPtr->instanceData,
3779 interp, optionName, newValue);
3782 if (interp != (Tcl_Interp *) NULL) {
3783 Tcl_AppendResult(interp, "bad option \"", optionName,
3784 "\": should be -blocking, -buffering, -buffersize, ",
3785 "-eofchar, -translation, ",
3786 "or channel type specific option",
3794 *----------------------------------------------------------------------
3796 * ChannelEventSourceExitProc --
3798 * This procedure is called during exit cleanup to delete the channel
3799 * event source. It deletes the event source for channels.
3805 * Destroys the channel event source.
3807 *----------------------------------------------------------------------
3812 ChannelEventSourceExitProc(clientData)
3813 ClientData clientData; /* Not used. */
3815 Tcl_DeleteEventSource(ChannelHandlerSetupProc, ChannelHandlerCheckProc,
3817 channelEventSourceCreated = 0;
3821 *----------------------------------------------------------------------
3823 * ChannelHandlerSetupProc --
3825 * This procedure is part of the event source for channel handlers.
3826 * It is invoked by Tcl_DoOneEvent before it waits for events. The
3827 * job of this procedure is to provide information to Tcl_DoOneEvent
3828 * on how to wait for events (what files to watch).
3834 * Tells the notifier what channels to watch.
3836 *----------------------------------------------------------------------
3840 ChannelHandlerSetupProc(clientData, flags)
3841 ClientData clientData; /* Not used. */
3842 int flags; /* Flags passed to Tk_DoOneEvent:
3843 * if it doesn't include
3844 * TCL_FILE_EVENTS then we do
3848 Channel *chanPtr, *nextChanPtr;
3850 if (!(flags & TCL_FILE_EVENTS)) {
3854 dontBlock.sec = 0; dontBlock.usec = 0;
3856 for (chanPtr = firstChanPtr; chanPtr != (Channel *) NULL;
3857 chanPtr = nextChanPtr) {
3858 nextChanPtr = chanPtr->nextChanPtr;
3859 if (chanPtr->interestMask & TCL_READABLE) {
3860 if ((!(chanPtr->flags & CHANNEL_BLOCKED)) &&
3861 (chanPtr->inQueueHead != (ChannelBuffer *) NULL) &&
3862 (chanPtr->inQueueHead->nextRemoved <
3863 chanPtr->inQueueHead->nextAdded)) {
3864 Tcl_SetMaxBlockTime(&dontBlock);
3865 } else if (chanPtr->inFile != (Tcl_File) NULL) {
3866 Tcl_WatchFile(chanPtr->inFile, TCL_READABLE);
3869 if (chanPtr->interestMask & TCL_WRITABLE) {
3870 if (chanPtr->outFile != (Tcl_File) NULL) {
3871 Tcl_WatchFile(chanPtr->outFile, TCL_WRITABLE);
3874 if (chanPtr->interestMask & TCL_EXCEPTION) {
3875 if (chanPtr->inFile != (Tcl_File) NULL) {
3876 Tcl_WatchFile(chanPtr->inFile, TCL_EXCEPTION);
3878 if (chanPtr->outFile != (Tcl_File) NULL) {
3879 Tcl_WatchFile(chanPtr->outFile, TCL_EXCEPTION);
3886 *----------------------------------------------------------------------
3888 * ChannelHandlerCheckProc --
3890 * This procedure is the second part (of three) of the event source
3891 * for channels. It is invoked by Tcl_DoOneEvent after the wait for
3892 * events is over. The job of this procedure is to test each channel
3893 * to see if it is ready now, and if so, to create events and put them
3894 * on the Tcl event queue.
3900 * Makes entries on the Tcl event queue for each channel that is
3903 *----------------------------------------------------------------------
3907 ChannelHandlerCheckProc(clientData, flags)
3908 ClientData clientData; /* Not used. */
3909 int flags; /* Flags passed to Tk_DoOneEvent:
3910 * if it doesn't include
3911 * TCL_FILE_EVENTS then we do
3914 Channel *chanPtr, *nextChanPtr;
3915 ChannelHandlerEvent *ePtr;
3918 if (!(flags & TCL_FILE_EVENTS)) {
3922 for (chanPtr = firstChanPtr;
3923 chanPtr != (Channel *) NULL;
3924 chanPtr = nextChanPtr) {
3925 nextChanPtr = chanPtr->nextChanPtr;
3930 * Check for readability.
3933 if (chanPtr->interestMask & TCL_READABLE) {
3936 * The channel is considered ready for reading if there is input
3937 * buffered AND the last attempt to read from the channel did not
3938 * return EWOULDBLOCK, OR if the underlying file is ready.
3940 * NOTE that the input queue may contain empty buffers, hence the
3941 * special check to see if the first input buffer is empty. The
3942 * invariant is that if there is an empty buffer in the queue
3943 * there is only one buffer in the queue, hence an empty first
3944 * buffer indicates that there is no input queued.
3947 if ((!(chanPtr->flags & CHANNEL_BLOCKED)) &&
3948 ((chanPtr->inQueueHead != (ChannelBuffer *) NULL) &&
3949 (chanPtr->inQueueHead->nextRemoved <
3950 chanPtr->inQueueHead->nextAdded))) {
3951 readyMask |= TCL_READABLE;
3952 } else if (chanPtr->inFile != (Tcl_File) NULL) {
3954 Tcl_FileReady(chanPtr->inFile, TCL_READABLE);
3959 * Check for writability.
3962 if (chanPtr->interestMask & TCL_WRITABLE) {
3965 * The channel is considered ready for writing if there is no
3966 * output buffered waiting to be written to the device, AND the
3967 * underlying file is ready.
3970 if ((chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
3971 (chanPtr->outFile != (Tcl_File) NULL)) {
3973 Tcl_FileReady(chanPtr->outFile, TCL_WRITABLE);
3978 * Check for exceptions.
3981 if (chanPtr->interestMask & TCL_EXCEPTION) {
3982 if (chanPtr->inFile != (Tcl_File) NULL) {
3984 Tcl_FileReady(chanPtr->inFile, TCL_EXCEPTION);
3986 if (chanPtr->outFile != (Tcl_File) NULL) {
3988 Tcl_FileReady(chanPtr->outFile, TCL_EXCEPTION);
3993 * If there are any events for this channel, put a notice into the
3997 if (readyMask != 0) {
3998 ePtr = (ChannelHandlerEvent *) ckalloc((unsigned)
3999 sizeof(ChannelHandlerEvent));
4000 ePtr->header.proc = ChannelHandlerEventProc;
4001 ePtr->chanPtr = chanPtr;
4002 ePtr->readyMask = readyMask;
4003 Tcl_QueueEvent((Tcl_Event *) ePtr, TCL_QUEUE_TAIL);
4009 *----------------------------------------------------------------------
4013 * This routine dispatches a background flush event.
4015 * Errors that occur during the write operation are stored
4016 * inside the channel structure for future reporting by the next
4017 * operation that uses this channel.
4023 * Causes production of output on a channel.
4025 *----------------------------------------------------------------------
4029 FlushEventProc(clientData, mask)
4030 ClientData clientData; /* Channel to produce output on. */
4031 int mask; /* Not used. */
4033 (void) FlushChannel(NULL, (Channel *) clientData, 1);
4037 *----------------------------------------------------------------------
4039 * ChannelHandlerEventProc --
4041 * This procedure is called by Tcl_DoOneEvent when a channel event
4042 * reaches the front of the event queue. This procedure is responsible
4043 * for actually handling the event by invoking the callback for the
4047 * Returns 1 if the event was handled, meaning that it should be
4048 * removed from the queue. Returns 0 if the event was not handled
4049 * meaning that it should stay in the queue. The only time the event
4050 * will not be handled is if the TCL_FILE_EVENTS flag bit is not
4051 * set in the flags passed.
4053 * NOTE: If the handler is deleted between the time the event is added
4054 * to the queue and the time it reaches the head of the queue, the
4055 * event is silently discarded (i.e. we return 1).
4058 * Whatever the channel handler callback procedure does.
4060 *----------------------------------------------------------------------
4064 ChannelHandlerEventProc(evPtr, flags)
4065 Tcl_Event *evPtr; /* Event to service. */
4066 int flags; /* Flags that indicate what events to
4067 * handle, such as TCL_FILE_EVENTS. */
4070 ChannelHandler *chPtr;
4071 ChannelHandlerEvent *ePtr;
4072 NextChannelHandler nh;
4074 if (!(flags & TCL_FILE_EVENTS)) {
4078 ePtr = (ChannelHandlerEvent *) evPtr;
4079 chanPtr = ePtr->chanPtr;
4082 * Add this invocation to the list of recursive invocations of
4083 * ChannelHandlerEventProc.
4086 nh.nextHandlerPtr = (ChannelHandler *) NULL;
4087 nh.nestedHandlerPtr = nestedHandlerPtr;
4088 nestedHandlerPtr = &nh;
4090 for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
4093 * If this channel handler is interested in any of the events that
4094 * have occurred on the channel, invoke its procedure.
4097 if ((chPtr->mask & ePtr->readyMask) != 0) {
4098 nh.nextHandlerPtr = chPtr->nextPtr;
4099 (*(chPtr->proc))(chPtr->clientData, ePtr->readyMask);
4100 chPtr = nh.nextHandlerPtr;
4102 chPtr = chPtr->nextPtr;
4106 nestedHandlerPtr = nh.nestedHandlerPtr;
4112 *----------------------------------------------------------------------
4114 * Tcl_CreateChannelHandler --
4116 * Arrange for a given procedure to be invoked whenever the
4117 * channel indicated by the chanPtr arg becomes readable or
4124 * From now on, whenever the I/O channel given by chanPtr becomes
4125 * ready in the way indicated by mask, proc will be invoked.
4126 * See the manual entry for details on the calling sequence
4127 * to proc. If there is already an event handler for chan, proc
4128 * and clientData, then the mask will be updated.
4130 *----------------------------------------------------------------------
4134 Tcl_CreateChannelHandler(chan, mask, proc, clientData)
4135 Tcl_Channel chan; /* The channel to create the handler for. */
4136 int mask; /* OR'ed combination of TCL_READABLE,
4137 * TCL_WRITABLE, and TCL_EXCEPTION:
4138 * indicates conditions under which
4139 * proc should be called. Use 0 to
4140 * disable a registered handler. */
4141 Tcl_ChannelProc *proc; /* Procedure to call for each
4142 * selected event. */
4143 ClientData clientData; /* Arbitrary data to pass to proc. */
4145 ChannelHandler *chPtr;
4148 chanPtr = (Channel *) chan;
4151 * Ensure that the channel event source is registered with the Tcl
4152 * notification mechanism.
4155 if (!channelEventSourceCreated) {
4156 channelEventSourceCreated = 1;
4157 Tcl_CreateEventSource(ChannelHandlerSetupProc, ChannelHandlerCheckProc,
4159 Tcl_CreateExitHandler(ChannelEventSourceExitProc, (ClientData) NULL);
4163 * Check whether this channel handler is not already registered. If
4164 * it is not, create a new record, else reuse existing record (smash
4168 for (chPtr = chanPtr->chPtr;
4169 chPtr != (ChannelHandler *) NULL;
4170 chPtr = chPtr->nextPtr) {
4171 if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
4172 (chPtr->clientData == clientData)) {
4176 if (chPtr == (ChannelHandler *) NULL) {
4177 chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler));
4180 chPtr->clientData = clientData;
4181 chPtr->chanPtr = chanPtr;
4182 chPtr->nextPtr = chanPtr->chPtr;
4183 chanPtr->chPtr = chPtr;
4187 * The remainder of the initialization below is done regardless of
4188 * whether or not this is a new record or a modification of an old
4195 * Recompute the interest mask for the channel - this call may actually
4196 * be disabling an existing handler..
4199 chanPtr->interestMask = 0;
4200 for (chPtr = chanPtr->chPtr;
4201 chPtr != (ChannelHandler *) NULL;
4202 chPtr = chPtr->nextPtr) {
4203 chanPtr->interestMask |= chPtr->mask;
4208 *----------------------------------------------------------------------
4210 * Tcl_DeleteChannelHandler --
4212 * Cancel a previously arranged callback arrangement for an IO
4219 * If a callback was previously registered for this chan, proc and
4220 * clientData , it is removed and the callback will no longer be called
4221 * when the channel becomes ready for IO.
4223 *----------------------------------------------------------------------
4227 Tcl_DeleteChannelHandler(chan, proc, clientData)
4228 Tcl_Channel chan; /* The channel for which to remove the
4230 Tcl_ChannelProc *proc; /* The procedure in the callback to delete. */
4231 ClientData clientData; /* The client data in the callback
4235 ChannelHandler *chPtr, *prevChPtr;
4237 NextChannelHandler *nhPtr;
4239 chanPtr = (Channel *) chan;
4242 * Find the entry and the previous one in the list.
4245 for (prevChPtr = (ChannelHandler *) NULL, chPtr = chanPtr->chPtr;
4246 chPtr != (ChannelHandler *) NULL;
4247 chPtr = chPtr->nextPtr) {
4248 if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
4249 && (chPtr->proc == proc)) {
4256 * If ChannelHandlerEventProc is about to process this handler, tell it to
4257 * process the next one instead - we are going to delete *this* one.
4260 for (nhPtr = nestedHandlerPtr;
4261 nhPtr != (NextChannelHandler *) NULL;
4262 nhPtr = nhPtr->nestedHandlerPtr) {
4263 if (nhPtr->nextHandlerPtr == chPtr) {
4264 nhPtr->nextHandlerPtr = chPtr->nextPtr;
4269 * If found, splice the entry out of the list.
4272 if (chPtr == (ChannelHandler *) NULL) {
4276 if (prevChPtr == (ChannelHandler *) NULL) {
4277 chanPtr->chPtr = chPtr->nextPtr;
4279 prevChPtr->nextPtr = chPtr->nextPtr;
4281 ckfree((char *) chPtr);
4284 * Recompute the interest list for the channel, so that infinite loops
4285 * will not result if Tcl_DeleteChanelHandler is called inside an event.
4288 chanPtr->interestMask = 0;
4289 for (chPtr = chanPtr->chPtr;
4290 chPtr != (ChannelHandler *) NULL;
4291 chPtr = chPtr->nextPtr) {
4292 chanPtr->interestMask |= chPtr->mask;
4297 *----------------------------------------------------------------------
4299 * ReturnScriptRecord --
4301 * Get a script stored for this channel with this interpreter.
4304 * A standard Tcl result.
4307 * Sets interp->result to the script.
4309 *----------------------------------------------------------------------
4313 ReturnScriptRecord(interp, chanPtr, mask)
4314 Tcl_Interp *interp; /* The interpreter in which the script
4315 * is to be executed. */
4316 Channel *chanPtr; /* The channel for which the script is
4318 int mask; /* Events in mask must overlap with events
4319 * for which this script is stored. */
4321 EventScriptRecord *esPtr;
4323 for (esPtr = chanPtr->scriptRecordPtr;
4324 esPtr != (EventScriptRecord *) NULL;
4325 esPtr = esPtr->nextPtr) {
4326 if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
4327 interp->result = esPtr->script;
4334 *----------------------------------------------------------------------
4336 * DeleteScriptRecord --
4338 * Delete a script record for this combination of channel, interp
4345 * Deletes a script record and cancels a channel event handler.
4347 *----------------------------------------------------------------------
4351 DeleteScriptRecord(interp, chanPtr, mask)
4352 Tcl_Interp *interp; /* Interpreter in which script was to be
4354 Channel *chanPtr; /* The channel for which to delete the
4355 * script record (if any). */
4356 int mask; /* Events in mask must exactly match mask
4357 * of script to delete. */
4359 EventScriptRecord *esPtr, *prevEsPtr;
4361 for (esPtr = chanPtr->scriptRecordPtr,
4362 prevEsPtr = (EventScriptRecord *) NULL;
4363 esPtr != (EventScriptRecord *) NULL;
4364 prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
4365 if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
4366 if (esPtr == chanPtr->scriptRecordPtr) {
4367 chanPtr->scriptRecordPtr = esPtr->nextPtr;
4369 prevEsPtr->nextPtr = esPtr->nextPtr;
4372 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
4373 ChannelEventScriptInvoker, (ClientData) esPtr);
4375 Tcl_EventuallyFree((ClientData)esPtr->script, TCL_DYNAMIC);
4376 ckfree((char *) esPtr);
4384 *----------------------------------------------------------------------
4386 * CreateScriptRecord --
4388 * Creates a record to store a script to be executed when a specific
4389 * event fires on a specific channel.
4395 * Causes the script to be stored for later execution.
4397 *----------------------------------------------------------------------
4401 CreateScriptRecord(interp, chanPtr, mask, script)
4402 Tcl_Interp *interp; /* Interpreter in which to execute
4403 * the stored script. */
4404 Channel *chanPtr; /* Channel for which script is to
4406 int mask; /* Set of events for which script
4407 * will be invoked. */
4408 char *script; /* A copy of this script is stored
4409 * in the newly created record. */
4411 EventScriptRecord *esPtr;
4413 for (esPtr = chanPtr->scriptRecordPtr;
4414 esPtr != (EventScriptRecord *) NULL;
4415 esPtr = esPtr->nextPtr) {
4416 if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
4417 Tcl_EventuallyFree((ClientData)esPtr->script, TCL_DYNAMIC);
4418 esPtr->script = (char *) NULL;
4422 if (esPtr == (EventScriptRecord *) NULL) {
4423 esPtr = (EventScriptRecord *) ckalloc((unsigned)
4424 sizeof(EventScriptRecord));
4425 Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
4426 ChannelEventScriptInvoker, (ClientData) esPtr);
4427 esPtr->nextPtr = chanPtr->scriptRecordPtr;
4428 chanPtr->scriptRecordPtr = esPtr;
4430 esPtr->chanPtr = chanPtr;
4431 esPtr->interp = interp;
4433 esPtr->script = ckalloc((unsigned) (strlen(script) + 1));
4434 strcpy(esPtr->script, script);
4438 *----------------------------------------------------------------------
4440 * ChannelEventScriptInvoker --
4442 * Invokes a script scheduled by "fileevent" for when the channel
4443 * becomes ready for IO. This function is invoked by the channel
4444 * handler which was created by the Tcl "fileevent" command.
4450 * Whatever the script does.
4452 *----------------------------------------------------------------------
4456 ChannelEventScriptInvoker(clientData, mask)
4457 ClientData clientData; /* The script+interp record. */
4458 int mask; /* Not used. */
4460 Tcl_Interp *interp; /* Interpreter in which to eval the script. */
4461 Channel *chanPtr; /* The channel for which this handler is
4463 char *script; /* Script to eval. */
4464 EventScriptRecord *esPtr; /* The event script + interpreter to eval it
4466 int result; /* Result of call to eval script. */
4468 esPtr = (EventScriptRecord *) clientData;
4470 chanPtr = esPtr->chanPtr;
4472 interp = esPtr->interp;
4473 script = esPtr->script;
4476 * We must preserve the channel, script and interpreter because each of
4477 * these may be deleted in the evaluation. If an error later occurs, we
4478 * want to have the relevant data around for error reporting and so we
4479 * can safely delete it.
4482 Tcl_Preserve((ClientData) chanPtr);
4483 Tcl_Preserve((ClientData) script);
4484 Tcl_Preserve((ClientData) interp);
4485 result = Tcl_GlobalEval(esPtr->interp, script);
4488 * On error, cause a background error and remove the channel handler
4489 * and the script record.
4492 if (result != TCL_OK) {
4493 Tcl_BackgroundError(interp);
4494 DeleteScriptRecord(interp, chanPtr, mask);
4496 Tcl_Release((ClientData) chanPtr);
4497 Tcl_Release((ClientData) script);
4498 Tcl_Release((ClientData) interp);
4502 *----------------------------------------------------------------------
4504 * Tcl_FileEventCmd --
4506 * This procedure implements the "fileevent" Tcl command. See the
4507 * user documentation for details on what it does. This command is
4508 * based on the Tk command "fileevent" which in turn is based on work
4509 * contributed by Mark Diekhans.
4512 * A standard Tcl result.
4515 * May create a channel handler for the specified channel.
4517 *----------------------------------------------------------------------
4522 Tcl_FileEventCmd(clientData, interp, argc, argv)
4523 ClientData clientData; /* Not used. */
4524 Tcl_Interp *interp; /* Interpreter in which the channel
4525 * for which to create the handler
4527 int argc; /* Number of arguments. */
4528 char **argv; /* Argument strings. */
4530 Channel *chanPtr; /* The channel to create
4531 * the handler for. */
4532 Tcl_Channel chan; /* The opaque type for the channel. */
4533 int c; /* First char of mode argument. */
4534 int mask; /* Mask for events of interest. */
4535 size_t length; /* Length of mode argument. */
4541 if ((argc != 3) && (argc != 4)) {
4542 Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0],
4543 " channelId event ?script?", (char *) NULL);
4547 length = strlen(argv[2]);
4548 if ((c == 'r') && (strncmp(argv[2], "readable", length) == 0)) {
4549 mask = TCL_READABLE;
4550 } else if ((c == 'w') && (strncmp(argv[2], "writable", length) == 0)) {
4551 mask = TCL_WRITABLE;
4553 Tcl_AppendResult(interp, "bad event name \"", argv[2],
4554 "\": must be readable or writable", (char *) NULL);
4557 chan = Tcl_GetChannel(interp, argv[1], NULL);
4558 if (chan == (Tcl_Channel) NULL) {
4562 chanPtr = (Channel *) chan;
4563 if ((chanPtr->flags & mask) == 0) {
4564 Tcl_AppendResult(interp, "channel is not ",
4565 (mask == TCL_READABLE) ? "readable" : "writable",
4571 * If we are supposed to return the script, do so.
4575 ReturnScriptRecord(interp, chanPtr, mask);
4580 * If we are supposed to delete a stored script, do so.
4583 if (argv[3][0] == 0) {
4584 DeleteScriptRecord(interp, chanPtr, mask);
4589 * Make the script record that will link between the event and the
4590 * script to invoke. This also creates a channel event handler which
4591 * will evaluate the script in the supplied interpreter.
4594 CreateScriptRecord(interp, chanPtr, mask, argv[3]);
4600 *----------------------------------------------------------------------
4602 * TclTestChannelCmd --
4604 * Implements the Tcl "testchannel" debugging command and its
4605 * subcommands. This is part of the testing environment but must be
4606 * in this file instead of tclTest.c because it needs access to the
4607 * fields of struct Channel.
4610 * A standard Tcl result.
4615 *----------------------------------------------------------------------
4620 TclTestChannelCmd(clientData, interp, argc, argv)
4621 ClientData clientData; /* Not used. */
4622 Tcl_Interp *interp; /* Interpreter for result. */
4623 int argc; /* Count of additional args. */
4624 char **argv; /* Additional arg strings. */
4626 char *cmdName; /* Sub command. */
4627 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
4628 Tcl_HashSearch hSearch; /* Search variable. */
4629 Tcl_HashEntry *hPtr; /* Search variable. */
4630 Channel *chanPtr; /* The actual channel. */
4631 Tcl_Channel chan; /* The opaque type. */
4632 size_t len; /* Length of subcommand string. */
4633 int IOQueued; /* How much IO is queued inside channel? */
4634 ChannelBuffer *bufPtr; /* For iterating over queued IO. */
4635 char buf[128]; /* For sprintf. */
4638 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
4639 " subcommand ?additional args..?\"", (char *) NULL);
4643 len = strlen(cmdName);
4645 chanPtr = (Channel *) NULL;
4647 chan = Tcl_GetChannel(interp, argv[2], NULL);
4648 if (chan == (Tcl_Channel) NULL) {
4651 chanPtr = (Channel *) chan;
4654 if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
4656 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
4657 " info channelName\"", (char *) NULL);
4660 Tcl_AppendElement(interp, argv[2]);
4661 Tcl_AppendElement(interp, chanPtr->typePtr->typeName);
4662 if (chanPtr->flags & TCL_READABLE) {
4663 Tcl_AppendElement(interp, "read");
4665 Tcl_AppendElement(interp, "");
4667 if (chanPtr->flags & TCL_WRITABLE) {
4668 Tcl_AppendElement(interp, "write");
4670 Tcl_AppendElement(interp, "");
4672 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
4673 Tcl_AppendElement(interp, "nonblocking");
4675 Tcl_AppendElement(interp, "blocking");
4677 if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
4678 Tcl_AppendElement(interp, "line");
4679 } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
4680 Tcl_AppendElement(interp, "none");
4682 Tcl_AppendElement(interp, "full");
4684 if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
4685 Tcl_AppendElement(interp, "async_flush");
4687 Tcl_AppendElement(interp, "");
4689 if (chanPtr->flags & CHANNEL_EOF) {
4690 Tcl_AppendElement(interp, "eof");
4692 Tcl_AppendElement(interp, "");
4694 if (chanPtr->flags & CHANNEL_BLOCKED) {
4695 Tcl_AppendElement(interp, "blocked");
4697 Tcl_AppendElement(interp, "unblocked");
4699 if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
4700 Tcl_AppendElement(interp, "auto");
4701 if (chanPtr->flags & INPUT_SAW_CR) {
4702 Tcl_AppendElement(interp, "saw_cr");
4704 Tcl_AppendElement(interp, "");
4706 } else if (chanPtr->inputTranslation == TCL_TRANSLATE_LF) {
4707 Tcl_AppendElement(interp, "lf");
4708 Tcl_AppendElement(interp, "");
4709 } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
4710 Tcl_AppendElement(interp, "cr");
4711 Tcl_AppendElement(interp, "");
4712 } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
4713 Tcl_AppendElement(interp, "crlf");
4714 if (chanPtr->flags & INPUT_SAW_CR) {
4715 Tcl_AppendElement(interp, "queued_cr");
4717 Tcl_AppendElement(interp, "");
4720 if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
4721 Tcl_AppendElement(interp, "auto");
4722 } else if (chanPtr->outputTranslation == TCL_TRANSLATE_LF) {
4723 Tcl_AppendElement(interp, "lf");
4724 } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
4725 Tcl_AppendElement(interp, "cr");
4726 } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
4727 Tcl_AppendElement(interp, "crlf");
4729 for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
4730 bufPtr != (ChannelBuffer *) NULL;
4731 bufPtr = bufPtr->nextPtr) {
4732 IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
4734 sprintf(buf, "%d", IOQueued);
4735 Tcl_AppendElement(interp, buf);
4738 if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
4739 IOQueued = chanPtr->curOutPtr->nextAdded -
4740 chanPtr->curOutPtr->nextRemoved;
4742 for (bufPtr = chanPtr->outQueueHead;
4743 bufPtr != (ChannelBuffer *) NULL;
4744 bufPtr = bufPtr->nextPtr) {
4745 IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
4747 sprintf(buf, "%d", IOQueued);
4748 Tcl_AppendElement(interp, buf);
4750 sprintf(buf, "%d", Tcl_Tell((Tcl_Channel) chanPtr));
4751 Tcl_AppendElement(interp, buf);
4753 sprintf(buf, "%d", chanPtr->refCount);
4754 Tcl_AppendElement(interp, buf);
4759 if ((cmdName[0] == 'i') &&
4760 (strncmp(cmdName, "inputbuffered", len) == 0)) {
4762 Tcl_AppendResult(interp, "channel name required",
4767 for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
4768 bufPtr != (ChannelBuffer *) NULL;
4769 bufPtr = bufPtr->nextPtr) {
4770 IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
4772 sprintf(buf, "%d", IOQueued);
4773 Tcl_AppendResult(interp, buf, (char *) NULL);
4777 if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
4779 Tcl_AppendResult(interp, "channel name required",
4784 if (chanPtr->flags & TCL_READABLE) {
4785 Tcl_AppendElement(interp, "read");
4787 Tcl_AppendElement(interp, "");
4789 if (chanPtr->flags & TCL_WRITABLE) {
4790 Tcl_AppendElement(interp, "write");
4792 Tcl_AppendElement(interp, "");
4797 if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
4799 Tcl_AppendResult(interp, "channel name required",
4803 Tcl_AppendResult(interp, chanPtr->channelName, (char *) NULL);
4807 if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
4808 hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
4809 if (hTblPtr == (Tcl_HashTable *) NULL) {
4812 for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
4813 hPtr != (Tcl_HashEntry *) NULL;
4814 hPtr = Tcl_NextHashEntry(&hSearch)) {
4815 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
4820 if ((cmdName[0] == 'o') &&
4821 (strncmp(cmdName, "outputbuffered", len) == 0)) {
4823 Tcl_AppendResult(interp, "channel name required",
4829 if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
4830 IOQueued = chanPtr->curOutPtr->nextAdded -
4831 chanPtr->curOutPtr->nextRemoved;
4833 for (bufPtr = chanPtr->outQueueHead;
4834 bufPtr != (ChannelBuffer *) NULL;
4835 bufPtr = bufPtr->nextPtr) {
4836 IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
4838 sprintf(buf, "%d", IOQueued);
4839 Tcl_AppendResult(interp, buf, (char *) NULL);
4843 if ((cmdName[0] == 'q') &&
4844 (strncmp(cmdName, "queuedcr", len) == 0)) {
4846 Tcl_AppendResult(interp, "channel name required",
4851 Tcl_AppendResult(interp,
4852 (chanPtr->flags & INPUT_SAW_CR) ? "1" : "0",
4857 if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
4858 hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
4859 if (hTblPtr == (Tcl_HashTable *) NULL) {
4862 for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
4863 hPtr != (Tcl_HashEntry *) NULL;
4864 hPtr = Tcl_NextHashEntry(&hSearch)) {
4865 chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
4866 if (chanPtr->flags & TCL_READABLE) {
4867 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
4873 if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
4875 Tcl_AppendResult(interp, "channel name required",
4880 sprintf(buf, "%d", chanPtr->refCount);
4881 Tcl_AppendResult(interp, buf, (char *) NULL);
4885 if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
4887 Tcl_AppendResult(interp, "channel name required",
4891 Tcl_AppendResult(interp, chanPtr->typePtr->typeName, (char *) NULL);
4895 if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
4896 hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
4897 if (hTblPtr == (Tcl_HashTable *) NULL) {
4900 for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
4901 hPtr != (Tcl_HashEntry *) NULL;
4902 hPtr = Tcl_NextHashEntry(&hSearch)) {
4903 chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
4904 if (chanPtr->flags & TCL_WRITABLE) {
4905 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
4911 Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
4912 "info, open, readable, or writable",
4918 *----------------------------------------------------------------------
4920 * TclTestChannelEventCmd --
4922 * This procedure implements the "testchannelevent" command. It is
4923 * used to test the Tcl channel event mechanism. It is present in
4924 * this file instead of tclTest.c because it needs access to the
4925 * internal structure of the channel.
4928 * A standard Tcl result.
4931 * Creates, deletes and returns channel event handlers.
4933 *----------------------------------------------------------------------
4938 TclTestChannelEventCmd(dummy, interp, argc, argv)
4939 ClientData dummy; /* Not used. */
4940 Tcl_Interp *interp; /* Current interpreter. */
4941 int argc; /* Number of arguments. */
4942 char **argv; /* Argument strings. */
4945 EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
4947 int index, i, mask, len;
4949 if ((argc < 3) || (argc > 5)) {
4950 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
4951 " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
4954 chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
4955 if (chanPtr == (Channel *) NULL) {
4960 if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
4962 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
4963 " channelName add eventSpec script\"", (char *) NULL);
4966 if (strcmp(argv[3], "readable") == 0) {
4967 mask = TCL_READABLE;
4968 } else if (strcmp(argv[3], "writable") == 0) {
4969 mask = TCL_WRITABLE;
4971 Tcl_AppendResult(interp, "bad event name \"", argv[3],
4972 "\": must be readable or writable", (char *) NULL);
4976 esPtr = (EventScriptRecord *) ckalloc((unsigned)
4977 sizeof(EventScriptRecord));
4978 esPtr->nextPtr = chanPtr->scriptRecordPtr;
4979 chanPtr->scriptRecordPtr = esPtr;
4981 esPtr->chanPtr = chanPtr;
4982 esPtr->interp = interp;
4984 esPtr->script = ckalloc((unsigned) (strlen(argv[4]) + 1));
4985 strcpy(esPtr->script, argv[4]);
4987 Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
4988 ChannelEventScriptInvoker, (ClientData) esPtr);
4993 if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
4995 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
4996 " channelName delete index\"", (char *) NULL);
4999 if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
5003 Tcl_AppendResult(interp, "bad event index: ", argv[3],
5004 ": must be nonnegative", (char *) NULL);
5007 for (i = 0, esPtr = chanPtr->scriptRecordPtr;
5008 (i < index) && (esPtr != (EventScriptRecord *) NULL);
5009 i++, esPtr = esPtr->nextPtr) {
5010 /* Empty loop body. */
5012 if (esPtr == (EventScriptRecord *) NULL) {
5013 Tcl_AppendResult(interp, "bad event index ", argv[3],
5014 ": out of range", (char *) NULL);
5017 if (esPtr == chanPtr->scriptRecordPtr) {
5018 chanPtr->scriptRecordPtr = esPtr->nextPtr;
5020 for (prevEsPtr = chanPtr->scriptRecordPtr;
5021 (prevEsPtr != (EventScriptRecord *) NULL) &&
5022 (prevEsPtr->nextPtr != esPtr);
5023 prevEsPtr = prevEsPtr->nextPtr) {
5024 /* Empty loop body. */
5026 if (prevEsPtr == (EventScriptRecord *) NULL) {
5027 panic("TclTestChannelEventCmd: damaged event script list");
5029 prevEsPtr->nextPtr = esPtr->nextPtr;
5031 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
5032 ChannelEventScriptInvoker, (ClientData) esPtr);
5033 Tcl_EventuallyFree((ClientData)esPtr->script, TCL_DYNAMIC);
5034 ckfree((char *) esPtr);
5039 if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
5041 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
5042 " channelName list\"", (char *) NULL);
5045 for (esPtr = chanPtr->scriptRecordPtr;
5046 esPtr != (EventScriptRecord *) NULL;
5047 esPtr = esPtr->nextPtr) {
5048 Tcl_AppendElement(interp,
5049 esPtr->mask == TCL_READABLE ? "readable" : "writable");
5050 Tcl_AppendElement(interp, esPtr->script);
5055 if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
5057 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
5058 " channelName removeall\"", (char *) NULL);
5061 for (esPtr = chanPtr->scriptRecordPtr;
5062 esPtr != (EventScriptRecord *) NULL;
5063 esPtr = nextEsPtr) {
5064 nextEsPtr = esPtr->nextPtr;
5065 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
5066 ChannelEventScriptInvoker, (ClientData) esPtr);
5067 Tcl_EventuallyFree((ClientData)esPtr->script, TCL_DYNAMIC);
5068 ckfree((char *) esPtr);
5070 chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
5074 Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
5075 "add, delete, list, or removeall", (char *) NULL);