home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tkisrc04.zip / tcl / os2 / tclIO.c < prev    next >
C/C++ Source or Header  |  1998-08-07  |  165KB  |  5,056 lines
  1. /* 
  2.  * tclIO.c --
  3.  *
  4.  *    This file provides the generic portions (those that are the same on
  5.  *    all platforms and for all channel types) of Tcl's IO facilities.
  6.  *
  7.  * Copyright (c) 1995-1996 Sun Microsystems, Inc.
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  * SCCS: @(#) tclIO.c 1.211 96/04/18 09:59:06
  13.  */
  14.  
  15. #include    "tclInt.h"
  16. #include    "tclPort.h"
  17.  
  18. /*
  19.  * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
  20.  * compile on systems where neither is defined. We want both defined so
  21.  * that we can test safely for both. In the code we still have to test for
  22.  * both because there may be systems on which both are defined and have
  23.  * different values.
  24.  */
  25.  
  26. #if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))
  27. #   define EWOULDBLOCK EAGAIN
  28. #endif
  29. #if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))
  30. #   define EAGAIN EWOULDBLOCK
  31. #endif
  32. #if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
  33.     error one of EWOULDBLOCK or EAGAIN must be defined
  34. #endif
  35.  
  36. /*
  37.  * struct ChannelBuffer:
  38.  *
  39.  * Buffers data being sent to or from a channel.
  40.  */
  41.  
  42. typedef struct ChannelBuffer {
  43.     int nextAdded;        /* The next position into which a character
  44.                                  * will be put in the buffer. */
  45.     int nextRemoved;        /* Position of next byte to be removed
  46.                                  * from the buffer. */
  47.     int bufSize;        /* How big is the buffer? */
  48.     struct ChannelBuffer *nextPtr;
  49.                     /* Next buffer in chain. */
  50.     char buf[4];        /* Placeholder for real buffer. The real
  51.                                  * buffer occuppies this space + bufSize-4
  52.                                  * bytes. This must be the last field in
  53.                                  * the structure. */
  54. } ChannelBuffer;
  55.  
  56. #define CHANNELBUFFER_HEADER_SIZE    (sizeof(ChannelBuffer) - 4)
  57.  
  58. /*
  59.  * The following defines the *default* buffer size for channels.
  60.  */
  61.  
  62. #define CHANNELBUFFER_DEFAULT_SIZE    (1024 * 4)
  63.  
  64. /*
  65.  * Structure to record a close callback. One such record exists for
  66.  * each close callback registered for a channel.
  67.  */
  68.  
  69. typedef struct CloseCallback {
  70.     Tcl_CloseProc *proc;        /* The procedure to call. */
  71.     ClientData clientData;        /* Arbitrary one-word data to pass
  72.                                          * to the callback. */
  73.     struct CloseCallback *nextPtr;    /* For chaining close callbacks. */
  74. } CloseCallback;
  75.  
  76. /*
  77.  * Forward declaration of Channel; being used in struct EventScriptRecord,
  78.  * below.
  79.  */
  80.  
  81. typedef struct Channel *ChanPtr;
  82.  
  83. /*
  84.  * The following structure describes the information saved from a call to
  85.  * "fileevent". This is used later when the event being waited for to
  86.  * invoke the saved script in the interpreter designed in this record.
  87.  */
  88.  
  89. typedef struct EventScriptRecord {
  90.     struct Channel *chanPtr;    /* The channel for which this script is
  91.                                  * registered. This is used only when an
  92.                                  * error occurs during evaluation of the
  93.                                  * script, to delete the handler. */
  94.     char *script;        /* Script to invoke. */
  95.     Tcl_Interp *interp;        /* In what interpreter to invoke script? */
  96.     int mask;            /* Events must overlap current mask for the
  97.                                  * stored script to be invoked. */
  98.     struct EventScriptRecord *nextPtr;
  99.                     /* Next in chain of records. */
  100. } EventScriptRecord;
  101.  
  102. /*
  103.  * Forward declaration of ChannelHandler; being used in struct Channel,
  104.  * below.
  105.  */
  106.  
  107. typedef struct ChannelHandler *ChannelHandlerPtr;
  108.  
  109. /*
  110.  * struct Channel:
  111.  *
  112.  * One of these structures is allocated for each open channel. It contains data
  113.  * specific to the channel but which belongs to the generic part of the Tcl
  114.  * channel mechanism, and it points at an instance specific (and type
  115.  * specific) * instance data, and at a channel type structure.
  116.  */
  117.  
  118. typedef struct Channel {
  119.     char *channelName;        /* The name of the channel instance in Tcl
  120.                                  * commands. Storage is owned by the generic IO
  121.                                  * code,  is dynamically allocated. */
  122.     int    flags;            /* ORed combination of the flags defined
  123.                                  * below. */
  124.     Tcl_EolTranslation inputTranslation;
  125.                 /* What translation to apply for end of line
  126.                                  * sequences on input? */    
  127.     Tcl_EolTranslation outputTranslation;
  128.                     /* What translation to use for generating
  129.                                  * end of line sequences in output? */
  130.     int inEofChar;        /* If nonzero, use this as a signal of EOF
  131.                                  * on input. */
  132.     int outEofChar;             /* If nonzero, append this to the channel
  133.                                  * when it is closed if it is open for
  134.                                  * writing. */
  135.     int unreportedError;    /* Non-zero if an error report was deferred
  136.                                  * because it happened in the background. The
  137.                                  * value is the POSIX error code. */
  138.     ClientData instanceData;    /* Instance specific data. */
  139.     Tcl_File inFile;        /* File to use for input, or NULL. */
  140.     Tcl_File outFile;        /* File to use for output, or NULL. */
  141.     Tcl_ChannelType *typePtr;    /* Pointer to channel type structure. */
  142.     int refCount;        /* How many interpreters hold references to
  143.                                  * this IO channel? */
  144.     CloseCallback *closeCbPtr;    /* Callbacks registered to be called when the
  145.                                  * channel is closed. */
  146.     ChannelBuffer *curOutPtr;    /* Current output buffer being filled. */
  147.     ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
  148.     ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */
  149.  
  150.     ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates
  151.                                  * need to allocate a new buffer for "gets"
  152.                                  * that crosses buffer boundaries. */
  153.     ChannelBuffer *inQueueHead;    /* Points at first buffer in input queue. */
  154.     ChannelBuffer *inQueueTail;    /* Points at last buffer in input queue. */
  155.  
  156.     struct ChannelHandler *chPtr;/* List of channel handlers registered
  157.                                   * for this channel. */
  158.     int interestMask;        /* Mask of all events this channel has
  159.                                  * handlers for. */
  160.     struct Channel *nextChanPtr;/* Next in list of channels currently open. */
  161.     EventScriptRecord *scriptRecordPtr;
  162.                     /* Chain of all scripts registered for
  163.                                  * event handlers ("fileevent") on this
  164.                                  * channel. */
  165.     int bufSize;        /* What size buffers to allocate? */
  166. } Channel;
  167.     
  168. /*
  169.  * Values for the flags field in Channel. Any ORed combination of the
  170.  * following flags can be stored in the field. These flags record various
  171.  * options and state bits about the channel. In addition to the flags below,
  172.  * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
  173.  */
  174.  
  175. #define CHANNEL_NONBLOCKING    (1<<3)    /* Channel is currently in
  176.                      * nonblocking mode. */
  177. #define CHANNEL_LINEBUFFERED    (1<<4)    /* Output to the channel must be
  178.                      * flushed after every newline. */
  179. #define CHANNEL_UNBUFFERED    (1<<5)    /* Output to the channel must always
  180.                      * be flushed immediately. */
  181. #define BUFFER_READY        (1<<6)    /* Current output buffer (the
  182.                      * curOutPtr field in the
  183.                                          * channel structure) should be
  184.                                          * output as soon as possible event
  185.                                          * though it may not be full. */
  186. #define BG_FLUSH_SCHEDULED    (1<<7)    /* A background flush of the
  187.                      * queued output buffers has been
  188.                                          * scheduled. */
  189. #define CHANNEL_CLOSED        (1<<8)    /* Channel has been closed. No
  190.                      * further Tcl-level IO on the
  191.                                          * channel is allowed. */
  192. #define    CHANNEL_EOF        (1<<9)    /* EOF occurred on this channel.
  193.                      * This bit is cleared before every
  194.                                          * input operation. */
  195. #define CHANNEL_STICKY_EOF    (1<<10)    /* EOF occurred on this channel because
  196.                      * we saw the input eofChar. This bit
  197.                                          * prevents clearing of the EOF bit
  198.                                          * before every input operation. */
  199. #define CHANNEL_BLOCKED        (1<<11)    /* EWOULDBLOCK or EAGAIN occurred
  200.                      * on this channel. This bit is
  201.                                          * cleared before every input or
  202.                                          * output operation. */
  203. #define INPUT_SAW_CR        (1<<12)    /* Channel is in CRLF eol input
  204.                      * translation mode and the last
  205.                                          * byte seen was a "\r". */
  206.  
  207. /*
  208.  * For each channel handler registered in a call to Tcl_CreateChannelHandler,
  209.  * there is one record of the following type. All of records for a specific
  210.  * channel are chained together in a singly linked list which is stored in
  211.  * the channel structure.
  212.  */
  213.  
  214. typedef struct ChannelHandler {
  215.     Channel *chanPtr;        /* The channel structure for this channel. */
  216.     int mask;            /* Mask of desired events. */
  217.     Tcl_ChannelProc *proc;    /* Procedure to call in the type of
  218.                                  * Tcl_CreateChannelHandler. */
  219.     ClientData clientData;    /* Argument to pass to procedure. */
  220.     struct ChannelHandler *nextPtr;
  221.                     /* Next one in list of registered handlers. */
  222. } ChannelHandler;
  223.  
  224. /*
  225.  * This structure keeps track of the current ChannelHandler being invoked in
  226.  * the current invocation of ChannelHandlerEventProc. There is a potential
  227.  * problem if a ChannelHandler is deleted while it is the current one, since
  228.  * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
  229.  * problem, structures of the type below indicate the next handler to be
  230.  * processed for any (recursively nested) dispatches in progress. The
  231.  * nextHandlerPtr field is updated if the handler being pointed to is deleted.
  232.  * The nextPtr field is used to chain together all recursive invocations, so
  233.  * that Tcl_DeleteChannelHandler can find all the recursively nested
  234.  * invocations of ChannelHandlerEventProc and compare the handler being
  235.  * deleted against the NEXT handler to be invoked in that invocation; when it
  236.  * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
  237.  * field of the structure to the next handler.
  238.  */
  239.  
  240. typedef struct NextChannelHandler {
  241.     ChannelHandler *nextHandlerPtr;    /* The next handler to be invoked in
  242.                                          * this invocation. */
  243.     struct NextChannelHandler *nestedHandlerPtr;
  244.                     /* Next nested invocation of
  245.                                          * ChannelHandlerEventProc. */
  246. } NextChannelHandler;
  247.  
  248. /*
  249.  * This variable holds the list of nested ChannelHandlerEventProc invocations.
  250.  */
  251.  
  252. static NextChannelHandler *nestedHandlerPtr = (NextChannelHandler *) NULL;
  253.  
  254. /*
  255.  * List of all channels currently open.
  256.  */
  257.  
  258. static Channel *firstChanPtr = (Channel *) NULL;
  259.  
  260. /*
  261.  * Has a channel exit handler been created yet?
  262.  */
  263.  
  264. static int channelExitHandlerCreated = 0;
  265.  
  266. /*
  267.  * Has the channel event source been created and registered with the
  268.  * notifier?
  269.  */
  270.  
  271. static int channelEventSourceCreated = 0;
  272.  
  273. /*
  274.  * The following structure describes the event that is added to the Tcl
  275.  * event queue by the channel handler check procedure.
  276.  */
  277.  
  278. typedef struct ChannelHandlerEvent {
  279.     Tcl_Event header;        /* Standard header for all events. */
  280.     Channel *chanPtr;        /* The channel that is ready. */
  281.     int readyMask;        /* Events that have occurred. */
  282. } ChannelHandlerEvent;
  283.  
  284. /*
  285.  * Static buffer used to sprintf channel option values and return
  286.  * them to the caller.
  287.  */
  288.  
  289. static char optionVal[128];
  290.  
  291. /*
  292.  * Static variables to hold channels for stdin, stdout and stderr.
  293.  */
  294.  
  295. static Tcl_Channel stdinChannel = NULL;
  296. static int stdinInitialized = 0;
  297. static Tcl_Channel stdoutChannel = NULL;
  298. static int stdoutInitialized = 0;
  299. static Tcl_Channel stderrChannel = NULL;
  300. static int stderrInitialized = 0;
  301.  
  302. /*
  303.  * Static functions in this file:
  304.  */
  305.  
  306. static int        ChannelEventDeleteProc _ANSI_ARGS_((
  307.                 Tcl_Event *evPtr, ClientData clientData));
  308. static void        ChannelEventSourceExitProc _ANSI_ARGS_((
  309.                     ClientData data));
  310. static int        ChannelHandlerEventProc _ANSI_ARGS_((
  311.                 Tcl_Event *evPtr, int flags));
  312. static void        ChannelHandlerCheckProc _ANSI_ARGS_((
  313.                 ClientData clientData, int flags));
  314. static void        ChannelHandlerSetupProc _ANSI_ARGS_((
  315.                 ClientData clientData, int flags));
  316. static void        ChannelEventScriptInvoker _ANSI_ARGS_((
  317.                 ClientData clientData, int flags));
  318. static int        CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
  319.                             Channel *chanPtr, int errorCode));
  320. static void        CloseChannelsOnExit _ANSI_ARGS_((ClientData data));
  321. static int        CopyAndTranslateBuffer _ANSI_ARGS_((
  322.                 Channel *chanPtr, char *result, int space));
  323. static void        CreateScriptRecord _ANSI_ARGS_((
  324.                 Tcl_Interp *interp, Channel *chanPtr,
  325.                             int mask, char *script));
  326. static void        DeleteChannelTable _ANSI_ARGS_((
  327.                 ClientData clientData, Tcl_Interp *interp));
  328. static void        DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
  329.                     Channel *chanPtr, int mask));
  330. static void        DiscardInputQueued _ANSI_ARGS_((
  331.                 Channel *chanPtr, int discardSavedBuffers));
  332. static void        DiscardOutputQueued _ANSI_ARGS_((
  333.                     Channel *chanPtr));
  334. static int        FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
  335.                             Channel *chanPtr, int calledFromAsyncFlush));
  336. static void        FlushEventProc _ANSI_ARGS_((ClientData clientData,
  337.                             int mask));
  338. static Tcl_HashTable    *GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
  339. static int        GetEOL _ANSI_ARGS_((Channel *chanPtr));
  340. static int        GetInput _ANSI_ARGS_((Channel *chanPtr));
  341. static void        RecycleBuffer _ANSI_ARGS_((Channel *chanPtr,
  342.                     ChannelBuffer *bufPtr, int mustDiscard));
  343. static void        ReturnScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
  344.                     Channel *chanPtr, int mask));
  345. static int        ScanBufferForEOL _ANSI_ARGS_((Channel *chanPtr,
  346.                             ChannelBuffer *bufPtr,
  347.                             Tcl_EolTranslation translation, int eofChar,
  348.                     int *bytesToEOLPtr, int *crSeenPtr));
  349. static int        ScanInputForEOL _ANSI_ARGS_((Channel *chanPtr,
  350.                     int *bytesQueuedPtr));
  351.  
  352. /*
  353.  *----------------------------------------------------------------------
  354.  *
  355.  * Tcl_SetStdChannel --
  356.  *
  357.  *    This function is used to change the channels that are used
  358.  *    for stdin/stdout/stderr in new interpreters.
  359.  *
  360.  * Results:
  361.  *    None
  362.  *
  363.  * Side effects:
  364.  *    None.
  365.  *
  366.  *----------------------------------------------------------------------
  367.  */
  368.  
  369. void
  370. Tcl_SetStdChannel(channel, type)
  371.     Tcl_Channel channel;
  372.     int type;            /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
  373. {
  374.     switch (type) {
  375.     case TCL_STDIN:
  376.         stdinInitialized = 1;
  377.         stdinChannel = channel;
  378.         break;
  379.     case TCL_STDOUT:
  380.         stdoutInitialized = 1;
  381.         stdoutChannel = channel;
  382.         break;
  383.     case TCL_STDERR:
  384.         stderrInitialized = 1;
  385.         stderrChannel = channel;
  386.         break;
  387.     }
  388. }
  389.  
  390. /*
  391.  *----------------------------------------------------------------------
  392.  *
  393.  * Tcl_GetStdChannel --
  394.  *
  395.  *    Returns the specified standard channel.
  396.  *
  397.  * Results:
  398.  *    Returns the specified standard channel, or NULL.
  399.  *
  400.  * Side effects:
  401.  *    May cause the creation of a standard channel and the underlying
  402.  *    file.
  403.  *
  404.  *----------------------------------------------------------------------
  405.  */
  406.  
  407. Tcl_Channel
  408. Tcl_GetStdChannel(type)
  409.     int type;            /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
  410. {
  411.     Tcl_Channel channel = NULL;
  412.  
  413.     /*
  414.      * If the channels were not created yet, create them now and
  415.      * store them in the static variables.  Note that we need to set
  416.      * stdinInitialized before calling TclGetDefaultStdChannel in order
  417.      * to avoid recursive loops when TclGetDefaultStdChannel calls
  418.      * Tcl_CreateChannel.
  419.      */
  420.  
  421.     switch (type) {
  422.     case TCL_STDIN:
  423.         if (!stdinInitialized) {
  424.         stdinInitialized = 1;
  425.         stdinChannel = TclGetDefaultStdChannel(TCL_STDIN);
  426.         }
  427.         channel = stdinChannel;
  428.         break;
  429.     case TCL_STDOUT:
  430.         if (!stdoutInitialized) {
  431.         stdoutInitialized = 1;
  432.         stdoutChannel = TclGetDefaultStdChannel(TCL_STDOUT);
  433.         }
  434.         channel = stdoutChannel;
  435.         break;
  436.     case TCL_STDERR:
  437.         if (!stderrInitialized) {
  438.         stderrInitialized = 1;
  439.         stderrChannel = TclGetDefaultStdChannel(TCL_STDERR);
  440.         }
  441.         channel = stderrChannel;
  442.         break;
  443.     }
  444.     return channel;
  445. }
  446.  
  447. /*
  448.  *----------------------------------------------------------------------
  449.  *
  450.  * Tcl_CreateCloseHandler
  451.  *
  452.  *    Creates a close callback which will be called when the channel is
  453.  *    closed.
  454.  *
  455.  * Results:
  456.  *    None.
  457.  *
  458.  * Side effects:
  459.  *    Causes the callback to be called in the future when the channel
  460.  *    will be closed.
  461.  *
  462.  *----------------------------------------------------------------------
  463.  */
  464.  
  465. void
  466. Tcl_CreateCloseHandler(chan, proc, clientData)
  467.     Tcl_Channel chan;        /* The channel for which to create the
  468.                                  * close callback. */
  469.     Tcl_CloseProc *proc;    /* The callback routine to call when the
  470.                                  * channel will be closed. */
  471.     ClientData clientData;    /* Arbitrary data to pass to the
  472.                                  * close callback. */
  473. {
  474.     Channel *chanPtr;
  475.     CloseCallback *cbPtr;
  476.  
  477.     chanPtr = (Channel *) chan;
  478.  
  479.     cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
  480.     cbPtr->proc = proc;
  481.     cbPtr->clientData = clientData;
  482.  
  483.     cbPtr->nextPtr = chanPtr->closeCbPtr;
  484.     chanPtr->closeCbPtr = cbPtr;
  485. }
  486.  
  487. /*
  488.  *----------------------------------------------------------------------
  489.  *
  490.  * Tcl_DeleteCloseHandler --
  491.  *
  492.  *    Removes a callback that would have been called on closing
  493.  *    the channel. If there is no matching callback then this
  494.  *    function has no effect.
  495.  *
  496.  * Results:
  497.  *    None.
  498.  *
  499.  * Side effects:
  500.  *    The callback will not be called in the future when the channel
  501.  *    is eventually closed.
  502.  *
  503.  *----------------------------------------------------------------------
  504.  */
  505.  
  506. void
  507. Tcl_DeleteCloseHandler(chan, proc, clientData)
  508.     Tcl_Channel chan;        /* The channel for which to cancel the
  509.                                  * close callback. */
  510.     Tcl_CloseProc *proc;    /* The procedure for the callback to
  511.                                  * remove. */
  512.     ClientData clientData;    /* The callback data for the callback
  513.                                  * to remove. */
  514. {
  515.     Channel *chanPtr;
  516.     CloseCallback *cbPtr, *cbPrevPtr;
  517.  
  518.     chanPtr = (Channel *) chan;
  519.     for (cbPtr = chanPtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
  520.              cbPtr != (CloseCallback *) NULL;
  521.              cbPtr = cbPtr->nextPtr) {
  522.         if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
  523.             if (cbPrevPtr == (CloseCallback *) NULL) {
  524.                 chanPtr->closeCbPtr = cbPtr->nextPtr;
  525.             } else {
  526.                 cbPrevPtr = cbPtr->nextPtr;
  527.             }
  528.             ckfree((char *) cbPtr);
  529.             break;
  530.         } else {
  531.             cbPrevPtr = cbPtr;
  532.         }
  533.     }
  534. }
  535.  
  536. /*
  537.  *----------------------------------------------------------------------
  538.  *
  539.  * CloseChannelsOnExit --
  540.  *
  541.  *    Closes all the existing channels, on exit. This    routine is called
  542.  *    during exit processing.
  543.  *
  544.  * Results:
  545.  *    None.
  546.  *
  547.  * Side effects:
  548.  *    Closes all channels.
  549.  *
  550.  *----------------------------------------------------------------------
  551.  */
  552.  
  553.     /* ARGSUSED */
  554. static void
  555. CloseChannelsOnExit(clientData)
  556.     ClientData clientData;        /* NULL - unused. */
  557. {
  558.     Channel *chanPtr;            /* Iterates over open channels. */
  559.     Channel *nextChanPtr;        /* Iterates over open channels. */
  560.  
  561.  
  562.     for (chanPtr = firstChanPtr; chanPtr != (Channel *) NULL;
  563.              chanPtr = nextChanPtr) {
  564.         nextChanPtr = chanPtr->nextChanPtr;
  565.  
  566.         /*
  567.          * Close it only if the refcount indicates that the channel is not
  568.          * referenced from any interpreter. If it is, that interpreter will
  569.          * close the channel when it gets destroyed.
  570.          */
  571.     
  572.         if (chanPtr->refCount <= 0) {
  573.                                  
  574.             /*
  575.              * Switch the channel back into synchronous mode to ensure that it
  576.              * gets flushed now.
  577.              */
  578.  
  579.             (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
  580.                     "-blocking", "on");
  581.  
  582.             Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
  583.         }
  584.     }
  585. }
  586.  
  587. /*
  588.  *----------------------------------------------------------------------
  589.  *
  590.  * GetChannelTable --
  591.  *
  592.  *    Gets and potentially initializes the channel table for an
  593.  *    interpreter. If it is initializing the table it also inserts
  594.  *    channels for stdin, stdout and stderr if the interpreter is
  595.  *    trusted.
  596.  *
  597.  * Results:
  598.  *    A pointer to the hash table created, for use by the caller.
  599.  *
  600.  * Side effects:
  601.  *    Initializes the channel table for an interpreter. May create
  602.  *    channels for stdin, stdout and stderr.
  603.  *
  604.  *----------------------------------------------------------------------
  605.  */
  606.  
  607. static Tcl_HashTable *
  608. GetChannelTable(interp)
  609.     Tcl_Interp *interp;
  610. {
  611.     Tcl_HashTable *hTblPtr;    /* Hash table of channels. */
  612.     Tcl_Channel stdinChannel, stdoutChannel, stderrChannel;
  613.  
  614.     hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
  615.     if (hTblPtr == (Tcl_HashTable *) NULL) {
  616.         hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
  617.         Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
  618.  
  619.         (void) Tcl_SetAssocData(interp, "tclIO",
  620.                 (Tcl_InterpDeleteProc *) DeleteChannelTable,
  621.                 (ClientData) hTblPtr);
  622.  
  623.         /*
  624.          * If the interpreter is trusted (not "safe"), insert channels
  625.          * for stdin, stdout and stderr (possibly creating them in the
  626.          * process).
  627.          */
  628.  
  629.         if (Tcl_IsSafe(interp) == 0) {
  630.         stdinChannel = Tcl_GetStdChannel(TCL_STDIN);
  631.             if (stdinChannel != NULL) {
  632.                 Tcl_RegisterChannel(interp, stdinChannel);
  633.             }
  634.         stdoutChannel = Tcl_GetStdChannel(TCL_STDOUT);
  635.             if (stdoutChannel != NULL) {
  636.                 Tcl_RegisterChannel(interp, stdoutChannel);
  637.             }
  638.         stderrChannel = Tcl_GetStdChannel(TCL_STDERR);
  639.             if (stderrChannel != NULL) {
  640.                 Tcl_RegisterChannel(interp, stderrChannel);
  641.             }
  642.         }
  643.  
  644.     }
  645.     return hTblPtr;
  646. }
  647.  
  648. /*
  649.  *----------------------------------------------------------------------
  650.  *
  651.  * DeleteChannelTable --
  652.  *
  653.  *    Deletes the channel table for an interpreter, closing any open
  654.  *    channels whose refcount reaches zero. This procedure is invoked
  655.  *    when an interpreter is deleted, via the AssocData cleanup
  656.  *    mechanism.
  657.  *
  658.  * Results:
  659.  *    None.
  660.  *
  661.  * Side effects:
  662.  *    Deletes the hash table of channels. May close channels. May flush
  663.  *    output on closed channels. Removes any channeEvent handlers that were
  664.  *    registered in this interpreter.
  665.  *
  666.  *----------------------------------------------------------------------
  667.  */
  668.  
  669. static void
  670. DeleteChannelTable(clientData, interp)
  671.     ClientData clientData;    /* The per-interpreter data structure. */
  672.     Tcl_Interp *interp;        /* The interpreter being deleted. */
  673. {
  674.     Tcl_HashTable *hTblPtr;    /* The hash table. */
  675.     Tcl_HashSearch hSearch;    /* Search variable. */
  676.     Tcl_HashEntry *hPtr;    /* Search variable. */
  677.     Channel *chanPtr;    /* Channel being deleted. */
  678.     EventScriptRecord *sPtr, *prevPtr, *nextPtr;
  679.                     /* Variables to loop over all channel events
  680.                                  * registered, to delete the ones that refer
  681.                                  * to the interpreter being deleted. */
  682.  
  683.     /*
  684.      * Delete all the registered channels - this will close channels whose
  685.      * refcount reaches zero.
  686.      */
  687.     
  688.     hTblPtr = (Tcl_HashTable *) clientData;
  689.     for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
  690.              hPtr != (Tcl_HashEntry *) NULL;
  691.              hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
  692.  
  693.         chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
  694.  
  695.         /*
  696.          * Remove any fileevents registered in this interpreter.
  697.          */
  698.         
  699.         for (sPtr = chanPtr->scriptRecordPtr,
  700.                  prevPtr = (EventScriptRecord *) NULL;
  701.                  sPtr != (EventScriptRecord *) NULL;
  702.                  sPtr = nextPtr) {
  703.             nextPtr = sPtr->nextPtr;
  704.             if (sPtr->interp == interp) {
  705.                 if (prevPtr == (EventScriptRecord *) NULL) {
  706.                     chanPtr->scriptRecordPtr = nextPtr;
  707.                 } else {
  708.                     prevPtr->nextPtr = nextPtr;
  709.                 }
  710.  
  711.                 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
  712.                         ChannelEventScriptInvoker, (ClientData) sPtr);
  713.  
  714.                 Tcl_EventuallyFree((ClientData) sPtr->script, TCL_DYNAMIC);
  715.                 ckfree((char *) sPtr);
  716.             } else {
  717.                 prevPtr = sPtr;
  718.             }
  719.         }
  720.  
  721.         /*
  722.          * Cannot call Tcl_UnregisterChannel because that procedure calls
  723.          * Tcl_GetAssocData to get the channel table, which might already
  724.          * be inaccessible from the interpreter structure. Instead, we
  725.          * emulate the behavior of Tcl_UnregisterChannel directly here.
  726.          */
  727.  
  728.         Tcl_DeleteHashEntry(hPtr);
  729.         chanPtr->refCount--;
  730.         if (chanPtr->refCount <= 0) {
  731.             chanPtr->flags |= CHANNEL_CLOSED;
  732.             if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
  733.                 Tcl_Close(interp, (Tcl_Channel) chanPtr);
  734.             }
  735.         }
  736.     }
  737.     Tcl_DeleteHashTable(hTblPtr);
  738.     ckfree((char *) hTblPtr);
  739. }
  740.  
  741. /*
  742.  *----------------------------------------------------------------------
  743.  *
  744.  * Tcl_UnregisterChannel --
  745.  *
  746.  *    Deletes the hash entry for a channel associated with an interpreter.
  747.  *
  748.  * Results:
  749.  *    A standard Tcl result.
  750.  *
  751.  * Side effects:
  752.  *    Deletes the hash entry for a channel associated with an interpreter.
  753.  *
  754.  *----------------------------------------------------------------------
  755.  */
  756.  
  757. int
  758. Tcl_UnregisterChannel(interp, chan)
  759.     Tcl_Interp *interp;        /* Interpreter in which channel is defined. */
  760.     Tcl_Channel chan;        /* Channel to delete. */
  761. {
  762.     Tcl_HashTable *hTblPtr;    /* Hash table of channels. */
  763.     Tcl_HashEntry *hPtr;    /* Search variable. */
  764.     Channel *chanPtr;        /* The real IO channel. */
  765.  
  766.     chanPtr = (Channel *) chan;
  767.     hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
  768.     if (hTblPtr == (Tcl_HashTable *) NULL) {
  769.         return TCL_OK;
  770.     }
  771.     hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName);
  772.     if (hPtr == (Tcl_HashEntry *) NULL) {
  773.         return TCL_OK;
  774.     }
  775.     if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
  776.         return TCL_OK;
  777.     }
  778.     Tcl_DeleteHashEntry(hPtr);
  779.     chanPtr->refCount--;
  780.     if (chanPtr->refCount <= 0) {
  781.         chanPtr->flags |= CHANNEL_CLOSED;
  782.         if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
  783.             if (Tcl_Close(interp, chan) != TCL_OK) {
  784.                 return TCL_ERROR;
  785.             }
  786.         }
  787.     }
  788.     return TCL_OK;
  789. }
  790.  
  791. /*
  792.  *----------------------------------------------------------------------
  793.  *
  794.  * Tcl_RegisterChannel --
  795.  *
  796.  *    Adds an already-open channel to the channel table of an interpreter.
  797.  *
  798.  * Results:
  799.  *    None.
  800.  *
  801.  * Side effects:
  802.  *    May increment the reference count of a channel.
  803.  *
  804.  *----------------------------------------------------------------------
  805.  */
  806.  
  807. void
  808. Tcl_RegisterChannel(interp, chan)
  809.     Tcl_Interp *interp;        /* Interpreter in which to add the channel. */
  810.     Tcl_Channel chan;        /* The channel to add to this interpreter
  811.                                  * channel table. */
  812. {
  813.     Tcl_HashTable *hTblPtr;    /* Hash table of channels. */
  814.     Tcl_HashEntry *hPtr;    /* Search variable. */
  815.     int new;            /* Is the hash entry new or does it exist? */
  816.     Channel *chanPtr;        /* The actual channel. */
  817.  
  818.     chanPtr = (Channel *) chan;
  819.  
  820.     if (chanPtr->channelName == (char *) NULL) {
  821.         panic("Tcl_RegisterChannel: channel without name");
  822.     }
  823.     hTblPtr = GetChannelTable(interp);
  824.     hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new);
  825.     if (new == 0) {
  826.         if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
  827.             return;
  828.         }
  829.         panic("Tcl_RegisterChannel: duplicate channel names");
  830.     }
  831.     Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
  832.     chanPtr->refCount++;
  833. }
  834.  
  835. /*
  836.  *----------------------------------------------------------------------
  837.  *
  838.  * Tcl_GetChannel --
  839.  *
  840.  *    Finds an existing Tcl_Channel structure by name in a given
  841.  *    interpreter. This function is public because it is used by
  842.  *    channel-type-specific functions.
  843.  *
  844.  * Results:
  845.  *    A Tcl_Channel or NULL on failure. If failed, interp->result
  846.  *    contains an error message. It also returns, in modePtr, the
  847.  *    modes in which the channel is opened.
  848.  *
  849.  * Side effects:
  850.  *    None.
  851.  *
  852.  *----------------------------------------------------------------------
  853.  */
  854.  
  855. Tcl_Channel
  856. Tcl_GetChannel(interp, chanName, modePtr)
  857.     Tcl_Interp *interp;        /* Interpreter in which to find or create
  858.                                  * the channel. */
  859.     char *chanName;        /* The name of the channel. */
  860.     int *modePtr;        /* Where to store the mode in which the
  861.                                  * channel was opened? Will contain an ORed
  862.                                  * combination of TCL_READABLE and
  863.                                  * TCL_WRITABLE, if non-NULL. */
  864. {
  865.     Channel *chanPtr;        /* The actual channel. */
  866.     Tcl_HashTable *hTblPtr;    /* Hash table of channels. */
  867.     Tcl_HashEntry *hPtr;    /* Search variable. */
  868.     char *name;            /* Translated name. */
  869.  
  870.     /*
  871.      * Substitute "stdin", etc.  Note that even though we immediately
  872.      * find the channel using Tcl_GetStdChannel, we still need to look
  873.      * it up in the specified interpreter to ensure that it is present
  874.      * in the channel table.  Otherwise, safe interpreters would always
  875.      * have access to the standard channels.
  876.      */
  877.  
  878.     name = chanName;
  879.     if ((chanName[0] == 's') && (chanName[1] == 't')) {
  880.     chanPtr = NULL;
  881.     if (strcmp(chanName, "stdin") == 0) {
  882.         chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDIN);
  883.     } else if (strcmp(chanName, "stdout") == 0) {
  884.         chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDOUT);
  885.     } else if (strcmp(chanName, "stderr") == 0) {
  886.         chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDERR);
  887.     }
  888.     if (chanPtr != NULL) {
  889.         name = chanPtr->channelName;
  890.     }
  891.     }
  892.     
  893.     hTblPtr = GetChannelTable(interp);
  894.     hPtr = Tcl_FindHashEntry(hTblPtr, name);
  895.     if (hPtr == (Tcl_HashEntry *) NULL) {
  896.         Tcl_AppendResult(interp, "can not find channel named \"",
  897.                 chanName, "\"", (char *) NULL);
  898.         return NULL;
  899.     }
  900.  
  901.     chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
  902.     if (modePtr != NULL) {
  903.         *modePtr = (chanPtr->flags & (TCL_READABLE|TCL_WRITABLE));
  904.     }
  905.     
  906.     return (Tcl_Channel) chanPtr;
  907. }
  908.  
  909. /*
  910.  *----------------------------------------------------------------------
  911.  *
  912.  * Tcl_CreateChannel --
  913.  *
  914.  *    Creates a new entry in the hash table for a Tcl_Channel
  915.  *    record.
  916.  *
  917.  * Results:
  918.  *    Returns the new Tcl_Channel.
  919.  *
  920.  * Side effects:
  921.  *    Creates a new Tcl_Channel instance and inserts it into the
  922.  *    hash table.
  923.  *
  924.  *----------------------------------------------------------------------
  925.  */
  926.  
  927. Tcl_Channel
  928. Tcl_CreateChannel(typePtr, chanName, inFile, outFile, instanceData)
  929.     Tcl_ChannelType *typePtr;    /* The channel type record. */
  930.     char *chanName;        /* Name of channel to record. */
  931.     Tcl_File inFile;        /* File to use for input, or NULL. */
  932.     Tcl_File outFile;        /* File to use for output, or NULL. */
  933.     ClientData instanceData;    /* Instance specific data. */
  934. {
  935.     Channel *chanPtr;        /* The channel structure newly created. */
  936.  
  937.     chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
  938.     
  939.     if (chanName != (char *) NULL) {
  940.         chanPtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));
  941.         strcpy(chanPtr->channelName, chanName);
  942.     } else {
  943.         panic("Tcl_CreateChannel: NULL channel name");
  944.     }
  945.  
  946.     chanPtr->flags = 0;
  947.     if (inFile != (Tcl_File) NULL) {
  948.         chanPtr->flags |= TCL_READABLE;
  949.     }
  950.     if (outFile != (Tcl_File) NULL) {
  951.         chanPtr->flags |= TCL_WRITABLE;
  952.     }
  953.  
  954.     /*
  955.      * Set the channel up initially in AUTO input translation mode to
  956.      * accept "\n", "\r" and "\r\n". Output translation mode is set to
  957.      * a platform specific default value. The eofChar is set to 0 for both
  958.      * input and output, so that Tcl does not look for an in-file EOF
  959.      * indicator (e.g. ^Z) and does not append an EOF indicator to files.
  960.      */
  961.  
  962.     chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
  963.     chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
  964.     chanPtr->inEofChar = 0;
  965.     chanPtr->outEofChar = 0;
  966.  
  967.     chanPtr->unreportedError = 0;
  968.     chanPtr->instanceData = instanceData;
  969.     chanPtr->inFile = inFile;
  970.     chanPtr->outFile = outFile;
  971.     chanPtr->typePtr = typePtr;
  972.     chanPtr->refCount = 0;
  973.     chanPtr->closeCbPtr = (CloseCallback *) NULL;
  974.     chanPtr->curOutPtr = (ChannelBuffer *) NULL;
  975.     chanPtr->outQueueHead = (ChannelBuffer *) NULL;
  976.     chanPtr->outQueueTail = (ChannelBuffer *) NULL;
  977.     chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
  978.     chanPtr->inQueueHead = (ChannelBuffer *) NULL;
  979.     chanPtr->inQueueTail = (ChannelBuffer *) NULL;
  980.     chanPtr->chPtr = (ChannelHandler *) NULL;
  981.     chanPtr->interestMask = 0;
  982.     chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
  983.     chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
  984.  
  985.     /*
  986.      * Link the channel into the list of all channels; create an on-exit
  987.      * handler if there is not one already, to close off all the channels
  988.      * in the list on exit.
  989.      */
  990.  
  991.     chanPtr->nextChanPtr = firstChanPtr;
  992.     firstChanPtr = chanPtr;
  993.  
  994.     if (!channelExitHandlerCreated) {
  995.         channelExitHandlerCreated = 1;
  996.         Tcl_CreateExitHandler(CloseChannelsOnExit, (ClientData) NULL);
  997.     }
  998.  
  999.     /*
  1000.      * Install this channel in the first empty standard channel slot.
  1001.      */
  1002.  
  1003.     if (Tcl_GetStdChannel(TCL_STDIN) == NULL) {
  1004.     Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDIN);
  1005.     } else if (Tcl_GetStdChannel(TCL_STDOUT) == NULL) {
  1006.     Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDOUT);
  1007.     } else if (Tcl_GetStdChannel(TCL_STDERR) == NULL) {
  1008.     Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDERR);
  1009.     } 
  1010.  
  1011.     return (Tcl_Channel) chanPtr;
  1012. }
  1013.  
  1014. /*
  1015.  *----------------------------------------------------------------------
  1016.  *
  1017.  * Tcl_GetChannelName --
  1018.  *
  1019.  *    Returns the string identifying the channel name.
  1020.  *
  1021.  * Results:
  1022.  *    The string containing the channel name. This memory is
  1023.  *    owned by the generic layer and should not be modified by
  1024.  *    the caller.
  1025.  *
  1026.  * Side effects:
  1027.  *    None.
  1028.  *
  1029.  *----------------------------------------------------------------------
  1030.  */
  1031.  
  1032. char *
  1033. Tcl_GetChannelName(chan)
  1034.     Tcl_Channel chan;        /* The channel for which to return the name. */
  1035. {
  1036.     Channel *chanPtr;        /* The actual channel. */
  1037.  
  1038.     chanPtr = (Channel *) chan;
  1039.     return chanPtr->channelName;
  1040. }
  1041.  
  1042. /*
  1043.  *----------------------------------------------------------------------
  1044.  *
  1045.  * Tcl_GetChannelType --
  1046.  *
  1047.  *    Given a channel structure, returns the channel type structure.
  1048.  *
  1049.  * Results:
  1050.  *    Returns a pointer to the channel type structure.
  1051.  *
  1052.  * Side effects:
  1053.  *    None.
  1054.  *
  1055.  *----------------------------------------------------------------------
  1056.  */
  1057.  
  1058. Tcl_ChannelType *
  1059. Tcl_GetChannelType(chan)
  1060.     Tcl_Channel chan;        /* The channel to return type for. */
  1061. {
  1062.     Channel *chanPtr;        /* The actual channel. */
  1063.  
  1064.     chanPtr = (Channel *) chan;
  1065.     return chanPtr->typePtr;
  1066. }
  1067.  
  1068. /*
  1069.  *----------------------------------------------------------------------
  1070.  *
  1071.  * Tcl_GetChannelFile --
  1072.  *
  1073.  *    Returns a file associated with a channel.
  1074.  *
  1075.  * Results:
  1076.  *    The file or NULL if failed (e.g. the channel is not open for the
  1077.  *    requested direction).
  1078.  *
  1079.  * Side effects:
  1080.  *    None.
  1081.  *
  1082.  *----------------------------------------------------------------------
  1083.  */
  1084.  
  1085. Tcl_File
  1086. Tcl_GetChannelFile(chan, direction)
  1087.     Tcl_Channel chan;        /* The channel to get file from. */
  1088.     int direction;        /* TCL_WRITABLE or TCL_READABLE. */
  1089. {
  1090.     Channel *chanPtr;        /* The actual channel. */
  1091.  
  1092.     chanPtr = (Channel *) chan;
  1093.     switch (direction) {
  1094.         case TCL_WRITABLE:
  1095.             return chanPtr->outFile;
  1096.         case TCL_READABLE:
  1097.             return chanPtr->inFile;
  1098.         default:
  1099.             return NULL;
  1100.     }
  1101. }
  1102.  
  1103. /*
  1104.  *----------------------------------------------------------------------
  1105.  *
  1106.  * Tcl_GetChannelInstanceData --
  1107.  *
  1108.  *    Returns the client data associated with a channel.
  1109.  *
  1110.  * Results:
  1111.  *    The client data.
  1112.  *
  1113.  * Side effects:
  1114.  *    None.
  1115.  *
  1116.  *----------------------------------------------------------------------
  1117.  */
  1118.  
  1119. ClientData
  1120. Tcl_GetChannelInstanceData(chan)
  1121.     Tcl_Channel chan;        /* Channel for which to return client data. */
  1122. {
  1123.     Channel *chanPtr;        /* The actual channel. */
  1124.  
  1125.     chanPtr = (Channel *) chan;
  1126.     return chanPtr->instanceData;
  1127. }
  1128.  
  1129. /*
  1130.  *----------------------------------------------------------------------
  1131.  *
  1132.  * RecycleBuffer --
  1133.  *
  1134.  *    Helper function to recycle input and output buffers. Ensures
  1135.  *    that two input buffers are saved (one in the input queue and
  1136.  *    another in the saveInBufPtr field) and that curOutPtr is set
  1137.  *    to a buffer. Only if these conditions are met is the buffer
  1138.  *    freed to the OS.
  1139.  *
  1140.  * Results:
  1141.  *    None.
  1142.  *
  1143.  * Side effects:
  1144.  *    May free a buffer to the OS.
  1145.  *
  1146.  *----------------------------------------------------------------------
  1147.  */
  1148.  
  1149. static void
  1150. RecycleBuffer(chanPtr, bufPtr, mustDiscard)
  1151.     Channel *chanPtr;        /* Channel for which to recycle buffers. */
  1152.     ChannelBuffer *bufPtr;    /* The buffer to recycle. */
  1153.     int mustDiscard;        /* If nonzero, free the buffer to the
  1154.                                  * OS, always. */
  1155. {
  1156.     /*
  1157.      * Do we have to free the buffer to the OS?
  1158.      */
  1159.  
  1160.     if (mustDiscard) {
  1161.         ckfree((char *) bufPtr);
  1162.         return;
  1163.     }
  1164.     
  1165.     /*
  1166.      * Only save buffers for the input queue if the channel is readable.
  1167.      */
  1168.     
  1169.     if (chanPtr->flags & TCL_READABLE) {
  1170.         if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
  1171.             chanPtr->inQueueHead = bufPtr;
  1172.             chanPtr->inQueueTail = bufPtr;
  1173.             goto keepit;
  1174.         }
  1175.         if (chanPtr->saveInBufPtr == (ChannelBuffer *) NULL) {
  1176.             chanPtr->saveInBufPtr = bufPtr;
  1177.             goto keepit;
  1178.         }
  1179.     }
  1180.  
  1181.     /*
  1182.      * Only save buffers for the output queue if the channel is writable.
  1183.      */
  1184.  
  1185.     if (chanPtr->flags & TCL_WRITABLE) {
  1186.         if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
  1187.             chanPtr->curOutPtr = bufPtr;
  1188.             goto keepit;
  1189.         }
  1190.     }
  1191.  
  1192.     /*
  1193.      * If we reached this code we return the buffer to the OS.
  1194.      */
  1195.  
  1196.     ckfree((char *) bufPtr);
  1197.     return;
  1198.  
  1199. keepit:
  1200.     bufPtr->nextRemoved = 0;
  1201.     bufPtr->nextAdded = 0;
  1202.     bufPtr->nextPtr = (ChannelBuffer *) NULL;
  1203. }
  1204.  
  1205. /*
  1206.  *----------------------------------------------------------------------
  1207.  *
  1208.  * DiscardOutputQueued --
  1209.  *
  1210.  *    Discards all output queued in the output queue of a channel.
  1211.  *
  1212.  * Results:
  1213.  *    None.
  1214.  *
  1215.  * Side effects:
  1216.  *    Recycles buffers.
  1217.  *
  1218.  *----------------------------------------------------------------------
  1219.  */
  1220.  
  1221. static void
  1222. DiscardOutputQueued(chanPtr)
  1223.     Channel *chanPtr;        /* The channel for which to discard output. */
  1224. {
  1225.     ChannelBuffer *bufPtr;
  1226.     
  1227.     while (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
  1228.         bufPtr = chanPtr->outQueueHead;
  1229.         chanPtr->outQueueHead = bufPtr->nextPtr;
  1230.         RecycleBuffer(chanPtr, bufPtr, 0);
  1231.     }
  1232.     chanPtr->outQueueHead = (ChannelBuffer *) NULL;
  1233.     chanPtr->outQueueTail = (ChannelBuffer *) NULL;
  1234. }
  1235.  
  1236. /*
  1237.  *----------------------------------------------------------------------
  1238.  *
  1239.  * FlushChannel --
  1240.  *
  1241.  *    This function flushes as much of the queued output as is possible
  1242.  *    now. If calledFromAsyncFlush is nonzero, it is being called in an
  1243.  *    event handler to flush channel output asynchronously.
  1244.  *
  1245.  * Results:
  1246.  *    0 if successful, else the error code that was returned by the
  1247.  *    channel type operation.
  1248.  *
  1249.  * Side effects:
  1250.  *    May produce output on a channel. May block indefinitely if the
  1251.  *    channel is synchronous. May schedule an async flush on the channel.
  1252.  *    May recycle memory for buffers in the output queue.
  1253.  *
  1254.  *----------------------------------------------------------------------
  1255.  */
  1256.  
  1257. static int
  1258. FlushChannel(interp, chanPtr, calledFromAsyncFlush)
  1259.     Tcl_Interp *interp;            /* For error reporting during close. */
  1260.     Channel *chanPtr;            /* The channel to flush on. */
  1261.     int calledFromAsyncFlush;        /* If nonzero then we are being
  1262.                                          * called from an asynchronous
  1263.                                          * flush callback. */
  1264. {
  1265.     ChannelBuffer *bufPtr;        /* Iterates over buffered output
  1266.                                          * queue. */
  1267.     int toWrite;            /* Amount of output data in current
  1268.                                          * buffer available to be written. */
  1269.     int written;            /* Amount of output data actually
  1270.                                          * written in current round. */
  1271.     int errorCode;            /* Stores POSIX error codes from
  1272.                                          * channel driver operations. */
  1273.  
  1274.     errorCode = 0;
  1275.     
  1276.     /*
  1277.      * Loop over the queued buffers and attempt to flush as
  1278.      * much as possible of the queued output to the channel.
  1279.      */
  1280.  
  1281.     while (1) {
  1282.  
  1283.         /*
  1284.          * If the queue is empty and there is a ready current buffer, OR if
  1285.          * the current buffer is full, then move the current buffer to the
  1286.          * queue.
  1287.          */
  1288.         
  1289.         if (((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
  1290.                 (chanPtr->curOutPtr->nextAdded == chanPtr->curOutPtr->bufSize))
  1291.                 || ((chanPtr->flags & BUFFER_READY) &&
  1292.                         (chanPtr->outQueueHead == (ChannelBuffer *) NULL))) {
  1293.             chanPtr->flags &= (~(BUFFER_READY));
  1294.             chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
  1295.             if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
  1296.                 chanPtr->outQueueHead = chanPtr->curOutPtr;
  1297.             } else {
  1298.                 chanPtr->outQueueTail->nextPtr = chanPtr->curOutPtr;
  1299.             }
  1300.             chanPtr->outQueueTail = chanPtr->curOutPtr;
  1301.             chanPtr->curOutPtr = (ChannelBuffer *) NULL;
  1302.         }
  1303.         bufPtr = chanPtr->outQueueHead;
  1304.  
  1305.         /*
  1306.          * If we are not being called from an async flush and an async
  1307.          * flush is active, we just return without producing any output.
  1308.          */
  1309.  
  1310.         if ((!calledFromAsyncFlush) &&
  1311.                 (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
  1312.             return 0;
  1313.         }
  1314.  
  1315.         /*
  1316.          * If the output queue is still empty, break out of the while loop.
  1317.          */
  1318.  
  1319.         if (bufPtr == (ChannelBuffer *) NULL) {
  1320.             break;    /* Out of the "while (1)". */
  1321.         }
  1322.  
  1323.         /*
  1324.          * Produce the output on the channel.
  1325.          */
  1326.         
  1327.         toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
  1328.         written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
  1329.                 chanPtr->outFile, bufPtr->buf + bufPtr->nextRemoved,
  1330.                 toWrite, &errorCode);
  1331.             
  1332.     /*
  1333.          * If the write failed completely attempt to start the asynchronous
  1334.          * flush mechanism and break out of this loop - do not attempt to
  1335.          * write any more output at this time.
  1336.          */
  1337.  
  1338.         if (written < 0) {
  1339.             
  1340.             /*
  1341.              * If the last attempt to write was interrupted, simply retry.
  1342.              */
  1343.             
  1344.             if (errorCode == EINTR) {
  1345.                 continue;
  1346.             }
  1347.  
  1348.             /*
  1349.              * If we would have blocked, attempt to set up an asynchronous
  1350.              * background flushing for this channel if the channel is
  1351.              * nonblocking, or block until more output can be written if
  1352.              * the channel is blocking.
  1353.              */
  1354.  
  1355.             if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
  1356.                 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
  1357.                     if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
  1358.                         Tcl_CreateFileHandler(chanPtr->outFile,
  1359.                                 TCL_WRITABLE, FlushEventProc,
  1360.                                 (ClientData) chanPtr);
  1361.                     }
  1362.                     chanPtr->flags |= BG_FLUSH_SCHEDULED;
  1363.                     errorCode = 0;
  1364.                     break;    /* Out of the "while (1)" loop. */
  1365.                 } else {
  1366.  
  1367.                     /*
  1368.                      * If the device driver did not emulate blocking behavior
  1369.                      * then we must do it it here.
  1370.                      */
  1371.                     
  1372.                     TclWaitForFile(chanPtr->outFile, TCL_WRITABLE, -1);
  1373.                     continue;
  1374.                 }
  1375.             }
  1376.  
  1377.             /*
  1378.              * Decide whether to report the error upwards or defer it. If
  1379.              * we got an error during async flush we discard all queued
  1380.              * output.
  1381.              */
  1382.  
  1383.             if (calledFromAsyncFlush) {
  1384.                 if (chanPtr->unreportedError == 0) {
  1385.                     chanPtr->unreportedError = errorCode;
  1386.                 }
  1387.             } else {
  1388.                 Tcl_SetErrno(errorCode);
  1389.             }
  1390.  
  1391.             /*
  1392.              * When we get an error we throw away all the output
  1393.              * currently queued.
  1394.              */
  1395.  
  1396.             DiscardOutputQueued(chanPtr);
  1397.             continue;
  1398.         }
  1399.  
  1400.         bufPtr->nextRemoved += written;
  1401.  
  1402.         /*
  1403.          * If this buffer is now empty, recycle it.
  1404.          */
  1405.  
  1406.         if (bufPtr->nextRemoved == bufPtr->nextAdded) {
  1407.             chanPtr->outQueueHead = bufPtr->nextPtr;
  1408.             if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
  1409.                 chanPtr->outQueueTail = (ChannelBuffer *) NULL;
  1410.             }
  1411.             RecycleBuffer(chanPtr, bufPtr, 0);
  1412.         }
  1413.     }    /* Closes "while (1)". */
  1414.     
  1415.     /*
  1416.      * If the queue became empty and we have an asynchronous flushing
  1417.      * mechanism active, cancel the asynchronous flushing.
  1418.      */
  1419.  
  1420.     if ((chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
  1421.             (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
  1422.         chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
  1423.         if (chanPtr->outFile != (Tcl_File) NULL) {
  1424.             Tcl_DeleteFileHandler(chanPtr->outFile);
  1425.         }
  1426.     }
  1427.  
  1428.     /*
  1429.      * If the channel is flagged as closed, delete it when the refcount
  1430.      * drops to zero, the output queue is empty and there is no output
  1431.      * in the current output buffer.
  1432.      */
  1433.  
  1434.     if ((chanPtr->flags & CHANNEL_CLOSED) && (chanPtr->refCount <= 0) &&
  1435.             (chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
  1436.             ((chanPtr->curOutPtr == (ChannelBuffer *) NULL) ||
  1437.                     (chanPtr->curOutPtr->nextAdded ==
  1438.                             chanPtr->curOutPtr->nextRemoved))) {
  1439.         return CloseChannel(interp, chanPtr, errorCode);
  1440.     }
  1441.     return errorCode;
  1442. }
  1443.  
  1444. /*
  1445.  *----------------------------------------------------------------------
  1446.  *
  1447.  * CloseChannel --
  1448.  *
  1449.  *    Utility procedure to close a channel and free its associated
  1450.  *    resources.
  1451.  *
  1452.  * Results:
  1453.  *    0 on success or a POSIX error code if the operation failed.
  1454.  *
  1455.  * Side effects:
  1456.  *    May close the actual channel; may free memory.
  1457.  *
  1458.  *----------------------------------------------------------------------
  1459.  */
  1460.  
  1461. static int
  1462. CloseChannel(interp, chanPtr, errorCode)
  1463.     Tcl_Interp *interp;            /* For error reporting. */
  1464.     Channel *chanPtr;            /* The channel to close. */
  1465.     int errorCode;            /* Status of operation so far. */
  1466. {
  1467.     int result;                /* Of calling driver close
  1468.                                          * operation. */
  1469.     Channel *prevChanPtr;        /* Preceding channel in list of
  1470.                                          * all channels - used to splice a
  1471.                                          * channel out of the list on close. */
  1472.     
  1473.     /*
  1474.      * No more input can be consumed so discard any leftover input.
  1475.      */
  1476.  
  1477.     DiscardInputQueued(chanPtr, 1);
  1478.  
  1479.     /*
  1480.      * Discard a leftover buffer in the current output buffer field.
  1481.      */
  1482.  
  1483.     if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
  1484.         ckfree((char *) chanPtr->curOutPtr);
  1485.         chanPtr->curOutPtr = (ChannelBuffer *) NULL;
  1486.     }
  1487.     
  1488.     /*
  1489.      * The caller guarantees that there are no more buffers
  1490.      * queued for output.
  1491.      */
  1492.  
  1493.     if (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
  1494.         panic("TclFlush, closed channel: queued output left");
  1495.     }
  1496.  
  1497.     /*
  1498.      * If the EOF character is set in the channel, append that to the
  1499.      * output device.
  1500.      */
  1501.  
  1502.     if ((chanPtr->outEofChar != 0) && (chanPtr->outFile != NULL)) {
  1503.         int dummy;
  1504.         char c;
  1505.  
  1506.         c = (char) chanPtr->outEofChar;
  1507.         (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
  1508.                 chanPtr->outFile, &c, 1, &dummy);
  1509.     }
  1510.  
  1511.     /*
  1512.      * Remove TCL_READABLE and TCL_WRITABLE from chanPtr->flags, so
  1513.      * that close callbacks can not do input or output (assuming they
  1514.      * squirreled the channel away in their clientData). This also
  1515.      * prevents infinite loops if the callback calls any C API that
  1516.      * could call FlushChannel.
  1517.      */
  1518.  
  1519.     chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));
  1520.         
  1521.     /*
  1522.      * Splice this channel out of the list of all channels.
  1523.      */
  1524.  
  1525.     if (chanPtr == firstChanPtr) {
  1526.         firstChanPtr = chanPtr->nextChanPtr;
  1527.     } else {
  1528.         for (prevChanPtr = firstChanPtr;
  1529.                  (prevChanPtr != (Channel *) NULL) &&
  1530.                      (prevChanPtr->nextChanPtr != chanPtr);
  1531.                  prevChanPtr = prevChanPtr->nextChanPtr) {
  1532.             /* Empty loop body. */
  1533.         }
  1534.         if (prevChanPtr == (Channel *) NULL) {
  1535.             panic("FlushChannel: damaged channel list");
  1536.         }
  1537.         prevChanPtr->nextChanPtr = chanPtr->nextChanPtr;
  1538.     }
  1539.  
  1540.     if (chanPtr->channelName != (char *) NULL) {
  1541.         ckfree(chanPtr->channelName);
  1542.     }
  1543.  
  1544.     /*
  1545.      * OK, close the channel itself.
  1546.      */
  1547.         
  1548.     result = (chanPtr->typePtr->closeProc) (chanPtr->instanceData, interp,
  1549.             chanPtr->inFile, chanPtr->outFile);
  1550.     
  1551.     /*
  1552.      * If we are being called synchronously, report either
  1553.      * any latent error on the channel or the current error.
  1554.      */
  1555.         
  1556.     if (chanPtr->unreportedError != 0) {
  1557.         errorCode = chanPtr->unreportedError;
  1558.     }
  1559.     if (errorCode == 0) {
  1560.         errorCode = result;
  1561.         if (errorCode != 0) {
  1562.             Tcl_SetErrno(errorCode);
  1563.         }
  1564.     }
  1565.  
  1566.     Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
  1567.  
  1568.     return errorCode;
  1569. }
  1570.  
  1571. /*
  1572.  *----------------------------------------------------------------------
  1573.  *
  1574.  * Tcl_Close --
  1575.  *
  1576.  *    Closes a channel.
  1577.  *
  1578.  * Results:
  1579.  *    A standard Tcl result.
  1580.  *
  1581.  * Side effects:
  1582.  *    Closes the channel if this is the last reference.
  1583.  *
  1584.  * NOTE:
  1585.  *    Tcl_Close removes the channel as far as the user is concerned.
  1586.  *    However, it may continue to exist for a while longer if it has
  1587.  *    a background flush scheduled. The device itself is eventually
  1588.  *    closed and the channel record removed, in CloseChannel, above.
  1589.  *
  1590.  *----------------------------------------------------------------------
  1591.  */
  1592.  
  1593.     /* ARGSUSED */
  1594. int
  1595. Tcl_Close(interp, chan)
  1596.     Tcl_Interp *interp;            /* Interpreter for errors. */
  1597.     Tcl_Channel chan;            /* The channel being closed. Must
  1598.                                          * not be referenced in any
  1599.                                          * interpreter. */
  1600. {
  1601.     ChannelHandler *chPtr, *chNext;    /* Iterate over channel handlers. */
  1602.     CloseCallback *cbPtr;        /* Iterate over close callbacks
  1603.                                          * for this channel. */
  1604.     EventScriptRecord *ePtr, *eNextPtr;    /* Iterate over eventscript records. */
  1605.     Channel *chanPtr;            /* The real IO channel. */
  1606.     int result;                /* Of calling FlushChannel. */
  1607.  
  1608.     chanPtr = (Channel *) chan;
  1609.  
  1610.     if (chanPtr->refCount > 0) {
  1611.         panic("called Tcl_Close on channel with refcount > 0");
  1612.     }
  1613.         
  1614.     /*
  1615.      * Remove the channel from the standard channel table.
  1616.      */
  1617.  
  1618.     if (Tcl_GetStdChannel(TCL_STDIN) == chan) {
  1619.     Tcl_SetStdChannel(NULL, TCL_STDIN);
  1620.     } else if (Tcl_GetStdChannel(TCL_STDOUT) == chan) {
  1621.     Tcl_SetStdChannel(NULL, TCL_STDOUT);
  1622.     } else if (Tcl_GetStdChannel(TCL_STDERR) == chan) {
  1623.     Tcl_SetStdChannel(NULL, TCL_STDERR);
  1624.     } 
  1625.  
  1626.     /*
  1627.      * Remove all the channel handler records attached to the channel
  1628.      * itself.
  1629.      */
  1630.         
  1631.     for (chPtr = chanPtr->chPtr;
  1632.              chPtr != (ChannelHandler *) NULL;
  1633.              chPtr = chNext) {
  1634.         chNext = chPtr->nextPtr;
  1635.         ckfree((char *) chPtr);
  1636.     }
  1637.     chanPtr->chPtr = (ChannelHandler *) NULL;
  1638.  
  1639.     /*
  1640.      * Must set the interest mask now to 0, otherwise infinite loops
  1641.      * will occur if Tcl_DoOneEvent is called before the channel is
  1642.      * finally deleted in FlushChannel. This can happen if the channel
  1643.      * has a background flush active.
  1644.      */
  1645.         
  1646.     chanPtr->interestMask = 0;
  1647.     
  1648.     /*
  1649.      * Remove any EventScript records for this channel.
  1650.      */
  1651.  
  1652.     for (ePtr = chanPtr->scriptRecordPtr;
  1653.              ePtr != (EventScriptRecord *) NULL;
  1654.              ePtr = eNextPtr) {
  1655.         eNextPtr = ePtr->nextPtr;
  1656.         Tcl_EventuallyFree((ClientData)ePtr->script, TCL_DYNAMIC);
  1657.         ckfree((char *) ePtr);
  1658.     }
  1659.     chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
  1660.         
  1661.     /*
  1662.      * Invoke the registered close callbacks and delete their records.
  1663.      */
  1664.  
  1665.     while (chanPtr->closeCbPtr != (CloseCallback *) NULL) {
  1666.         cbPtr = chanPtr->closeCbPtr;
  1667.         chanPtr->closeCbPtr = cbPtr->nextPtr;
  1668.         (cbPtr->proc) (cbPtr->clientData);
  1669.         ckfree((char *) cbPtr);
  1670.     }
  1671.  
  1672.     /*
  1673.      * And remove any events for this channel from the event queue.
  1674.      */
  1675.  
  1676.     Tcl_DeleteEvents(ChannelEventDeleteProc, (ClientData) chanPtr);
  1677.  
  1678.     /*
  1679.      * Ensure that the last output buffer will be flushed.
  1680.      */
  1681.     
  1682.     if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
  1683.            (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
  1684.         chanPtr->flags |= BUFFER_READY;
  1685.     }
  1686.  
  1687.     /*
  1688.      * The call to FlushChannel will flush any queued output and invoke
  1689.      * the close function of the channel driver, or it will set up the
  1690.      * channel to be flushed and closed asynchronously.
  1691.      */
  1692.     
  1693.     chanPtr->flags |= CHANNEL_CLOSED;
  1694.     result = FlushChannel(interp, chanPtr, 0);
  1695.     if (result != 0) {
  1696.         return TCL_ERROR;
  1697.     }
  1698.  
  1699.     return TCL_OK;
  1700. }
  1701.  
  1702. /*
  1703.  *----------------------------------------------------------------------
  1704.  *
  1705.  * ChannelEventDeleteProc --
  1706.  *
  1707.  *    This procedure returns 1 if the event passed in is for the
  1708.  *    channel passed in as the second argument. This procedure is
  1709.  *    used as a filter for events to delete in a call to
  1710.  *    Tcl_DeleteEvents in CloseChannel.
  1711.  *
  1712.  * Results:
  1713.  *    1 if matching, 0 otherwise.
  1714.  *
  1715.  * Side effects:
  1716.  *    None.
  1717.  *
  1718.  *----------------------------------------------------------------------
  1719.  */
  1720.  
  1721. static int
  1722. ChannelEventDeleteProc(evPtr, clientData)
  1723.     Tcl_Event *evPtr;        /* The event to check for a match. */
  1724.     ClientData clientData;    /* The channel to check for. */
  1725. {
  1726.     ChannelHandlerEvent *cEvPtr;
  1727.     Channel *chanPtr;
  1728.  
  1729.     if (evPtr->proc != ChannelHandlerEventProc) {
  1730.         return 0;
  1731.     }
  1732.     cEvPtr = (ChannelHandlerEvent *) evPtr;
  1733.     chanPtr = (Channel *) clientData;
  1734.     if (cEvPtr->chanPtr != chanPtr) {
  1735.         return 0;
  1736.     }
  1737.     return 1;
  1738. }
  1739.  
  1740. /*
  1741.  *----------------------------------------------------------------------
  1742.  *
  1743.  * Tcl_Write --
  1744.  *
  1745.  *    Puts a sequence of characters into an output buffer, may queue the
  1746.  *    buffer for output if it gets full, and also remembers whether the
  1747.  *    current buffer is ready e.g. if it contains a newline and we are in
  1748.  *    line buffering mode.
  1749.  *
  1750.  * Results:
  1751.  *    The number of bytes written or -1 in case of error. If -1,
  1752.  *    Tcl_GetErrno will return the error code.
  1753.  *
  1754.  * Side effects:
  1755.  *    May buffer up output and may cause output to be produced on the
  1756.  *    channel.
  1757.  *
  1758.  *----------------------------------------------------------------------
  1759.  */
  1760.  
  1761. int
  1762. Tcl_Write(chan, srcPtr, slen)
  1763.     Tcl_Channel chan;            /* The channel to buffer output for. */
  1764.     char *srcPtr;            /* Output to buffer. */
  1765.     int slen;                /* Its length. Negative means
  1766.                                          * the output is null terminated
  1767.                                          * and we must compute its length. */
  1768. {
  1769.     Channel *chanPtr;            /* The actual channel. */
  1770.     ChannelBuffer *outBufPtr;        /* Current output buffer. */
  1771.     int foundNewline;            /* Did we find a newline in output? */
  1772.     char *dPtr, *sPtr;            /* Search variables for newline. */
  1773.     int crsent;                /* In CRLF eol translation mode,
  1774.                                          * remember the fact that a CR was
  1775.                                          * output to the channel without
  1776.                                          * its following NL. */
  1777.     int i;                /* Loop index for newline search. */
  1778.     int destCopied;            /* How many bytes were used in this
  1779.                                          * destination buffer to hold the
  1780.                                          * output? */
  1781.     int totalDestCopied;        /* How many bytes total were
  1782.                                          * copied to the channel buffer? */
  1783.     int srcCopied;            /* How many bytes were copied from
  1784.                                          * the source string? */
  1785.     char *destPtr;            /* Where in line to copy to? */
  1786.  
  1787.     chanPtr = (Channel *) chan;
  1788.  
  1789.     /*
  1790.      * Check for unreported error.
  1791.      */
  1792.  
  1793.     if (chanPtr->unreportedError != 0) {
  1794.         Tcl_SetErrno(chanPtr->unreportedError);
  1795.         chanPtr->unreportedError = 0;
  1796.         return -1;
  1797.     }
  1798.     
  1799.     /*
  1800.      * If the channel is not open for writing punt.
  1801.      */
  1802.  
  1803.     if (!(chanPtr->flags & TCL_WRITABLE)) {
  1804.         Tcl_SetErrno(EACCES);
  1805.         return -1;
  1806.     }
  1807.     
  1808.     /*
  1809.      * If length passed is negative, assume that the output is null terminated
  1810.      * and compute its length.
  1811.      */
  1812.     
  1813.     if (slen < 0) {
  1814.         slen = strlen(srcPtr);
  1815.     }
  1816.     
  1817.     /*
  1818.      * If we are in network (or windows) translation mode, record the fact
  1819.      * that we have not yet sent a CR to the channel.
  1820.      */
  1821.  
  1822.     crsent = 0;
  1823.     
  1824.     /*
  1825.      * Loop filling buffers and flushing them until all output has been
  1826.      * consumed.
  1827.      */
  1828.  
  1829.     srcCopied = 0;
  1830.     totalDestCopied = 0;
  1831.  
  1832.     while (slen > 0) {
  1833.         
  1834.         /*
  1835.          * Make sure there is a current output buffer to accept output.
  1836.          */
  1837.  
  1838.         if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
  1839.             chanPtr->curOutPtr = (ChannelBuffer *) ckalloc((unsigned)
  1840.                     (CHANNELBUFFER_HEADER_SIZE + chanPtr->bufSize));
  1841.             chanPtr->curOutPtr->nextAdded = 0;
  1842.             chanPtr->curOutPtr->nextRemoved = 0;
  1843.             chanPtr->curOutPtr->bufSize = chanPtr->bufSize;
  1844.             chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
  1845.         }
  1846.  
  1847.         outBufPtr = chanPtr->curOutPtr;
  1848.  
  1849.         destCopied = outBufPtr->bufSize - outBufPtr->nextAdded;
  1850.         if (destCopied > slen) {
  1851.             destCopied = slen;
  1852.         }
  1853.         
  1854.         destPtr = outBufPtr->buf + outBufPtr->nextAdded;
  1855.         switch (chanPtr->outputTranslation) {
  1856.             case TCL_TRANSLATE_LF:
  1857.                 srcCopied = destCopied;
  1858.                 memcpy((VOID *) destPtr, (VOID *) srcPtr, (size_t) destCopied);
  1859.                 break;
  1860.             case TCL_TRANSLATE_CR:
  1861.                 srcCopied = destCopied;
  1862.                 memcpy((VOID *) destPtr, (VOID *) srcPtr, (size_t) destCopied);
  1863.                 for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
  1864.                     if (*dPtr == '\n') {
  1865.                         *dPtr = '\r';
  1866.                     }
  1867.                 }
  1868.                 break;
  1869.             case TCL_TRANSLATE_CRLF:
  1870.                 for (srcCopied = 0, dPtr = destPtr, sPtr = srcPtr;
  1871.                      dPtr < destPtr + destCopied;
  1872.                      dPtr++, sPtr++, srcCopied++) {
  1873.                     if (*sPtr == '\n') {
  1874.                         if (crsent) {
  1875.                             *dPtr = '\n';
  1876.                             crsent = 0;
  1877.                         } else {
  1878.                             *dPtr = '\r';
  1879.                             crsent = 1;
  1880.                             sPtr--, srcCopied--;
  1881.                         }
  1882.                     } else {
  1883.                         *dPtr = *sPtr;
  1884.                     }
  1885.                 }
  1886.                 break;
  1887.             case TCL_TRANSLATE_AUTO:
  1888.                 panic("Tcl_Write: AUTO output translation mode not supported");
  1889.             default:
  1890.                 panic("Tcl_Write: unknown output translation mode");
  1891.         }
  1892.  
  1893.         /*
  1894.          * The current buffer is ready for output if it is full, or if it
  1895.          * contains a newline and this channel is line-buffered, or if it
  1896.          * contains any output and this channel is unbuffered.
  1897.          */
  1898.  
  1899.         outBufPtr->nextAdded += destCopied;
  1900.         if (!(chanPtr->flags & BUFFER_READY)) {
  1901.             if (outBufPtr->nextAdded == outBufPtr->bufSize) {
  1902.                 chanPtr->flags |= BUFFER_READY;
  1903.             } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
  1904.                 for (sPtr = srcPtr, i = 0, foundNewline = 0;
  1905.                          (i < srcCopied) && (!foundNewline);
  1906.                          i++, sPtr++) {
  1907.                     if (*sPtr == '\n') {
  1908.                         foundNewline = 1;
  1909.                         break;
  1910.                     }
  1911.                 }
  1912.                 if (foundNewline) {
  1913.                     chanPtr->flags |= BUFFER_READY;
  1914.                 }
  1915.             } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
  1916.                 chanPtr->flags |= BUFFER_READY;
  1917.             }
  1918.         }
  1919.         
  1920.         totalDestCopied += srcCopied;
  1921.         srcPtr += srcCopied;
  1922.         slen -= srcCopied;
  1923.  
  1924.         if (chanPtr->flags & BUFFER_READY) {
  1925.             if (FlushChannel(NULL, chanPtr, 0) != 0) {
  1926.                 return -1;
  1927.             }
  1928.         }
  1929.     } /* Closes "while" */
  1930.  
  1931.     return totalDestCopied;
  1932. }
  1933.  
  1934. /*
  1935.  *----------------------------------------------------------------------
  1936.  *
  1937.  * Tcl_Flush --
  1938.  *
  1939.  *    Flushes output data on a channel.
  1940.  *
  1941.  * Results:
  1942.  *    A standard Tcl result.
  1943.  *
  1944.  * Side effects:
  1945.  *    May flush output queued on this channel.
  1946.  *
  1947.  *----------------------------------------------------------------------
  1948.  */
  1949.  
  1950. int
  1951. Tcl_Flush(chan)
  1952.     Tcl_Channel chan;            /* The Channel to flush. */
  1953. {
  1954.     int result;                /* Of calling FlushChannel. */
  1955.     Channel *chanPtr;            /* The actual channel. */
  1956.  
  1957.     chanPtr = (Channel *) chan;
  1958.  
  1959.     /*
  1960.      * Check for unreported error.
  1961.      */
  1962.  
  1963.     if (chanPtr->unreportedError != 0) {
  1964.         Tcl_SetErrno(chanPtr->unreportedError);
  1965.         chanPtr->unreportedError = 0;
  1966.         return TCL_ERROR;
  1967.     }
  1968.  
  1969.     /*
  1970.      * If the channel is not open for writing punt.
  1971.      */
  1972.  
  1973.     if (!(chanPtr->flags & TCL_WRITABLE)) {
  1974.         Tcl_SetErrno(EACCES);
  1975.         return TCL_ERROR;
  1976.     }
  1977.     
  1978.     /*
  1979.      * Force current output buffer to be output also.
  1980.      */
  1981.     
  1982.     if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
  1983.             (chanPtr->curOutPtr->nextAdded > 0)) {
  1984.         chanPtr->flags |= BUFFER_READY;
  1985.     }
  1986.     
  1987.     result = FlushChannel(NULL, chanPtr, 0);
  1988.     if (result != 0) {
  1989.         return TCL_ERROR;
  1990.     }
  1991.  
  1992.     return TCL_OK;
  1993. }
  1994.  
  1995. /*
  1996.  *----------------------------------------------------------------------
  1997.  *
  1998.  * DiscardInputQueued --
  1999.  *
  2000.  *    Discards any input read from the channel but not yet consumed
  2001.  *    by Tcl reading commands.
  2002.  *
  2003.  * Results:
  2004.  *    None.
  2005.  *
  2006.  * Side effects:
  2007.  *    May discard input from the channel. If discardLastBuffer is zero,
  2008.  *    leaves one buffer in place for back-filling.
  2009.  *
  2010.  *----------------------------------------------------------------------
  2011.  */
  2012.  
  2013. static void
  2014. DiscardInputQueued(chanPtr, discardSavedBuffers)
  2015.     Channel *chanPtr;        /* Channel on which to discard
  2016.                                  * the queued input. */
  2017.     int discardSavedBuffers;    /* If non-zero, discard all buffers including
  2018.                                  * last one. */
  2019. {
  2020.     ChannelBuffer *bufPtr, *nxtPtr;    /* Loop variables. */
  2021.  
  2022.     bufPtr = chanPtr->inQueueHead;
  2023.     chanPtr->inQueueHead = (ChannelBuffer *) NULL;
  2024.     chanPtr->inQueueTail = (ChannelBuffer *) NULL;
  2025.     for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
  2026.         nxtPtr = bufPtr->nextPtr;
  2027.         RecycleBuffer(chanPtr, bufPtr, discardSavedBuffers);
  2028.     }
  2029.  
  2030.     /*
  2031.      * If discardSavedBuffers is nonzero, must also discard any previously
  2032.      * saved buffer in the saveInBufPtr field.
  2033.      */
  2034.     
  2035.     if (discardSavedBuffers) {
  2036.         if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
  2037.             ckfree((char *) chanPtr->saveInBufPtr);
  2038.             chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
  2039.         }
  2040.     }
  2041. }
  2042.  
  2043. /*
  2044.  *----------------------------------------------------------------------
  2045.  *
  2046.  * GetInput --
  2047.  *
  2048.  *    Reads input data from a device or file into an input buffer.
  2049.  *
  2050.  * Results:
  2051.  *    A Posix error code or 0.
  2052.  *
  2053.  * Side effects:
  2054.  *    Reads from the underlying device.
  2055.  *
  2056.  *----------------------------------------------------------------------
  2057.  */
  2058.  
  2059. static int
  2060. GetInput(chanPtr)
  2061.     Channel *chanPtr;            /* Channel to read input from. */
  2062. {
  2063.     int toRead;                /* How much to read? */
  2064.     int result;                /* Of calling driver. */
  2065.     int nread;                /* How much was read from channel? */
  2066.     ChannelBuffer *bufPtr;        /* New buffer to add to input queue. */
  2067.  
  2068.     /*
  2069.      * See if we can fill an existing buffer. If we can, read only
  2070.      * as much as will fit in it. Otherwise allocate a new buffer,
  2071.      * add it to the input queue and attempt to fill it to the max.
  2072.      */
  2073.  
  2074.     if ((chanPtr->inQueueTail != (ChannelBuffer *) NULL) &&
  2075.            (chanPtr->inQueueTail->nextAdded < chanPtr->inQueueTail->bufSize)) {
  2076.         bufPtr = chanPtr->inQueueTail;
  2077.         toRead = bufPtr->bufSize - bufPtr->nextAdded;
  2078.     } else {
  2079.     if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
  2080.         bufPtr = chanPtr->saveInBufPtr;
  2081.         chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
  2082.     } else {
  2083.         bufPtr = (ChannelBuffer *) ckalloc(
  2084.         ((unsigned) CHANNELBUFFER_HEADER_SIZE + chanPtr->bufSize));
  2085.         bufPtr->bufSize = chanPtr->bufSize;
  2086.     }
  2087.     bufPtr->nextRemoved = 0;
  2088.     bufPtr->nextAdded = 0;
  2089.         toRead = bufPtr->bufSize;
  2090.         if (chanPtr->inQueueTail == (ChannelBuffer *) NULL) {
  2091.             chanPtr->inQueueHead = bufPtr;
  2092.         } else {
  2093.             chanPtr->inQueueTail->nextPtr = bufPtr;
  2094.         }
  2095.         chanPtr->inQueueTail = bufPtr;
  2096.         bufPtr->nextPtr = (ChannelBuffer *) NULL;
  2097.     }
  2098.       
  2099.     while (1) {
  2100.     
  2101.         /*
  2102.          * If EOF is set, we should avoid calling the driver because on some
  2103.          * platforms it is impossible to read from a device after EOF.
  2104.          */
  2105.  
  2106.         if (chanPtr->flags & CHANNEL_EOF) {
  2107.         break;
  2108.         }
  2109.         nread = (chanPtr->typePtr->inputProc) (chanPtr->instanceData,
  2110.                 chanPtr->inFile, bufPtr->buf + bufPtr->nextAdded,
  2111.                 toRead, &result);
  2112.         if (nread == 0) {
  2113.             chanPtr->flags |= CHANNEL_EOF;
  2114.             break;
  2115.         } else if (nread < 0) {
  2116.             if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
  2117.                 chanPtr->flags |= CHANNEL_BLOCKED;
  2118.                 result = EAGAIN;
  2119.                 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
  2120.                     Tcl_SetErrno(result);
  2121.                     return result;
  2122.                 } else {
  2123.  
  2124.                     /*
  2125.                      * If the device driver did not emulate blocking behavior
  2126.                      * then we have to do it here.
  2127.                      */
  2128.                     
  2129.                     TclWaitForFile(chanPtr->inFile, TCL_READABLE, -1);
  2130.                 }
  2131.             } else {
  2132.                 Tcl_SetErrno(result);
  2133.                 return result;
  2134.             }
  2135.         } else {
  2136.             bufPtr->nextAdded += nread;
  2137.  
  2138.             /*
  2139.              * If we get a short read, signal up that we may be BLOCKED. We
  2140.              * should avoid calling the driver because on some platforms we
  2141.              * will block in the low level reading code even though the
  2142.              * channel is set into nonblocking mode.
  2143.              */
  2144.             
  2145.             if (nread < toRead) {
  2146.                 chanPtr->flags |= CHANNEL_BLOCKED;
  2147.             }
  2148.             break;
  2149.         }
  2150.     }
  2151.  
  2152.     return 0;
  2153. }
  2154.  
  2155. /*
  2156.  *----------------------------------------------------------------------
  2157.  *
  2158.  * CopyAndTranslateBuffer --
  2159.  *
  2160.  *    Copy at most one buffer of input to the result space, doing
  2161.  *    eol translations according to mode in effect currently.
  2162.  *
  2163.  * Results:
  2164.  *    Number of characters (as opposed to bytes) copied. May return
  2165.  *    zero if no input is available to be translated.
  2166.  *
  2167.  * Side effects:
  2168.  *    Consumes buffered input. May deallocate one buffer.
  2169.  *
  2170.  *----------------------------------------------------------------------
  2171.  */
  2172.  
  2173. static int
  2174. CopyAndTranslateBuffer(chanPtr, result, space)
  2175.     Channel *chanPtr;        /* The channel from which to read input. */
  2176.     char *result;        /* Where to store the copied input. */
  2177.     int space;            /* How many bytes are available in result
  2178.                                  * to store the copied input? */
  2179. {
  2180.     int bytesInBuffer;        /* How many bytes are available to be
  2181.                                  * copied in the current input buffer? */
  2182.     int copied;            /* How many characters were already copied
  2183.                                  * into the destination space? */
  2184.     ChannelBuffer *bufPtr;    /* The buffer from which to copy bytes. */
  2185.     char curByte;        /* The byte we are currently translating. */
  2186.     int i;            /* Iterates over the copied input looking
  2187.                                  * for the input eofChar. */
  2188.     
  2189.     /*
  2190.      * If there is no input at all, return zero. The invariant is that either
  2191.      * there is no buffer in the queue, or if the first buffer is empty, it
  2192.      * is also the last buffer (and thus there is no input in the queue).
  2193.      * Note also that if the buffer is empty, we leave it in the queue.
  2194.      */
  2195.     
  2196.     if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
  2197.         return 0;
  2198.     }
  2199.     bufPtr = chanPtr->inQueueHead;
  2200.     bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
  2201.     if (bytesInBuffer < space) {
  2202.         space = bytesInBuffer;
  2203.     }
  2204.     copied = 0;
  2205.     switch (chanPtr->inputTranslation) {
  2206.         case TCL_TRANSLATE_LF:
  2207.  
  2208.             if (space == 0) {
  2209.                 return 0;
  2210.             }
  2211.             
  2212.         /*
  2213.              * Copy the current chunk into the result buffer.
  2214.              */
  2215.  
  2216.             memcpy((VOID *) result,
  2217.                     (VOID *)(bufPtr->buf + bufPtr->nextRemoved),
  2218.                     (size_t) space);
  2219.             bufPtr->nextRemoved += space;
  2220.             copied = space;
  2221.             break;
  2222.  
  2223.         case TCL_TRANSLATE_CR:
  2224.  
  2225.             if (space == 0) {
  2226.                 return 0;
  2227.             }
  2228.  
  2229.         /*
  2230.              * Copy the current chunk into the result buffer, then
  2231.              * replace all \r with \n.
  2232.              */
  2233.  
  2234.             memcpy((VOID *) result,
  2235.                     (VOID *)(bufPtr->buf + bufPtr->nextRemoved),
  2236.                     (size_t) space);
  2237.             bufPtr->nextRemoved += space;
  2238.             for (copied = 0; copied < space; copied++) {
  2239.                 if (result[copied] == '\r') {
  2240.                     result[copied] = '\n';
  2241.                 }
  2242.             }
  2243.             break;
  2244.  
  2245.         case TCL_TRANSLATE_CRLF:
  2246.  
  2247.             /*
  2248.              * If there is a held-back "\r" at EOF, produce it now.
  2249.              */
  2250.             
  2251.             if (space == 0) {
  2252.                 if ((chanPtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
  2253.                         (INPUT_SAW_CR | CHANNEL_EOF)) {
  2254.                     result[0] = '\r';
  2255.                     chanPtr->flags &= (~(INPUT_SAW_CR));
  2256.                     return 1;
  2257.                 }
  2258.                 return 0;
  2259.             }
  2260.  
  2261.             /*
  2262.              * Copy the current chunk and replace "\r\n" with "\n"
  2263.              * (but not standalone "\r"!).
  2264.              */
  2265.  
  2266.             for (copied = 0;
  2267.                      (copied < space) &&
  2268.                          (bufPtr->nextRemoved < bufPtr->nextAdded);
  2269.                      copied++) {
  2270.                 curByte = bufPtr->buf[bufPtr->nextRemoved];
  2271.                 bufPtr->nextRemoved++;
  2272.                 if (curByte == '\r') {
  2273.                     if (chanPtr->flags & INPUT_SAW_CR) {
  2274.                         result[copied] = '\r';
  2275.                     } else {
  2276.                         chanPtr->flags |= INPUT_SAW_CR;
  2277.                         copied--;
  2278.                     }
  2279.                 } else if (curByte == '\n') {
  2280.                     chanPtr->flags &= (~(INPUT_SAW_CR));
  2281.                     result[copied] = '\n';
  2282.                 } else {
  2283.                     if (chanPtr->flags & INPUT_SAW_CR) {
  2284.                         chanPtr->flags &= (~(INPUT_SAW_CR));
  2285.                         result[copied] = '\r';
  2286.                         copied++;
  2287.                     }
  2288.                     result[copied] = curByte;
  2289.                 }
  2290.             }
  2291.             break;
  2292.                 
  2293.         case TCL_TRANSLATE_AUTO:
  2294.             
  2295.             if (space == 0) {
  2296.                 return 0;
  2297.             }
  2298.  
  2299.             /*
  2300.              * Loop over the current buffer, converting "\r" and "\r\n"
  2301.              * to "\n".
  2302.              */
  2303.  
  2304.             for (copied = 0;
  2305.                      (copied < space) &&
  2306.                          (bufPtr->nextRemoved < bufPtr->nextAdded); ) {
  2307.                 curByte = bufPtr->buf[bufPtr->nextRemoved];
  2308.                 bufPtr->nextRemoved++;
  2309.                 if (curByte == '\r') {
  2310.                     result[copied] = '\n';
  2311.             copied++;
  2312.                     if (bufPtr->nextRemoved < bufPtr->nextAdded) {
  2313.                         if (bufPtr->buf[bufPtr->nextRemoved] == '\n') {
  2314.                             bufPtr->nextRemoved++;
  2315.                         }
  2316.                         chanPtr->flags &= (~(INPUT_SAW_CR));
  2317.                     } else {
  2318.                         chanPtr->flags |= INPUT_SAW_CR;
  2319.                     }
  2320.                 } else {
  2321.                     if (curByte == '\n') {
  2322.                         if (!(chanPtr->flags & INPUT_SAW_CR)) {
  2323.                             result[copied] = '\n';
  2324.                 copied++;
  2325.                         }
  2326.                     } else {
  2327.                         result[copied] = curByte;
  2328.             copied++;
  2329.                     }
  2330.                     chanPtr->flags &= (~(INPUT_SAW_CR));
  2331.                 }
  2332.             }
  2333.             break;
  2334.  
  2335.         default:
  2336.             panic("unknown eol translation mode");
  2337.     }
  2338.  
  2339.     /*
  2340.      * If an in-stream EOF character is set for this channel,, check that
  2341.      * the input we copied so far does not contain the EOF char. If it does,
  2342.      * copy only up to and excluding that character.
  2343.      */
  2344.     
  2345.     if (chanPtr->inEofChar != 0) {
  2346.         for (i = 0; i < copied; i++) {
  2347.             if (result[i] == (char) chanPtr->inEofChar) {
  2348.                 break;
  2349.             }
  2350.         }
  2351.         if (i < copied) {
  2352.  
  2353.             /*
  2354.              * Set sticky EOF so that no further input is presented
  2355.              * to the caller.
  2356.              */
  2357.             
  2358.             chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
  2359.  
  2360.             /*
  2361.              * Reset the start of valid data in the input buffer to the
  2362.              * position of the eofChar, so that subsequent reads will
  2363.              * encounter it immediately. First we set it to the position
  2364.              * of the last byte consumed if all result bytes were the
  2365.              * product of one input byte; since it is possible that "\r\n"
  2366.              * contracted to "\n" in the result, we have to search back
  2367.              * from that position until we find the eofChar, because it
  2368.              * is possible that its actual position in the buffer is n
  2369.              * bytes further back (n is the number of "\r\n" sequences
  2370.              * that were contracted to "\n" in the result).
  2371.              */
  2372.                   
  2373.             bufPtr->nextRemoved -= (copied - i);
  2374.             while ((bufPtr->nextRemoved > 0) &&
  2375.                     (bufPtr->buf[bufPtr->nextRemoved] !=
  2376.                             (char) chanPtr->inEofChar)) {
  2377.                 bufPtr->nextRemoved--;
  2378.             }
  2379.             copied = i;
  2380.         }
  2381.     }
  2382.  
  2383.     /*
  2384.      * If the current buffer is empty recycle it.
  2385.      */
  2386.  
  2387.     if (bufPtr->nextRemoved == bufPtr->nextAdded) {
  2388.         chanPtr->inQueueHead = bufPtr->nextPtr;
  2389.         if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
  2390.             chanPtr->inQueueTail = (ChannelBuffer *) NULL;
  2391.         }
  2392.         RecycleBuffer(chanPtr, bufPtr, 0);
  2393.     }
  2394.  
  2395.     /*
  2396.      * Return the number of characters copied into the result buffer.
  2397.      * This may be different from the number of bytes consumed, because
  2398.      * of EOL translations.
  2399.      */
  2400.  
  2401.     return copied;
  2402. }
  2403.  
  2404. /*
  2405.  *----------------------------------------------------------------------
  2406.  *
  2407.  * ScanBufferForEOL --
  2408.  *
  2409.  *    Scans one buffer for EOL according to the specified EOL
  2410.  *    translation mode. If it sees the input eofChar for the channel
  2411.  *    it stops also.
  2412.  *
  2413.  * Results:
  2414.  *    TRUE if EOL is found, FALSE otherwise. Also sets output parameter
  2415.  *    bytesToEOLPtr to the number of bytes so far to EOL, and crSeenPtr
  2416.  *    to whether a "\r" was seen.
  2417.  *
  2418.  * Side effects:
  2419.  *    None.
  2420.  *
  2421.  *----------------------------------------------------------------------
  2422.  */
  2423.  
  2424. static int
  2425. ScanBufferForEOL(chanPtr, bufPtr, translation, eofChar, bytesToEOLPtr,
  2426.                  crSeenPtr)
  2427.     Channel *chanPtr;
  2428.     ChannelBuffer *bufPtr;        /* Buffer to scan for EOL. */
  2429.     Tcl_EolTranslation translation;    /* Translation mode to use. */
  2430.     int eofChar;            /* EOF char to look for. */
  2431.     int *bytesToEOLPtr;            /* Running counter. */
  2432.     int *crSeenPtr;            /* Has "\r" been seen? */
  2433. {
  2434.     char *rPtr;                /* Iterates over input string. */
  2435.     char *sPtr;                /* Where to stop search? */
  2436.     int EOLFound;
  2437.     int bytesToEOL;
  2438.     
  2439.     for (EOLFound = 0, rPtr = bufPtr->buf + bufPtr->nextRemoved,
  2440.              sPtr = bufPtr->buf + bufPtr->nextAdded,
  2441.              bytesToEOL = *bytesToEOLPtr;
  2442.              (!EOLFound) && (rPtr < sPtr);
  2443.              rPtr++) {
  2444.         switch (translation) {
  2445.             case TCL_TRANSLATE_AUTO:
  2446.                 if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
  2447.                     chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
  2448.                     EOLFound = 1;
  2449.                 } else if (*rPtr == '\n') {
  2450.  
  2451.             /*
  2452.                      * CopyAndTranslateBuffer wants to know the length
  2453.                      * of the result, not the input. The input is one
  2454.                      * larger because "\r\n" shrinks to "\n".
  2455.                      */
  2456.  
  2457.                     if (!(*crSeenPtr)) {
  2458.                         bytesToEOL++;
  2459.             EOLFound = 1;
  2460.                     } else {
  2461.  
  2462.             /*
  2463.              * This is a lf at the begining of a buffer
  2464.              * where the previous buffer ended in a cr.
  2465.              * Consume this lf because we've already emitted
  2466.              * the newline for this crlf sequence. ALSO, if
  2467.                          * bytesToEOL is 0 (which means that we are at the
  2468.                          * first character of the scan), unset the
  2469.                          * INPUT_SAW_CR flag in the channel, because we
  2470.                          * already handled it; leaving it set would cause
  2471.                          * CopyAndTranslateBuffer to potentially consume
  2472.                          * another lf if one follows the current byte.
  2473.              */
  2474.  
  2475.             bufPtr->nextRemoved++;
  2476.                         *crSeenPtr = 0;
  2477.                         chanPtr->flags &= (~(INPUT_SAW_CR));
  2478.             }
  2479.                 } else if (*rPtr == '\r') {
  2480.                     bytesToEOL++;
  2481.                     EOLFound = 1;
  2482.                 } else {
  2483.                     *crSeenPtr = 0;
  2484.                     bytesToEOL++;
  2485.                 }
  2486.                 break;
  2487.             case TCL_TRANSLATE_LF:
  2488.                 if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
  2489.                     chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
  2490.                     EOLFound = 1;
  2491.                 } else {
  2492.                     if (*rPtr == '\n') {
  2493.                         EOLFound = 1;
  2494.                     }
  2495.                     bytesToEOL++;
  2496.                 }
  2497.                 break;
  2498.             case TCL_TRANSLATE_CR:
  2499.                 if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
  2500.                     chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
  2501.                     EOLFound = 1;
  2502.                 } else {
  2503.                     if (*rPtr == '\r') {
  2504.                         EOLFound = 1;
  2505.                     }
  2506.                     bytesToEOL++;
  2507.                 }
  2508.                 break;
  2509.             case TCL_TRANSLATE_CRLF:
  2510.                 if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
  2511.                     chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
  2512.                     EOLFound = 1;
  2513.                 } else if (*rPtr == '\n') {
  2514.  
  2515.                     /*
  2516.                      * CopyAndTranslateBuffer wants to know the length
  2517.                      * of the result, not the input. The input is one
  2518.                      * larger because crlf shrinks to lf.
  2519.                      */
  2520.  
  2521.                     if (*crSeenPtr) {
  2522.                         EOLFound = 1;
  2523.                     } else {
  2524.                         bytesToEOL++;
  2525.                     }
  2526.                 } else {
  2527.                     if (*rPtr == '\r') {
  2528.                         *crSeenPtr = 1;
  2529.                     } else {
  2530.                         *crSeenPtr = 0;
  2531.                     }
  2532.                     bytesToEOL++;
  2533.                 }
  2534.                 break;
  2535.             default:
  2536.                 panic("unknown eol translation mode");
  2537.         }
  2538.     }
  2539.  
  2540.     *bytesToEOLPtr = bytesToEOL;
  2541.     return EOLFound;
  2542. }
  2543.  
  2544. /*
  2545.  *----------------------------------------------------------------------
  2546.  *
  2547.  * ScanInputForEOL --
  2548.  *
  2549.  *    Scans queued input for chanPtr for an end of line (according to the
  2550.  *    current EOL translation mode) and returns the number of bytes
  2551.  *    upto and including the end of line, or -1 if none was found.
  2552.  *
  2553.  * Results:
  2554.  *    Count of bytes upto and including the end of line if one is present
  2555.  *    or -1 if none was found. Also returns in an output parameter the
  2556.  *    number of bytes queued if no end of line was found.
  2557.  *
  2558.  * Side effects:
  2559.  *    None.
  2560.  *
  2561.  *----------------------------------------------------------------------
  2562.  */
  2563.  
  2564. static int
  2565. ScanInputForEOL(chanPtr, bytesQueuedPtr)
  2566.     Channel *chanPtr;    /* Channel for which to scan queued
  2567.                                  * input for end of line. */
  2568.     int *bytesQueuedPtr;    /* Where to store the number of bytes
  2569.                                  * currently queued if no end of line
  2570.                                  * was found. */
  2571. {
  2572.     ChannelBuffer *bufPtr;    /* Iterates over queued buffers. */
  2573.     int bytesToEOL;        /* How many bytes to end of line? */
  2574.     int EOLFound;        /* Did we find an end of line? */
  2575.     int crSeen;            /* Did we see a "\r" in CRLF mode? */
  2576.  
  2577.     *bytesQueuedPtr = 0;
  2578.     bytesToEOL = 0;
  2579.     EOLFound = 0;
  2580.     for (bufPtr = chanPtr->inQueueHead,
  2581.              crSeen = (chanPtr->flags & INPUT_SAW_CR) ? 1 : 0;
  2582.             (!EOLFound) && (bufPtr != (ChannelBuffer *) NULL);
  2583.             bufPtr = bufPtr->nextPtr) {
  2584.         EOLFound = ScanBufferForEOL(chanPtr, bufPtr, chanPtr->inputTranslation,
  2585.                 chanPtr->inEofChar, &bytesToEOL, &crSeen);
  2586.     }
  2587.  
  2588.     if (EOLFound == 0) {
  2589.         *bytesQueuedPtr = bytesToEOL;
  2590.         return -1;
  2591.     }
  2592.     return bytesToEOL;        
  2593. }
  2594.  
  2595. /*
  2596.  *----------------------------------------------------------------------
  2597.  *
  2598.  * GetEOL --
  2599.  *
  2600.  *    Accumulate input into the channel input buffer queue until an
  2601.  *    end of line has been seen.
  2602.  *
  2603.  * Results:
  2604.  *    Number of bytes buffered or -1 on failure.
  2605.  *
  2606.  * Side effects:
  2607.  *    Consumes input from the channel.
  2608.  *
  2609.  *----------------------------------------------------------------------
  2610.  */
  2611.  
  2612. static int
  2613. GetEOL(chanPtr)
  2614.     Channel *chanPtr;    /* Channel to queue input on. */
  2615. {
  2616.     int result;            /* Of getting another buffer from the
  2617.                                  * channel. */
  2618.     int bytesToEOL;        /* How many bytes in buffer up to and
  2619.                                  * including the end of line? */
  2620.     int bytesQueued;        /* How many bytes are queued currently
  2621.                                  * in the input chain of the channel? */
  2622.  
  2623.     while (1) {
  2624.         bytesToEOL = ScanInputForEOL(chanPtr, &bytesQueued);
  2625.         if (bytesToEOL > 0) {
  2626.             chanPtr->flags &= (~(CHANNEL_BLOCKED));
  2627.             return bytesToEOL;
  2628.         }
  2629.         if (chanPtr->flags & CHANNEL_EOF) {
  2630.         /*
  2631.          * Boundary case where cr was at the end of the previous buffer
  2632.          * and this buffer just has a newline.  At EOF our caller wants
  2633.          * to see -1 for the line length.
  2634.          */
  2635.             return (bytesQueued == 0) ? -1 : bytesQueued ;
  2636.         }
  2637.         if (chanPtr->flags & CHANNEL_BLOCKED) {
  2638.             if (chanPtr->flags & CHANNEL_NONBLOCKING) {
  2639.                 return -1;
  2640.             }
  2641.             chanPtr->flags &= (~(CHANNEL_BLOCKED));
  2642.         }
  2643.         result = GetInput(chanPtr);
  2644.         if (result != 0) {
  2645.             if (result == EAGAIN) {
  2646.                 chanPtr->flags |= CHANNEL_BLOCKED;
  2647.             }
  2648.             return -1;
  2649.         }
  2650.     }
  2651. }
  2652.  
  2653. /*
  2654.  *----------------------------------------------------------------------
  2655.  *
  2656.  * Tcl_Read --
  2657.  *
  2658.  *    Reads a given number of characters from a channel.
  2659.  *
  2660.  * Results:
  2661.  *    The number of characters read, or -1 on error. Use Tcl_GetErrno()
  2662.  *    to retrieve the error code for the error that occurred.
  2663.  *
  2664.  * Side effects:
  2665.  *    May cause input to be buffered.
  2666.  *
  2667.  *----------------------------------------------------------------------
  2668.  */
  2669.  
  2670. int
  2671. Tcl_Read(chan, bufPtr, toRead)
  2672.     Tcl_Channel chan;        /* The channel from which to read. */
  2673.     char *bufPtr;        /* Where to store input read. */
  2674.     int toRead;            /* Maximum number of characters to read. */
  2675. {
  2676.     Channel *chanPtr;        /* The real IO channel. */
  2677.     int copied;            /* How many characters were copied into
  2678.                                  * the result string? */
  2679.     int copiedNow;        /* How many characters were copied from
  2680.                                  * the current input buffer? */
  2681.     int result;            /* Of calling GetInput. */
  2682.     
  2683.     chanPtr = (Channel *) chan;
  2684.  
  2685.     /*
  2686.      * Check for unreported error.
  2687.      */
  2688.  
  2689.     if (chanPtr->unreportedError != 0) {
  2690.         Tcl_SetErrno(chanPtr->unreportedError);
  2691.         chanPtr->unreportedError = 0;
  2692.         return -1;
  2693.     }
  2694.  
  2695.     /*
  2696.      * Punt if the channel is not opened for reading.
  2697.      */
  2698.  
  2699.     if (!(chanPtr->flags & TCL_READABLE)) {
  2700.         Tcl_SetErrno(EACCES);
  2701.         return -1;
  2702.     }
  2703.     
  2704.     /*
  2705.      * If we have not encountered a sticky EOF, clear the EOF bit. Either
  2706.      * way clear the BLOCKED bit. We want to discover these anew during
  2707.      * each operation.
  2708.      */
  2709.  
  2710.     if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
  2711.         chanPtr->flags &= (~(CHANNEL_EOF));
  2712.     }
  2713.     chanPtr->flags &= (~(CHANNEL_BLOCKED));
  2714.     
  2715.     for (copied = 0; copied < toRead; copied += copiedNow) {
  2716.         copiedNow = CopyAndTranslateBuffer(chanPtr, bufPtr + copied,
  2717.                 toRead - copied);
  2718.         if (copiedNow == 0) {
  2719.             if (chanPtr->flags & CHANNEL_EOF) {
  2720.                 return copied;
  2721.             }
  2722.             if (chanPtr->flags & CHANNEL_BLOCKED) {
  2723.                 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
  2724.                     return copied;
  2725.                 }
  2726.                 chanPtr->flags &= (~(CHANNEL_BLOCKED));
  2727.             }
  2728.             result = GetInput(chanPtr);
  2729.             if (result != 0) {
  2730.                 if (result == EAGAIN) {
  2731.                     return copied;
  2732.                 }
  2733.                 return -1;
  2734.             }
  2735.         }
  2736.     }
  2737.     chanPtr->flags &= (~(CHANNEL_BLOCKED));
  2738.     return copied;
  2739. }
  2740.  
  2741. /*
  2742.  *----------------------------------------------------------------------
  2743.  *
  2744.  * Tcl_Gets --
  2745.  *
  2746.  *    Reads a complete line of input from the channel.
  2747.  *
  2748.  * Results:
  2749.  *    Length of line read or -1 if error, EOF or blocked. If -1, use
  2750.  *    Tcl_GetErrno() to retrieve the POSIX error code for the
  2751.  *    error or condition that occurred.
  2752.  *
  2753.  * Side effects:
  2754.  *    May flush output on the channel. May cause input to be
  2755.  *    consumed from the channel.
  2756.  *
  2757.  *----------------------------------------------------------------------
  2758.  */
  2759.  
  2760. int
  2761. Tcl_Gets(chan, lineRead)
  2762.     Tcl_Channel chan;        /* Channel from which to read. */
  2763.     Tcl_DString *lineRead;    /* The characters of the line read
  2764.                                  * (excluding the terminating newline if
  2765.                                  * present) will be appended to this
  2766.                                  * DString. The caller must have initialized
  2767.                                  * it and is responsible for managing the
  2768.                                  * storage. */
  2769. {
  2770.     Channel *chanPtr;        /* The channel to read from. */
  2771.     char *buf;            /* Points into DString where data
  2772.                                  * will be stored. */
  2773.     int offset;            /* Offset from start of DString at
  2774.                                  * which to append the line just read. */
  2775.     int copiedTotal;        /* Accumulates total length of input copied. */
  2776.     int copiedNow;        /* How many bytes were copied from the
  2777.                                  * current input buffer? */
  2778.     int lineLen;        /* Length of line read, including the
  2779.                                  * translated newline. If this is zero
  2780.                                  * and neither EOF nor BLOCKED is set,
  2781.                                  * the current line is empty. */
  2782.     
  2783.     chanPtr = (Channel *) chan;
  2784.  
  2785.     /*
  2786.      * Check for unreported error.
  2787.      */
  2788.  
  2789.     if (chanPtr->unreportedError != 0) {
  2790.         Tcl_SetErrno(chanPtr->unreportedError);
  2791.         chanPtr->unreportedError = 0;
  2792.         return -1;
  2793.     }
  2794.  
  2795.     /*
  2796.      * Punt if the channel is not opened for reading.
  2797.      */
  2798.  
  2799.     if (!(chanPtr->flags & TCL_READABLE)) {
  2800.         Tcl_SetErrno(EACCES);
  2801.         return -1;
  2802.     }
  2803.  
  2804.     /*
  2805.      * If we have not encountered a sticky EOF, clear the EOF bit
  2806.      * (sticky EOF is set if we have seen the input eofChar, to prevent
  2807.      * reading beyond the eofChar). Also, always clear the BLOCKED bit.
  2808.      * We want to discover these conditions anew in each operation.
  2809.      */
  2810.     
  2811.     if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
  2812.         chanPtr->flags &= (~(CHANNEL_EOF));
  2813.     }
  2814.     chanPtr->flags &= (~(CHANNEL_BLOCKED));
  2815.     lineLen = GetEOL(chanPtr);
  2816.     if (lineLen < 0) {
  2817.         return -1;
  2818.     }
  2819.     if (lineLen == 0) {
  2820.         if (chanPtr->flags & (CHANNEL_EOF | CHANNEL_BLOCKED)) {
  2821.             return -1;
  2822.         }
  2823.         return 0;
  2824.     }
  2825.     offset = Tcl_DStringLength(lineRead);
  2826.     Tcl_DStringSetLength(lineRead, lineLen + offset);
  2827.     buf = Tcl_DStringValue(lineRead) + offset;
  2828.  
  2829.     for (copiedTotal = 0; copiedTotal < lineLen; copiedTotal += copiedNow) {
  2830.         copiedNow = CopyAndTranslateBuffer(chanPtr, buf + copiedTotal,
  2831.                 lineLen - copiedTotal);
  2832.     }
  2833.     if ((copiedTotal > 0) && (buf[copiedTotal - 1] == '\n')) {
  2834.         copiedTotal--;
  2835.     }
  2836.     Tcl_DStringSetLength(lineRead, copiedTotal + offset);
  2837.     return copiedTotal;
  2838. }
  2839.  
  2840. /*
  2841.  *----------------------------------------------------------------------
  2842.  *
  2843.  * Tcl_Seek --
  2844.  *
  2845.  *    Implements seeking on Tcl Channels. This is a public function
  2846.  *    so that other C facilities may be implemented on top of it.
  2847.  *
  2848.  * Results:
  2849.  *    The new access point or -1 on error. If error, use Tcl_GetErrno()
  2850.  *    to retrieve the POSIX error code for the error that occurred.
  2851.  *
  2852.  * Side effects:
  2853.  *    May flush output on the channel. May discard queued input.
  2854.  *
  2855.  *----------------------------------------------------------------------
  2856.  */
  2857.  
  2858. int
  2859. Tcl_Seek(chan, offset, mode)
  2860.     Tcl_Channel chan;        /* The channel on which to seek. */
  2861.     int offset;            /* Offset to seek to. */
  2862.     int mode;            /* Relative to which location to seek? */
  2863. {
  2864.     Channel *chanPtr;    /* The real IO channel. */
  2865.     ChannelBuffer *bufPtr;    /* Iterates over queued input
  2866.                                  * and output buffers. */
  2867.     int inputBuffered, outputBuffered;
  2868.     int result;            /* Of device driver operations. */
  2869.     int curPos;            /* Position on the device. */
  2870.     int wasAsync;        /* Was the channel nonblocking before the
  2871.                                  * seek operation? If so, must restore to
  2872.                                  * nonblocking mode after the seek. */
  2873.  
  2874.     chanPtr = (Channel *) chan;
  2875.  
  2876.     /*
  2877.      * Check for unreported error.
  2878.      */
  2879.  
  2880.     if (chanPtr->unreportedError != 0) {
  2881.         Tcl_SetErrno(chanPtr->unreportedError);
  2882.         chanPtr->unreportedError = 0;
  2883.         return -1;
  2884.     }
  2885.  
  2886.     /*
  2887.      * Disallow seek on channels that are open for neither writing nor
  2888.      * reading (e.g. socket server channels).
  2889.      */
  2890.  
  2891.     if (!(chanPtr->flags & (TCL_WRITABLE|TCL_READABLE))) {
  2892.         Tcl_SetErrno(EACCES);
  2893.         return -1;
  2894.     }
  2895.  
  2896.     /*
  2897.      * Disallow seek on channels whose type does not have a seek procedure
  2898.      * defined. This means that the channel does not support seeking.
  2899.      */
  2900.  
  2901.     if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
  2902.         Tcl_SetErrno(EINVAL);
  2903.         return -1;
  2904.     }
  2905.  
  2906.     /*
  2907.      * Compute how much input and output is buffered. If both input and
  2908.      * output is buffered, cannot compute the current position.
  2909.      */
  2910.  
  2911.     for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
  2912.              bufPtr != (ChannelBuffer *) NULL;
  2913.              bufPtr = bufPtr->nextPtr) {
  2914.         inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
  2915.     }
  2916.     for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
  2917.              bufPtr != (ChannelBuffer *) NULL;
  2918.              bufPtr = bufPtr->nextPtr) {
  2919.         outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
  2920.     }
  2921.     if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
  2922.            (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
  2923.         chanPtr->flags |= BUFFER_READY;
  2924.         outputBuffered +=
  2925.             (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
  2926.     }
  2927.     if ((inputBuffered != 0) && (outputBuffered != 0)) {
  2928.         Tcl_SetErrno(EFAULT);
  2929.         return -1;
  2930.     }
  2931.  
  2932.     /*
  2933.      * If we are seeking relative to the current position, compute the
  2934.      * corrected offset taking into account the amount of unread input.
  2935.      */
  2936.  
  2937.     if (mode == SEEK_CUR) {
  2938.         offset -= inputBuffered;
  2939.     }
  2940.  
  2941.     /*
  2942.      * Discard any queued input - this input should not be read after
  2943.      * the seek.
  2944.      */
  2945.  
  2946.     DiscardInputQueued(chanPtr, 0);
  2947.  
  2948.     /*
  2949.      * Reset EOF and BLOCKED flags. We invalidate them by moving the
  2950.      * access point. Also clear CR related flags.
  2951.      */
  2952.  
  2953.     chanPtr->flags &=
  2954.         (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR));
  2955.     
  2956.     /*
  2957.      * If the channel is in asynchronous output mode, switch it back
  2958.      * to synchronous mode and cancel any async flush that may be
  2959.      * scheduled. After the flush, the channel will be put back into
  2960.      * asynchronous output mode.
  2961.      */
  2962.  
  2963.     wasAsync = 0;
  2964.     if (chanPtr->flags & CHANNEL_NONBLOCKING) {
  2965.         wasAsync = 1;
  2966.         result = 0;
  2967.         if (chanPtr->typePtr->blockModeProc != NULL) {
  2968.             result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
  2969.                     chanPtr->inFile, chanPtr->outFile, TCL_MODE_BLOCKING);
  2970.         }
  2971.         if (result != 0) {
  2972.             Tcl_SetErrno(result);
  2973.             return -1;
  2974.         }
  2975.         chanPtr->flags &= (~(CHANNEL_NONBLOCKING));
  2976.         if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
  2977.             Tcl_DeleteFileHandler(chanPtr->outFile);
  2978.             chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
  2979.         }
  2980.     }
  2981.     
  2982.     /*
  2983.      * If the flush fails we cannot recover the original position. In
  2984.      * that case the seek is not attempted because we do not know where
  2985.      * the access position is - instead we return the error. FlushChannel
  2986.      * has already called Tcl_SetErrno() to report the error upwards.
  2987.      * If the flush succeeds we do the seek also.
  2988.      */
  2989.     
  2990.     if (FlushChannel(NULL, chanPtr, 0) != 0) {
  2991.         curPos = -1;
  2992.     } else {
  2993.  
  2994.         /*
  2995.          * Now seek to the new position in the channel as requested by the
  2996.          * caller.
  2997.          */
  2998.  
  2999.         curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
  3000.                 chanPtr->inFile, chanPtr->outFile, (long) offset,
  3001.                 mode, &result);
  3002.         if (curPos == -1) {
  3003.             Tcl_SetErrno(result);
  3004.         }
  3005.     }
  3006.     
  3007.     /*
  3008.      * Restore to nonblocking mode if that was the previous behavior.
  3009.      *
  3010.      * NOTE: Even if there was an async flush active we do not restore
  3011.      * it now because we already flushed all the queued output, above.
  3012.      */
  3013.     
  3014.     if (wasAsync) {
  3015.         chanPtr->flags |= CHANNEL_NONBLOCKING;
  3016.         result = 0;
  3017.         if (chanPtr->typePtr->blockModeProc != NULL) {
  3018.             result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
  3019.                     chanPtr->inFile, chanPtr->outFile, TCL_MODE_NONBLOCKING);
  3020.         }
  3021.         if (result != 0) {
  3022.             Tcl_SetErrno(result);
  3023.             return -1;
  3024.         }
  3025.     }
  3026.  
  3027.     return curPos;
  3028. }
  3029.  
  3030. /*
  3031.  *----------------------------------------------------------------------
  3032.  *
  3033.  * Tcl_Tell --
  3034.  *
  3035.  *    Returns the position of the next character to be read/written on
  3036.  *    this channel.
  3037.  *
  3038.  * Results:
  3039.  *    A nonnegative integer on success, -1 on failure. If failed,
  3040.  *    use Tcl_GetErrno() to retrieve the POSIX error code for the
  3041.  *    error that occurred.
  3042.  *
  3043.  * Side effects:
  3044.  *    None.
  3045.  *
  3046.  *----------------------------------------------------------------------
  3047.  */
  3048.  
  3049. int
  3050. Tcl_Tell(chan)
  3051.     Tcl_Channel chan;            /* The channel to return pos for. */
  3052. {
  3053.     Channel *chanPtr;        /* The actual channel to tell on. */
  3054.     ChannelBuffer *bufPtr;        /* Iterates over queued input
  3055.                                          * and output buffers. */
  3056.     int inputBuffered, outputBuffered;
  3057.     int result;                /* Of calling device driver. */
  3058.     int curPos;                /* Position on device. */
  3059.  
  3060.     chanPtr = (Channel *) chan;
  3061.  
  3062.     /*
  3063.      * Check for unreported error.
  3064.      */
  3065.  
  3066.     if (chanPtr->unreportedError != 0) {
  3067.         Tcl_SetErrno(chanPtr->unreportedError);
  3068.         chanPtr->unreportedError = 0;
  3069.         return -1;
  3070.     }
  3071.  
  3072.     /*
  3073.      * Disallow tell on channels that are open for neither
  3074.      * writing nor reading (e.g. socket server channels).
  3075.      */
  3076.  
  3077.     if (!(chanPtr->flags & (TCL_WRITABLE|TCL_READABLE))) {
  3078.         Tcl_SetErrno(EACCES);
  3079.         return -1;
  3080.     }
  3081.  
  3082.     /*
  3083.      * Disallow tell on channels whose type does not have a seek procedure
  3084.      * defined. This means that the channel does not support seeking.
  3085.      */
  3086.  
  3087.     if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
  3088.         Tcl_SetErrno(EINVAL);
  3089.         return -1;
  3090.     }
  3091.  
  3092.     /*
  3093.      * Compute how much input and output is buffered. If both input and
  3094.      * output is buffered, cannot compute the current position.
  3095.      */
  3096.  
  3097.     for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
  3098.              bufPtr != (ChannelBuffer *) NULL;
  3099.              bufPtr = bufPtr->nextPtr) {
  3100.         inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
  3101.     }
  3102.     for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
  3103.              bufPtr != (ChannelBuffer *) NULL;
  3104.              bufPtr = bufPtr->nextPtr) {
  3105.         outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
  3106.     }
  3107.     if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
  3108.         outputBuffered +=
  3109.             (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
  3110.     }
  3111.     if ((inputBuffered != 0) && (outputBuffered != 0)) {
  3112.         Tcl_SetErrno(EFAULT);
  3113.         return -1;
  3114.     }
  3115.  
  3116.     /*
  3117.      * Get the current position in the device and compute the position
  3118.      * where the next character will be read or written.
  3119.      */
  3120.  
  3121.     curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
  3122.             chanPtr->inFile, chanPtr->outFile, (long) 0, SEEK_CUR, &result);
  3123.     if (curPos == -1) {
  3124.         Tcl_SetErrno(result);
  3125.         return -1;
  3126.     }
  3127.     if (inputBuffered != 0) {
  3128.         return (curPos - inputBuffered);
  3129.     }
  3130.     return (curPos + outputBuffered);
  3131. }
  3132.  
  3133. /*
  3134.  *----------------------------------------------------------------------
  3135.  *
  3136.  * Tcl_Eof --
  3137.  *
  3138.  *    Returns 1 if the channel is at EOF, 0 otherwise.
  3139.  *
  3140.  * Results:
  3141.  *    1 or 0, always.
  3142.  *
  3143.  * Side effects:
  3144.  *    None.
  3145.  *
  3146.  *----------------------------------------------------------------------
  3147.  */
  3148.  
  3149. int
  3150. Tcl_Eof(chan)
  3151.     Tcl_Channel chan;            /* Does this channel have EOF? */
  3152. {
  3153.     Channel *chanPtr;        /* The real channel structure. */
  3154.  
  3155.     chanPtr = (Channel *) chan;
  3156.     return ((chanPtr->flags & CHANNEL_STICKY_EOF) ||
  3157.             ((chanPtr->flags & CHANNEL_EOF) && (Tcl_InputBuffered(chan) == 0)))
  3158.         ? 1 : 0;
  3159. }
  3160.  
  3161. /*
  3162.  *----------------------------------------------------------------------
  3163.  *
  3164.  * Tcl_InputBlocked --
  3165.  *
  3166.  *    Returns 1 if input is blocked on this channel, 0 otherwise.
  3167.  *
  3168.  * Results:
  3169.  *    0 or 1, always.
  3170.  *
  3171.  * Side effects:
  3172.  *    None.
  3173.  *
  3174.  *----------------------------------------------------------------------
  3175.  */
  3176.  
  3177. int
  3178. Tcl_InputBlocked(chan)
  3179.     Tcl_Channel chan;            /* Is this channel blocked? */
  3180. {
  3181.     Channel *chanPtr;        /* The real channel structure. */
  3182.  
  3183.     chanPtr = (Channel *) chan;
  3184.     return (chanPtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
  3185. }
  3186.  
  3187. /*
  3188.  *----------------------------------------------------------------------
  3189.  *
  3190.  * Tcl_InputBuffered --
  3191.  *
  3192.  *    Returns the number of bytes of input currently buffered in the
  3193.  *    internal buffer of a channel.
  3194.  *
  3195.  * Results:
  3196.  *    The number of input bytes buffered, or zero if the channel is not
  3197.  *    open for reading.
  3198.  *
  3199.  * Side effects:
  3200.  *    None.
  3201.  *
  3202.  *----------------------------------------------------------------------
  3203.  */
  3204.  
  3205. int
  3206. Tcl_InputBuffered(chan)
  3207.     Tcl_Channel chan;            /* The channel to query. */
  3208. {
  3209.     Channel *chanPtr;
  3210.     int bytesBuffered;
  3211.     ChannelBuffer *bufPtr;
  3212.  
  3213.     chanPtr = (Channel *) chan;
  3214.     for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;
  3215.              bufPtr != (ChannelBuffer *) NULL;
  3216.              bufPtr = bufPtr->nextPtr) {
  3217.         bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
  3218.     }
  3219.     return bytesBuffered;
  3220. }
  3221.  
  3222. /*
  3223.  *----------------------------------------------------------------------
  3224.  *
  3225.  * Tcl_SetChannelBufferSize --
  3226.  *
  3227.  *    Sets the size of buffers to allocate to store input or output
  3228.  *    in the channel. The size must be between 10 bytes and 1 MByte.
  3229.  *
  3230.  * Results:
  3231.  *    None.
  3232.  *
  3233.  * Side effects:
  3234.  *    Sets the size of buffers subsequently allocated for this channel.
  3235.  *
  3236.  *----------------------------------------------------------------------
  3237.  */
  3238.  
  3239. void
  3240. Tcl_SetChannelBufferSize(chan, sz)
  3241.     Tcl_Channel chan;            /* The channel whose buffer size
  3242.                                          * to set. */
  3243.     int sz;                /* The size to set. */
  3244. {
  3245.     Channel *chanPtr;
  3246.     
  3247.     if (sz < 10) {
  3248.         sz = CHANNELBUFFER_DEFAULT_SIZE;
  3249.     }
  3250.  
  3251.     /*
  3252.      * Allow only buffers that are smaller than one megabyte.
  3253.      */
  3254.     
  3255.     if (sz > (1024 * 1024)) {
  3256.         sz = CHANNELBUFFER_DEFAULT_SIZE;
  3257.     }
  3258.  
  3259.     chanPtr = (Channel *) chan;
  3260.     chanPtr->bufSize = sz;
  3261. }
  3262.  
  3263. /*
  3264.  *----------------------------------------------------------------------
  3265.  *
  3266.  * Tcl_GetChannelBufferSize --
  3267.  *
  3268.  *    Retrieves the size of buffers to allocate for this channel.
  3269.  *
  3270.  * Results:
  3271.  *    The size.
  3272.  *
  3273.  * Side effects:
  3274.  *    None.
  3275.  *
  3276.  *----------------------------------------------------------------------
  3277.  */
  3278.  
  3279. int
  3280. Tcl_GetChannelBufferSize(chan)
  3281.     Tcl_Channel chan;        /* The channel for which to find the
  3282.                                  * buffer size. */
  3283. {
  3284.     Channel *chanPtr;
  3285.  
  3286.     chanPtr = (Channel *) chan;
  3287.     return chanPtr->bufSize;
  3288. }
  3289.  
  3290. /*
  3291.  *----------------------------------------------------------------------
  3292.  *
  3293.  * Tcl_GetChannelOption --
  3294.  *
  3295.  *    Gets a mode associated with an IO channel. If the optionName arg
  3296.  *    is non NULL, retrieves the value of that option. If the optionName
  3297.  *    arg is NULL, retrieves a list of alternating option names and
  3298.  *    values for the given channel.
  3299.  *
  3300.  * Results:
  3301.  *    A standard Tcl result. Also sets the supplied DString to the
  3302.  *    string value of the option(s) returned.
  3303.  *
  3304.  * Side effects:
  3305.  *    The string returned by this function is in static storage and
  3306.  *    may be reused at any time subsequent to the call.
  3307.  *
  3308.  *----------------------------------------------------------------------
  3309.  */
  3310.  
  3311. int
  3312. Tcl_GetChannelOption(chan, optionName, dsPtr)
  3313.     Tcl_Channel chan;        /* Channel on which to get option. */
  3314.     char *optionName;        /* Option to get. */
  3315.     Tcl_DString *dsPtr;        /* Where to store value(s). */
  3316. {
  3317.     Channel *chanPtr;        /* The real IO channel. */
  3318.     size_t len;            /* Length of optionName string. */
  3319.  
  3320.     chanPtr = (Channel *) chan;
  3321.  
  3322.     /*
  3323.      * If the optionName is NULL it means that we want a list of all
  3324.      * options and values.
  3325.      */
  3326.     
  3327.     if (optionName == (char *) NULL) {
  3328.         len = 0;
  3329.     } else {
  3330.         len = strlen(optionName);
  3331.     }
  3332.     
  3333.     if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&
  3334.             (strncmp(optionName, "-blocking", len) == 0))) {
  3335.         if (len == 0) {
  3336.             Tcl_DStringAppendElement(dsPtr, "-blocking");
  3337.         }
  3338.         Tcl_DStringAppendElement(dsPtr,
  3339.                 (chanPtr->flags & CHANNEL_NONBLOCKING) ? "0" : "1");
  3340.         if (len > 0) {
  3341.             return TCL_OK;
  3342.         }
  3343.     }
  3344.     if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
  3345.             (strncmp(optionName, "-buffering", len) == 0))) {
  3346.         if (len == 0) {
  3347.             Tcl_DStringAppendElement(dsPtr, "-buffering");
  3348.         }
  3349.         if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
  3350.             Tcl_DStringAppendElement(dsPtr, "line");
  3351.         } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
  3352.             Tcl_DStringAppendElement(dsPtr, "none");
  3353.         } else {
  3354.             Tcl_DStringAppendElement(dsPtr, "full");
  3355.         }
  3356.         if (len > 0) {
  3357.             return TCL_OK;
  3358.         }
  3359.     }
  3360.     if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
  3361.             (strncmp(optionName, "-buffersize", len) == 0))) {
  3362.         if (len == 0) {
  3363.             Tcl_DStringAppendElement(dsPtr, "-buffersize");
  3364.         }
  3365.         sprintf(optionVal, "%d", chanPtr->bufSize);
  3366.         Tcl_DStringAppendElement(dsPtr, optionVal);
  3367.         if (len > 0) {
  3368.             return TCL_OK;
  3369.         }
  3370.     }
  3371.     if ((len == 0) ||
  3372.             ((len > 1) && (optionName[1] == 'e') &&
  3373.                     (strncmp(optionName, "-eofchar", len) == 0))) {
  3374.         if (len == 0) {
  3375.             Tcl_DStringAppendElement(dsPtr, "-eofchar");
  3376.         }
  3377.         if ((chanPtr->flags & (TCL_READABLE|TCL_WRITABLE)) ==
  3378.                 (TCL_READABLE|TCL_WRITABLE)) {
  3379.             Tcl_DStringStartSublist(dsPtr);
  3380.         }
  3381.         if (chanPtr->flags & TCL_READABLE) {
  3382.             if (chanPtr->inEofChar == 0) {
  3383.                 Tcl_DStringAppendElement(dsPtr, "");
  3384.             } else {
  3385.                 char buf[4];
  3386.  
  3387.                 sprintf(buf, "%c", chanPtr->inEofChar);
  3388.                 Tcl_DStringAppendElement(dsPtr, buf);
  3389.             }
  3390.         }
  3391.         if (chanPtr->flags & TCL_WRITABLE) {
  3392.             if (chanPtr->outEofChar == 0) {
  3393.                 Tcl_DStringAppendElement(dsPtr, "");
  3394.             } else {
  3395.                 char buf[4];
  3396.  
  3397.                 sprintf(buf, "%c", chanPtr->outEofChar);
  3398.                 Tcl_DStringAppendElement(dsPtr, buf);
  3399.             }
  3400.         }
  3401.         if ((chanPtr->flags & (TCL_READABLE|TCL_WRITABLE)) ==
  3402.                 (TCL_READABLE|TCL_WRITABLE)) {
  3403.             Tcl_DStringEndSublist(dsPtr);
  3404.         }
  3405.         if (len > 0) {
  3406.             return TCL_OK;
  3407.         }
  3408.     }
  3409.     if ((len == 0) ||
  3410.             ((len > 1) && (optionName[1] == 't') &&
  3411.                     (strncmp(optionName, "-translation", len) == 0))) {
  3412.         if (len == 0) {
  3413.             Tcl_DStringAppendElement(dsPtr, "-translation");
  3414.         }
  3415.         if ((chanPtr->flags & (TCL_READABLE|TCL_WRITABLE)) ==
  3416.                 (TCL_READABLE|TCL_WRITABLE)) {
  3417.             Tcl_DStringStartSublist(dsPtr);
  3418.         }
  3419.         if (chanPtr->flags & TCL_READABLE) {
  3420.             if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
  3421.                 Tcl_DStringAppendElement(dsPtr, "auto");
  3422.             } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
  3423.                 Tcl_DStringAppendElement(dsPtr, "cr");
  3424.             } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
  3425.                 Tcl_DStringAppendElement(dsPtr, "crlf");
  3426.             } else {
  3427.                 Tcl_DStringAppendElement(dsPtr, "lf");
  3428.             }
  3429.         }
  3430.         if (chanPtr->flags & TCL_WRITABLE) {
  3431.             if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
  3432.                 Tcl_DStringAppendElement(dsPtr, "auto");
  3433.             } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
  3434.                 Tcl_DStringAppendElement(dsPtr, "cr");
  3435.             } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
  3436.                 Tcl_DStringAppendElement(dsPtr, "crlf");
  3437.             } else {
  3438.                 Tcl_DStringAppendElement(dsPtr, "lf");
  3439.             }
  3440.         }
  3441.         if ((chanPtr->flags & (TCL_READABLE|TCL_WRITABLE)) ==
  3442.                 (TCL_READABLE|TCL_WRITABLE)) {
  3443.             Tcl_DStringEndSublist(dsPtr);
  3444.         }
  3445.         if (len > 0) {
  3446.             return TCL_OK;
  3447.         }
  3448.     }
  3449.     if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) {
  3450.         return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
  3451.                 optionName, dsPtr);
  3452.     }
  3453.     if (len == 0) {
  3454.         return TCL_OK;
  3455.     }
  3456.     Tcl_SetErrno(EINVAL);
  3457.     return TCL_ERROR;
  3458. }
  3459.  
  3460. /*
  3461.  *----------------------------------------------------------------------
  3462.  *
  3463.  * Tcl_SetChannelOption --
  3464.  *
  3465.  *    Sets an option on a channel.
  3466.  *
  3467.  * Results:
  3468.  *    A standard Tcl result. Also sets interp->result on error if
  3469.  *    interp is not NULL.
  3470.  *
  3471.  * Side effects:
  3472.  *    May modify an option on a device.
  3473.  *
  3474.  *----------------------------------------------------------------------
  3475.  */
  3476.  
  3477. int
  3478. Tcl_SetChannelOption(interp, chan, optionName, newValue)
  3479.     Tcl_Interp *interp;        /* For error reporting - can be NULL. */
  3480.     Tcl_Channel chan;        /* Channel on which to set mode. */
  3481.     char *optionName;        /* Which option to set? */
  3482.     char *newValue;        /* New value for option. */
  3483. {
  3484.     int result;            /* Result of channel type operation. */
  3485.     int newMode;        /* New (numeric) mode to sert. */
  3486.     Channel *chanPtr;    /* The real IO channel. */
  3487.     size_t len;            /* Length of optionName string. */
  3488.     int argc;
  3489.     char **argv;
  3490.  
  3491.     chanPtr = (Channel *) chan;
  3492.     
  3493.     len = strlen(optionName);
  3494.  
  3495.     if ((len > 2) && (optionName[1] == 'b') &&
  3496.             (strncmp(optionName, "-blocking", len) == 0)) {
  3497.         if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
  3498.             return TCL_ERROR;
  3499.         }
  3500.         if (newMode) {
  3501.             newMode = TCL_MODE_BLOCKING;
  3502.         } else {
  3503.             newMode = TCL_MODE_NONBLOCKING;
  3504.         }
  3505.         result = 0;
  3506.         if (chanPtr->typePtr->blockModeProc != NULL) {
  3507.             result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
  3508.                     chanPtr->inFile, chanPtr->outFile, newMode);
  3509.         }
  3510.         if (result != 0) {
  3511.             Tcl_SetErrno(result);
  3512.             if (interp != (Tcl_Interp *) NULL) {
  3513.                 Tcl_AppendResult(interp, "error setting blocking mode: ",
  3514.                         Tcl_PosixError(interp), (char *) NULL);
  3515.             }
  3516.             return TCL_ERROR;
  3517.         }
  3518.         if (newMode == TCL_MODE_BLOCKING) {
  3519.             chanPtr->flags &= (~(CHANNEL_NONBLOCKING));
  3520.             if (chanPtr->outFile != (Tcl_File) NULL) {
  3521.                 Tcl_DeleteFileHandler(chanPtr->outFile);
  3522.                 chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
  3523.             }
  3524.         } else {
  3525.             chanPtr->flags |= CHANNEL_NONBLOCKING;
  3526.         }
  3527.         return TCL_OK;
  3528.     }
  3529.  
  3530.     if ((len > 7) && (optionName[1] == 'b') &&
  3531.             (strncmp(optionName, "-buffering", len) == 0)) {
  3532.         len = strlen(newValue);
  3533.         if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
  3534.             chanPtr->flags &=
  3535.                 (~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));
  3536.         } else if ((newValue[0] == 'l') &&
  3537.                 (strncmp(newValue, "line", len) == 0)) {
  3538.             chanPtr->flags &= (~(CHANNEL_UNBUFFERED));
  3539.             chanPtr->flags |= CHANNEL_LINEBUFFERED;
  3540.         } else if ((newValue[0] == 'n') &&
  3541.                 (strncmp(newValue, "none", len) == 0)) {
  3542.             chanPtr->flags &= (~(CHANNEL_LINEBUFFERED));
  3543.             chanPtr->flags |= CHANNEL_UNBUFFERED;
  3544.         } else {
  3545.             if (interp != (Tcl_Interp *) NULL) {
  3546.                 Tcl_AppendResult(interp, "bad value for -buffering: ",
  3547.                         "must be one of full, line, or none",
  3548.                         (char *) NULL);
  3549.                 return TCL_ERROR;
  3550.             }
  3551.         }
  3552.         return TCL_OK;
  3553.     }
  3554.  
  3555.     if ((len > 7) && (optionName[1] == 'b') &&
  3556.             (strncmp(optionName, "-buffersize", len) == 0)) {
  3557.         chanPtr->bufSize = atoi(newValue);
  3558.         if ((chanPtr->bufSize < 10) || (chanPtr->bufSize > (1024 * 1024))) {
  3559.             chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
  3560.         }
  3561.         return TCL_OK;
  3562.     }
  3563.     
  3564.     if ((len > 1) && (optionName[1] == 'e') &&
  3565.             (strncmp(optionName, "-eofchar", len) == 0)) {
  3566.         if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
  3567.             return TCL_ERROR;
  3568.         }
  3569.         if (argc == 0) {
  3570.             chanPtr->inEofChar = 0;
  3571.             chanPtr->outEofChar = 0;
  3572.         } else if (argc == 1) {
  3573.             if (chanPtr->flags & TCL_WRITABLE) {
  3574.                 chanPtr->outEofChar = (int) argv[0][0];
  3575.             }
  3576.             if (chanPtr->flags & TCL_READABLE) {
  3577.                 chanPtr->inEofChar = (int) argv[0][0];
  3578.             }
  3579.         } else if (argc != 2) {
  3580.             if (interp != (Tcl_Interp *) NULL) {
  3581.                 Tcl_AppendResult(interp,
  3582.                         "bad value for -eofchar: should be a list of one or",
  3583.                         " two elements", (char *) NULL);
  3584.             }
  3585.             ckfree((char *) argv);
  3586.             return TCL_ERROR;
  3587.         } else {
  3588.             if (chanPtr->flags & TCL_READABLE) {
  3589.                 chanPtr->inEofChar = (int) argv[0][0];
  3590.             }
  3591.             if (chanPtr->flags & TCL_WRITABLE) {
  3592.                 chanPtr->outEofChar = (int) argv[1][0];
  3593.             }
  3594.         }
  3595.         if (argv != (char **) NULL) {
  3596.             ckfree((char *) argv);
  3597.         }
  3598.         return TCL_OK;
  3599.     }
  3600.  
  3601.     if ((len > 1) && (optionName[1] == 't') &&
  3602.             (strncmp(optionName, "-translation", len) == 0)) {
  3603.         if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
  3604.             return TCL_ERROR;
  3605.         }
  3606.         if (argc == 1) {
  3607.             if (chanPtr->flags & TCL_READABLE) {
  3608.                 chanPtr->flags &= (~(INPUT_SAW_CR));
  3609.                 if (strcmp(argv[0], "auto") == 0) {
  3610.                     chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
  3611.                 } else if (strcmp(argv[0], "binary") == 0) {
  3612.                     chanPtr->inEofChar = 0;
  3613.                     chanPtr->inputTranslation = TCL_TRANSLATE_LF;
  3614.                 } else if (strcmp(argv[0], "lf") == 0) {
  3615.                     chanPtr->inputTranslation = TCL_TRANSLATE_LF;
  3616.                 } else if (strcmp(argv[0], "cr") == 0) {
  3617.                     chanPtr->inputTranslation = TCL_TRANSLATE_CR;
  3618.                 } else if (strcmp(argv[0], "crlf") == 0) {
  3619.                     chanPtr->inputTranslation = TCL_TRANSLATE_CRLF;
  3620.                 } else if (strcmp(argv[0], "platform") == 0) {
  3621.                     chanPtr->inputTranslation = TCL_PLATFORM_TRANSLATION;
  3622.                 } else {
  3623.                     if (interp != (Tcl_Interp *) NULL) {
  3624.                         Tcl_AppendResult(interp,
  3625.                                 "bad value for -translation: ",
  3626.                                 "must be one of auto, binary, cr, lf, crlf,",
  3627.                                 " or platform", (char *) NULL);
  3628.                     }
  3629.                     ckfree((char *) argv);
  3630.                     return TCL_ERROR;
  3631.                 }
  3632.             }
  3633.             if (chanPtr->flags & TCL_WRITABLE) {
  3634.                 if (strcmp(argv[0], "auto") == 0) {
  3635.                     /*
  3636.                      * This is a hack to get TCP sockets to produce output
  3637.                      * in CRLF mode if they are being set into AUTO mode.
  3638.                      * A better solution for achieving this effect will be
  3639.                      * coded later.
  3640.                      */
  3641.  
  3642.                     if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {
  3643.                         chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
  3644.                     } else {
  3645.                         chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
  3646.                     }
  3647.                 } else if (strcmp(argv[0], "binary") == 0) {
  3648.                     chanPtr->outEofChar = 0;
  3649.                     chanPtr->outputTranslation = TCL_TRANSLATE_LF;
  3650.                 } else if (strcmp(argv[0], "lf") == 0) {
  3651.                     chanPtr->outputTranslation = TCL_TRANSLATE_LF;
  3652.                 } else if (strcmp(argv[0], "cr") == 0) {
  3653.                     chanPtr->outputTranslation = TCL_TRANSLATE_CR;
  3654.                 } else if (strcmp(argv[0], "crlf") == 0) {
  3655.                     chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
  3656.                 } else if (strcmp(argv[0], "platform") == 0) {
  3657.                     chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
  3658.                 } else {
  3659.                     if (interp != (Tcl_Interp *) NULL) {
  3660.                         Tcl_AppendResult(interp,
  3661.                                 "bad value for -translation: ",
  3662.                                 "must be one of auto, binary, cr, lf, crlf,",
  3663.                                 " or platform", (char *) NULL);
  3664.                     }
  3665.                     ckfree((char *) argv);
  3666.                     return TCL_ERROR;
  3667.                 }
  3668.             }
  3669.         } else if (argc != 2) {
  3670.             if (interp != (Tcl_Interp *) NULL) {
  3671.                 Tcl_AppendResult(interp,
  3672.                         "bad value for -translation: must be a one or two",
  3673.                         " element list", (char *) NULL);
  3674.             }
  3675.             ckfree((char *) argv);
  3676.             return TCL_ERROR;
  3677.         } else {
  3678.             if (chanPtr->flags & TCL_READABLE) {
  3679.                 if (argv[0][0] == '\0') {
  3680.                     /* Empty body. */
  3681.                 } else if (strcmp(argv[0], "auto") == 0) {
  3682.                     chanPtr->flags &= (~(INPUT_SAW_CR));
  3683.                     chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
  3684.                 } else if (strcmp(argv[0], "binary") == 0) {
  3685.                     chanPtr->inEofChar = 0;
  3686.                     chanPtr->flags &= (~(INPUT_SAW_CR));
  3687.                     chanPtr->inputTranslation = TCL_TRANSLATE_LF;
  3688.                 } else if (strcmp(argv[0], "lf") == 0) {
  3689.                     chanPtr->flags &= (~(INPUT_SAW_CR));
  3690.                     chanPtr->inputTranslation = TCL_TRANSLATE_LF;
  3691.                 } else if (strcmp(argv[0], "cr") == 0) {
  3692.                     chanPtr->flags &= (~(INPUT_SAW_CR));
  3693.                     chanPtr->inputTranslation = TCL_TRANSLATE_CR;
  3694.                 } else if (strcmp(argv[0], "crlf") == 0) {
  3695.                     chanPtr->flags &= (~(INPUT_SAW_CR));
  3696.                     chanPtr->inputTranslation = TCL_TRANSLATE_CRLF;
  3697.                 } else if (strcmp(argv[0], "platform") == 0) {
  3698.                     chanPtr->flags &= (~(INPUT_SAW_CR));
  3699.                     chanPtr->inputTranslation = TCL_PLATFORM_TRANSLATION;
  3700.                 } else {
  3701.                     if (interp != (Tcl_Interp *) NULL) {
  3702.                         Tcl_AppendResult(interp,
  3703.                                 "bad value for -translation: ",
  3704.                                 "must be one of auto, binary, cr, lf, crlf,",
  3705.                                 " or platform", (char *) NULL);
  3706.                     }
  3707.                     ckfree((char *) argv);
  3708.                     return TCL_ERROR;
  3709.                 }
  3710.             }
  3711.             if (chanPtr->flags & TCL_WRITABLE) {
  3712.                 if (argv[1][0] == '\0') {
  3713.                     /* Empty body. */
  3714.                 } else if (strcmp(argv[1], "auto") == 0) {
  3715.                     /*
  3716.                      * This is a hack to get TCP sockets to produce output
  3717.                      * in CRLF mode if they are being set into AUTO mode.
  3718.                      * A better solution for achieving this effect will be
  3719.                      * coded later.
  3720.                      */
  3721.  
  3722.                     if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {
  3723.                         chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
  3724.                     } else {
  3725.                         chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
  3726.                     }
  3727.                 } else if (strcmp(argv[1], "binary") == 0) {
  3728.                     chanPtr->outEofChar = 0;
  3729.                     chanPtr->outputTranslation = TCL_TRANSLATE_LF;
  3730.                 } else if (strcmp(argv[1], "lf") == 0) {
  3731.                     chanPtr->outputTranslation = TCL_TRANSLATE_LF;
  3732.                 } else if (strcmp(argv[1], "cr") == 0) {
  3733.                     chanPtr->outputTranslation = TCL_TRANSLATE_CR;
  3734.                 } else if (strcmp(argv[1], "crlf") == 0) {
  3735.                     chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
  3736.                 } else if (strcmp(argv[1], "platform") == 0) {
  3737.                     chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
  3738.                 } else {
  3739.                     if (interp != (Tcl_Interp *) NULL) {
  3740.                         Tcl_AppendResult(interp,
  3741.                                 "bad value for -translation: ",
  3742.                                 "must be one of auto, binary, cr, lf, crlf,",
  3743.                                 " or platform", (char *) NULL);
  3744.                     }
  3745.                     ckfree((char *) argv);
  3746.                     return TCL_ERROR;
  3747.                 }
  3748.             }
  3749.         }
  3750.         ckfree((char *) argv);            
  3751.         return TCL_OK;
  3752.     }
  3753.         
  3754.     if (chanPtr->typePtr->setOptionProc != (Tcl_DriverSetOptionProc *) NULL) {
  3755.         return (chanPtr->typePtr->setOptionProc) (chanPtr->instanceData,
  3756.                 interp, optionName, newValue);
  3757.     }
  3758.     
  3759.     if (interp != (Tcl_Interp *) NULL) {
  3760.         Tcl_AppendResult(interp, "bad option \"", optionName,
  3761.                 "\": should be -blocking, -buffering, -buffersize, ",
  3762.                 "-eofchar, -translation, ",
  3763.                 "or channel type specific option",
  3764.                 (char *) NULL);
  3765.     }
  3766.  
  3767.     return TCL_ERROR;
  3768. }
  3769.  
  3770. /*
  3771.  *----------------------------------------------------------------------
  3772.  *
  3773.  * ChannelEventSourceExitProc --
  3774.  *
  3775.  *    This procedure is called during exit cleanup to delete the channel
  3776.  *    event source. It deletes the event source for channels.
  3777.  *
  3778.  * Results:
  3779.  *    None.
  3780.  *
  3781.  * Side effects:
  3782.  *    Destroys the channel event source.
  3783.  *
  3784.  *----------------------------------------------------------------------
  3785.  */
  3786.  
  3787.     /* ARGSUSED */
  3788. static void
  3789. ChannelEventSourceExitProc(clientData)
  3790.     ClientData clientData;        /* Not used. */
  3791. {
  3792.     Tcl_DeleteEventSource(ChannelHandlerSetupProc, ChannelHandlerCheckProc,
  3793.             (ClientData) NULL);
  3794.     channelEventSourceCreated = 0;
  3795. }
  3796.  
  3797. /*
  3798.  *----------------------------------------------------------------------
  3799.  *
  3800.  * ChannelHandlerSetupProc --
  3801.  *
  3802.  *    This procedure is part of the event source for channel handlers.
  3803.  *    It is invoked by Tcl_DoOneEvent before it waits for events. The
  3804.  *    job of this procedure is to provide information to Tcl_DoOneEvent
  3805.  *    on how to wait for events (what files to watch).
  3806.  *
  3807.  * Results:
  3808.  *    None.
  3809.  *
  3810.  * Side effects:
  3811.  *    Tells the notifier what channels to watch.
  3812.  *
  3813.  *----------------------------------------------------------------------
  3814.  */
  3815.  
  3816. static void
  3817. ChannelHandlerSetupProc(clientData, flags)
  3818.     ClientData clientData;        /* Not used. */
  3819.     int flags;                /* Flags passed to Tk_DoOneEvent:
  3820.                      * if it doesn't include
  3821.                      * TCL_FILE_EVENTS then we do
  3822.                      * nothing. */
  3823. {
  3824.     Tcl_Time dontBlock;
  3825.     Channel *chanPtr, *nextChanPtr;
  3826.  
  3827.     if (!(flags & TCL_FILE_EVENTS)) {
  3828.         return;
  3829.     }
  3830.  
  3831.     dontBlock.sec = 0; dontBlock.usec = 0;
  3832.     
  3833.     for (chanPtr = firstChanPtr; chanPtr != (Channel *) NULL;
  3834.              chanPtr = nextChanPtr) {
  3835.         nextChanPtr = chanPtr->nextChanPtr;
  3836.         if (chanPtr->interestMask & TCL_READABLE) {
  3837.             if ((!(chanPtr->flags & CHANNEL_BLOCKED)) &&
  3838.                     (chanPtr->inQueueHead != (ChannelBuffer *) NULL) &&
  3839.                     (chanPtr->inQueueHead->nextRemoved <
  3840.                             chanPtr->inQueueHead->nextAdded)) {
  3841.                 Tcl_SetMaxBlockTime(&dontBlock);
  3842.             } else if (chanPtr->inFile != (Tcl_File) NULL) {
  3843.                 Tcl_WatchFile(chanPtr->inFile, TCL_READABLE);
  3844.             }
  3845.         }
  3846.         if (chanPtr->interestMask & TCL_WRITABLE) {
  3847.             if (chanPtr->outFile != (Tcl_File) NULL) {
  3848.                 Tcl_WatchFile(chanPtr->outFile, TCL_WRITABLE);
  3849.             }
  3850.         }
  3851.         if (chanPtr->interestMask & TCL_EXCEPTION) {
  3852.             if (chanPtr->inFile != (Tcl_File) NULL) {
  3853.                 Tcl_WatchFile(chanPtr->inFile, TCL_EXCEPTION);
  3854.             }
  3855.             if (chanPtr->outFile != (Tcl_File) NULL) {
  3856.                 Tcl_WatchFile(chanPtr->outFile, TCL_EXCEPTION);
  3857.             }
  3858.         }
  3859.     }
  3860. }
  3861.  
  3862. /*
  3863.  *----------------------------------------------------------------------
  3864.  *
  3865.  * ChannelHandlerCheckProc --
  3866.  *
  3867.  *    This procedure is the second part (of three) of the event source
  3868.  *    for channels. It is invoked by Tcl_DoOneEvent after the wait for
  3869.  *    events is over. The job of this procedure is to test each channel
  3870.  *    to see if it is ready now, and if so, to create events and put them
  3871.  *    on the Tcl event queue.
  3872.  *
  3873.  * Results:
  3874.  *    None.
  3875.  *
  3876.  * Side effects:
  3877.  *    Makes entries on the Tcl event queue for each channel that is
  3878.  *    ready now.
  3879.  *
  3880.  *----------------------------------------------------------------------
  3881.  */
  3882.  
  3883. static void
  3884. ChannelHandlerCheckProc(clientData, flags)
  3885.     ClientData clientData;        /* Not used. */
  3886.     int flags;                /* Flags passed to Tk_DoOneEvent:
  3887.                      * if it doesn't include 
  3888.                      * TCL_FILE_EVENTS then we do
  3889.                      * nothing. */
  3890. {
  3891.     Channel *chanPtr, *nextChanPtr;
  3892.     ChannelHandlerEvent *ePtr;
  3893.     int readyMask;
  3894.     
  3895.     if (!(flags & TCL_FILE_EVENTS)) {
  3896.         return;
  3897.     }
  3898.  
  3899.     for (chanPtr = firstChanPtr;
  3900.              chanPtr != (Channel *) NULL;
  3901.              chanPtr = nextChanPtr) {
  3902.         nextChanPtr = chanPtr->nextChanPtr;
  3903.  
  3904.         readyMask = 0;
  3905.  
  3906.         /*
  3907.          * Check for readability.
  3908.          */
  3909.         
  3910.         if (chanPtr->interestMask & TCL_READABLE) {
  3911.  
  3912.             /*
  3913.              * The channel is considered ready for reading if there is input
  3914.              * buffered AND the last attempt to read from the channel did not
  3915.              * return EWOULDBLOCK, OR if the underlying file is ready.
  3916.              *
  3917.              * NOTE that the input queue may contain empty buffers, hence the
  3918.              * special check to see if the first input buffer is empty. The
  3919.              * invariant is that if there is an empty buffer in the queue
  3920.              * there is only one buffer in the queue, hence an empty first
  3921.              * buffer indicates that there is no input queued.
  3922.              */
  3923.             
  3924.             if ((!(chanPtr->flags & CHANNEL_BLOCKED)) &&
  3925.                     ((chanPtr->inQueueHead != (ChannelBuffer *) NULL) &&
  3926.                             (chanPtr->inQueueHead->nextRemoved <
  3927.                                     chanPtr->inQueueHead->nextAdded))) {
  3928.                 readyMask |= TCL_READABLE;
  3929.             } else if (chanPtr->inFile != (Tcl_File) NULL) {
  3930.                 readyMask |=
  3931.                     Tcl_FileReady(chanPtr->inFile, TCL_READABLE);
  3932.             }
  3933.         }
  3934.  
  3935.         /*
  3936.          * Check for writability.
  3937.          */
  3938.  
  3939.         if (chanPtr->interestMask & TCL_WRITABLE) {
  3940.  
  3941.             /*
  3942.              * The channel is considered ready for writing if there is no
  3943.              * output buffered waiting to be written to the device, AND the
  3944.              * underlying file is ready.
  3945.              */
  3946.             
  3947.             if ((chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
  3948.                     (chanPtr->outFile != (Tcl_File) NULL)) {
  3949.                 readyMask |=
  3950.                     Tcl_FileReady(chanPtr->outFile, TCL_WRITABLE);
  3951.             }
  3952.         }
  3953.  
  3954.         /*
  3955.          * Check for exceptions.
  3956.          */
  3957.  
  3958.         if (chanPtr->interestMask & TCL_EXCEPTION) {
  3959.             if (chanPtr->inFile != (Tcl_File) NULL) {
  3960.                 readyMask |=
  3961.                     Tcl_FileReady(chanPtr->inFile, TCL_EXCEPTION);
  3962.             }
  3963.             if (chanPtr->outFile != (Tcl_File) NULL) {
  3964.                 readyMask |=
  3965.                     Tcl_FileReady(chanPtr->outFile, TCL_EXCEPTION);
  3966.             }
  3967.         }
  3968.         
  3969.         /*
  3970.          * If there are any events for this channel, put a notice into the
  3971.          * Tcl event queue.
  3972.          */
  3973.         
  3974.         if (readyMask != 0) {
  3975.             ePtr = (ChannelHandlerEvent *) ckalloc((unsigned)
  3976.                     sizeof(ChannelHandlerEvent));
  3977.             ePtr->header.proc = ChannelHandlerEventProc;
  3978.             ePtr->chanPtr = chanPtr;
  3979.             ePtr->readyMask = readyMask;
  3980.             Tcl_QueueEvent((Tcl_Event *) ePtr, TCL_QUEUE_TAIL);
  3981.         }
  3982.     }
  3983. }
  3984.  
  3985. /*
  3986.  *----------------------------------------------------------------------
  3987.  *
  3988.  * FlushEventProc --
  3989.  *
  3990.  *    This routine dispatches a background flush event.
  3991.  *
  3992.  *    Errors that occur during the write operation are stored
  3993.  *    inside the channel structure for future reporting by the next
  3994.  *    operation that uses this channel.
  3995.  *
  3996.  * Results:
  3997.  *    None.
  3998.  *
  3999.  * Side effects:
  4000.  *    Causes production of output on a channel.
  4001.  *
  4002.  *----------------------------------------------------------------------
  4003.  */
  4004.  
  4005. static void
  4006. FlushEventProc(clientData, mask)
  4007.     ClientData clientData;        /* Channel to produce output on. */
  4008.     int mask;                /* Not used. */
  4009. {
  4010.     (void) FlushChannel(NULL, (Channel *) clientData, 1);
  4011. }
  4012.  
  4013. /*
  4014.  *----------------------------------------------------------------------
  4015.  *
  4016.  * ChannelHandlerEventProc --
  4017.  *
  4018.  *    This procedure is called by Tcl_DoOneEvent when a channel event
  4019.  *    reaches the front of the event queue. This procedure is responsible
  4020.  *    for actually handling the event by invoking the callback for the
  4021.  *    channel handler.
  4022.  *
  4023.  * Results:
  4024.  *    Returns 1 if the event was handled, meaning that it should be
  4025.  *    removed from the queue. Returns 0 if the event was not handled
  4026.  *    meaning that it should stay in the queue. The only time the event
  4027.  *    will not be handled is if the TCL_FILE_EVENTS flag bit is not
  4028.  *    set in the flags passed.
  4029.  *
  4030.  *    NOTE: If the handler is deleted between the time the event is added
  4031.  *    to the queue and the time it reaches the head of the queue, the
  4032.  *    event is silently discarded (i.e. we return 1).
  4033.  *
  4034.  * Side effects:
  4035.  *    Whatever the channel handler callback procedure does.
  4036.  *
  4037.  *----------------------------------------------------------------------
  4038.  */
  4039.  
  4040. static int
  4041. ChannelHandlerEventProc(evPtr, flags)
  4042.     Tcl_Event *evPtr;        /* Event to service. */
  4043.     int flags;            /* Flags that indicate what events to
  4044.                                  * handle, such as TCL_FILE_EVENTS. */
  4045. {
  4046.     Channel *chanPtr;
  4047.     ChannelHandler *chPtr;
  4048.     ChannelHandlerEvent *ePtr;
  4049.     NextChannelHandler nh;
  4050.  
  4051.     if (!(flags & TCL_FILE_EVENTS)) {
  4052.         return 0;
  4053.     }
  4054.  
  4055.     ePtr = (ChannelHandlerEvent *) evPtr;
  4056.     chanPtr = ePtr->chanPtr;
  4057.  
  4058.     /*
  4059.      * Add this invocation to the list of recursive invocations of
  4060.      * ChannelHandlerEventProc.
  4061.      */
  4062.     
  4063.     nh.nextHandlerPtr = (ChannelHandler *) NULL;
  4064.     nh.nestedHandlerPtr = nestedHandlerPtr;
  4065.     nestedHandlerPtr = &nh;
  4066.     
  4067.     for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
  4068.  
  4069.         /*
  4070.          * If this channel handler is interested in any of the events that
  4071.          * have occurred on the channel, invoke its procedure.
  4072.          */
  4073.         
  4074.         if ((chPtr->mask & ePtr->readyMask) != 0) {
  4075.             nh.nextHandlerPtr = chPtr->nextPtr;
  4076.         (*(chPtr->proc))(chPtr->clientData, ePtr->readyMask);
  4077.             chPtr = nh.nextHandlerPtr;
  4078.         } else {
  4079.             chPtr = chPtr->nextPtr;
  4080.     }
  4081.     }
  4082.  
  4083.     nestedHandlerPtr = nh.nestedHandlerPtr;
  4084.     
  4085.     return 1;
  4086. }
  4087.  
  4088. /*
  4089.  *----------------------------------------------------------------------
  4090.  *
  4091.  * Tcl_CreateChannelHandler --
  4092.  *
  4093.  *    Arrange for a given procedure to be invoked whenever the
  4094.  *    channel indicated by the chanPtr arg becomes readable or
  4095.  *    writable.
  4096.  *
  4097.  * Results:
  4098.  *    None.
  4099.  *
  4100.  * Side effects:
  4101.  *    From now on, whenever the I/O channel given by chanPtr becomes
  4102.  *    ready in the way indicated by mask, proc will be invoked.
  4103.  *    See the manual entry for details on the calling sequence
  4104.  *    to proc.  If there is already an event handler for chan, proc
  4105.  *    and clientData, then the mask will be updated.
  4106.  *
  4107.  *----------------------------------------------------------------------
  4108.  */
  4109.  
  4110. void
  4111. Tcl_CreateChannelHandler(chan, mask, proc, clientData)
  4112.     Tcl_Channel chan;        /* The channel to create the handler for. */
  4113.     int mask;            /* OR'ed combination of TCL_READABLE,
  4114.                  * TCL_WRITABLE, and TCL_EXCEPTION:
  4115.                  * indicates conditions under which
  4116.                  * proc should be called. Use 0 to
  4117.                                  * disable a registered handler. */
  4118.     Tcl_ChannelProc *proc;    /* Procedure to call for each
  4119.                  * selected event. */
  4120.     ClientData clientData;    /* Arbitrary data to pass to proc. */
  4121. {
  4122.     ChannelHandler *chPtr;
  4123.     Channel *chanPtr;
  4124.  
  4125.     chanPtr = (Channel *) chan;
  4126.     
  4127.     /*
  4128.      * Ensure that the channel event source is registered with the Tcl
  4129.      * notification mechanism.
  4130.      */
  4131.     
  4132.     if (!channelEventSourceCreated) {
  4133.         channelEventSourceCreated = 1;
  4134.         Tcl_CreateEventSource(ChannelHandlerSetupProc, ChannelHandlerCheckProc,
  4135.                 (ClientData) NULL);
  4136.         Tcl_CreateExitHandler(ChannelEventSourceExitProc, (ClientData) NULL);
  4137.     }
  4138.  
  4139.     /*
  4140.      * Check whether this channel handler is not already registered. If
  4141.      * it is not, create a new record, else reuse existing record (smash
  4142.      * current values).
  4143.      */
  4144.  
  4145.     for (chPtr = chanPtr->chPtr;
  4146.              chPtr != (ChannelHandler *) NULL;
  4147.              chPtr = chPtr->nextPtr) {
  4148.         if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
  4149.                 (chPtr->clientData == clientData)) {
  4150.             break;
  4151.         }
  4152.     }
  4153.     if (chPtr == (ChannelHandler *) NULL) {
  4154.         chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler));
  4155.         chPtr->mask = 0;
  4156.         chPtr->proc = proc;
  4157.         chPtr->clientData = clientData;
  4158.         chPtr->chanPtr = chanPtr;
  4159.         chPtr->nextPtr = chanPtr->chPtr;
  4160.         chanPtr->chPtr = chPtr;
  4161.     }
  4162.  
  4163.     /*
  4164.      * The remainder of the initialization below is done regardless of
  4165.      * whether or not this is a new record or a modification of an old
  4166.      * one.
  4167.      */
  4168.  
  4169.     chPtr->mask = mask;
  4170.  
  4171.     /*
  4172.      * Recompute the interest mask for the channel - this call may actually
  4173.      * be disabling an existing handler..
  4174.      */
  4175.     
  4176.     chanPtr->interestMask = 0;
  4177.     for (chPtr = chanPtr->chPtr;
  4178.          chPtr != (ChannelHandler *) NULL;
  4179.          chPtr = chPtr->nextPtr) {
  4180.     chanPtr->interestMask |= chPtr->mask;
  4181.     }                                       
  4182. }
  4183.  
  4184. /*
  4185.  *----------------------------------------------------------------------
  4186.  *
  4187.  * Tcl_DeleteChannelHandler --
  4188.  *
  4189.  *    Cancel a previously arranged callback arrangement for an IO
  4190.  *    channel.
  4191.  *
  4192.  * Results:
  4193.  *    None.
  4194.  *
  4195.  * Side effects:
  4196.  *    If a callback was previously registered for this chan, proc and
  4197.  *     clientData , it is removed and the callback will no longer be called
  4198.  *    when the channel becomes ready for IO.
  4199.  *
  4200.  *----------------------------------------------------------------------
  4201.  */
  4202.  
  4203. void
  4204. Tcl_DeleteChannelHandler(chan, proc, clientData)
  4205.     Tcl_Channel chan;        /* The channel for which to remove the
  4206.                                  * callback. */
  4207.     Tcl_ChannelProc *proc;    /* The procedure in the callback to delete. */
  4208.     ClientData clientData;    /* The client data in the callback
  4209.                                  * to delete. */
  4210.     
  4211. {
  4212.     ChannelHandler *chPtr, *prevChPtr;
  4213.     Channel *chanPtr;
  4214.     NextChannelHandler *nhPtr;
  4215.  
  4216.     chanPtr = (Channel *) chan;
  4217.  
  4218.     /*
  4219.      * Find the entry and the previous one in the list.
  4220.      */
  4221.  
  4222.     for (prevChPtr = (ChannelHandler *) NULL, chPtr = chanPtr->chPtr;
  4223.              chPtr != (ChannelHandler *) NULL;
  4224.              chPtr = chPtr->nextPtr) {
  4225.         if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
  4226.                 && (chPtr->proc == proc)) {
  4227.             break;
  4228.         }
  4229.         prevChPtr = chPtr;
  4230.     }
  4231.  
  4232.     /*
  4233.      * If ChannelHandlerEventProc is about to process this handler, tell it to
  4234.      * process the next one instead - we are going to delete *this* one.
  4235.      */
  4236.  
  4237.     for (nhPtr = nestedHandlerPtr;
  4238.              nhPtr != (NextChannelHandler *) NULL;
  4239.              nhPtr = nhPtr->nestedHandlerPtr) {
  4240.         if (nhPtr->nextHandlerPtr == chPtr) {
  4241.             nhPtr->nextHandlerPtr = chPtr->nextPtr;
  4242.         }
  4243.     }
  4244.     
  4245.     /*
  4246.      * If found, splice the entry out of the list.
  4247.      */
  4248.  
  4249.     if (chPtr == (ChannelHandler *) NULL) {
  4250.         return;
  4251.     }
  4252.  
  4253.     if (prevChPtr == (ChannelHandler *) NULL) {
  4254.         chanPtr->chPtr = chPtr->nextPtr;
  4255.     } else {
  4256.         prevChPtr->nextPtr = chPtr->nextPtr;
  4257.     }
  4258.     ckfree((char *) chPtr);
  4259.  
  4260.     /*
  4261.      * Recompute the interest list for the channel, so that infinite loops
  4262.      * will not result if Tcl_DeleteChanelHandler is called inside an event.
  4263.      */
  4264.  
  4265.     chanPtr->interestMask = 0;
  4266.     for (chPtr = chanPtr->chPtr;
  4267.              chPtr != (ChannelHandler *) NULL;
  4268.              chPtr = chPtr->nextPtr) {
  4269.         chanPtr->interestMask |= chPtr->mask;
  4270.     }
  4271. }
  4272.  
  4273. /*
  4274.  *----------------------------------------------------------------------
  4275.  *
  4276.  * ReturnScriptRecord --
  4277.  *
  4278.  *    Get a script stored for this channel with this interpreter.
  4279.  *
  4280.  * Results:
  4281.  *    A standard Tcl result.
  4282.  *
  4283.  * Side effects:
  4284.  *    Sets interp->result to the script.
  4285.  *
  4286.  *----------------------------------------------------------------------
  4287.  */
  4288.  
  4289. static void
  4290. ReturnScriptRecord(interp, chanPtr, mask)
  4291.     Tcl_Interp *interp;        /* The interpreter in which the script
  4292.                                  * is to be executed. */
  4293.     Channel *chanPtr;        /* The channel for which the script is
  4294.                                  * stored. */
  4295.     int mask;            /* Events in mask must overlap with events
  4296.                                  * for which this script is stored. */
  4297. {
  4298.     EventScriptRecord *esPtr;
  4299.     
  4300.     for (esPtr = chanPtr->scriptRecordPtr;
  4301.              esPtr != (EventScriptRecord *) NULL;
  4302.              esPtr = esPtr->nextPtr) {
  4303.         if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
  4304.             interp->result = esPtr->script;
  4305.             return;
  4306.         }
  4307.     }
  4308. }
  4309.  
  4310. /*
  4311.  *----------------------------------------------------------------------
  4312.  *
  4313.  * DeleteScriptRecord --
  4314.  *
  4315.  *    Delete a script record for this combination of channel, interp
  4316.  *    and mask.
  4317.  *
  4318.  * Results:
  4319.  *    None.
  4320.  *
  4321.  * Side effects:
  4322.  *    Deletes a script record and cancels a channel event handler.
  4323.  *
  4324.  *----------------------------------------------------------------------
  4325.  */
  4326.  
  4327. static void
  4328. DeleteScriptRecord(interp, chanPtr, mask)
  4329.     Tcl_Interp *interp;        /* Interpreter in which script was to be
  4330.                                  * executed. */
  4331.     Channel *chanPtr;        /* The channel for which to delete the
  4332.                                  * script record (if any). */
  4333.     int mask;            /* Events in mask must exactly match mask
  4334.                                  * of script to delete. */
  4335. {
  4336.     EventScriptRecord *esPtr, *prevEsPtr;
  4337.  
  4338.     for (esPtr = chanPtr->scriptRecordPtr,
  4339.              prevEsPtr = (EventScriptRecord *) NULL;
  4340.              esPtr != (EventScriptRecord *) NULL;
  4341.              prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
  4342.         if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
  4343.             if (esPtr == chanPtr->scriptRecordPtr) {
  4344.                 chanPtr->scriptRecordPtr = esPtr->nextPtr;
  4345.             } else {
  4346.                 prevEsPtr->nextPtr = esPtr->nextPtr;
  4347.             }
  4348.  
  4349.             Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
  4350.                     ChannelEventScriptInvoker, (ClientData) esPtr);
  4351.             
  4352.             Tcl_EventuallyFree((ClientData)esPtr->script, TCL_DYNAMIC);
  4353.             ckfree((char *) esPtr);
  4354.  
  4355.             break;
  4356.         }
  4357.     }
  4358. }
  4359.  
  4360. /*
  4361.  *----------------------------------------------------------------------
  4362.  *
  4363.  * CreateScriptRecord --
  4364.  *
  4365.  *    Creates a record to store a script to be executed when a specific
  4366.  *    event fires on a specific channel.
  4367.  *
  4368.  * Results:
  4369.  *    None.
  4370.  *
  4371.  * Side effects:
  4372.  *    Causes the script to be stored for later execution.
  4373.  *
  4374.  *----------------------------------------------------------------------
  4375.  */
  4376.  
  4377. static void
  4378. CreateScriptRecord(interp, chanPtr, mask, script)
  4379.     Tcl_Interp *interp;            /* Interpreter in which to execute
  4380.                                          * the stored script. */
  4381.     Channel *chanPtr;            /* Channel for which script is to
  4382.                                          * be stored. */
  4383.     int mask;                /* Set of events for which script
  4384.                                          * will be invoked. */
  4385.     char *script;            /* A copy of this script is stored
  4386.                                          * in the newly created record. */
  4387. {
  4388.     EventScriptRecord *esPtr;
  4389.  
  4390.     for (esPtr = chanPtr->scriptRecordPtr;
  4391.              esPtr != (EventScriptRecord *) NULL;
  4392.              esPtr = esPtr->nextPtr) {
  4393.         if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
  4394.             Tcl_EventuallyFree((ClientData)esPtr->script, TCL_DYNAMIC);
  4395.             esPtr->script = (char *) NULL;
  4396.             break;
  4397.         }
  4398.     }
  4399.     if (esPtr == (EventScriptRecord *) NULL) {
  4400.         esPtr = (EventScriptRecord *) ckalloc((unsigned)
  4401.                 sizeof(EventScriptRecord));
  4402.         Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
  4403.                 ChannelEventScriptInvoker, (ClientData) esPtr);
  4404.         esPtr->nextPtr = chanPtr->scriptRecordPtr;
  4405.         chanPtr->scriptRecordPtr = esPtr;
  4406.     }
  4407.     esPtr->chanPtr = chanPtr;
  4408.     esPtr->interp = interp;
  4409.     esPtr->mask = mask;
  4410.     esPtr->script = ckalloc((unsigned) (strlen(script) + 1));
  4411.     strcpy(esPtr->script, script);
  4412. }
  4413.  
  4414. /*
  4415.  *----------------------------------------------------------------------
  4416.  *
  4417.  * ChannelEventScriptInvoker --
  4418.  *
  4419.  *    Invokes a script scheduled by "fileevent" for when the channel
  4420.  *    becomes ready for IO. This function is invoked by the channel
  4421.  *    handler which was created by the Tcl "fileevent" command.
  4422.  *
  4423.  * Results:
  4424.  *    None.
  4425.  *
  4426.  * Side effects:
  4427.  *    Whatever the script does.
  4428.  *
  4429.  *----------------------------------------------------------------------
  4430.  */
  4431.  
  4432. static void
  4433. ChannelEventScriptInvoker(clientData, mask)
  4434.     ClientData clientData;    /* The script+interp record. */
  4435.     int mask;            /* Not used. */
  4436. {
  4437.     Tcl_Interp *interp;        /* Interpreter in which to eval the script. */
  4438.     Channel *chanPtr;        /* The channel for which this handler is
  4439.                                  * registered. */
  4440.     char *script;        /* Script to eval. */
  4441.     EventScriptRecord *esPtr;    /* The event script + interpreter to eval it
  4442.                                  * in. */
  4443.     int result;            /* Result of call to eval script. */
  4444.  
  4445.     esPtr = (EventScriptRecord *) clientData;
  4446.  
  4447.     chanPtr = esPtr->chanPtr;
  4448.     mask = esPtr->mask;
  4449.     interp = esPtr->interp;
  4450.     script = esPtr->script;
  4451.  
  4452.     /*
  4453.      * We must preserve the channel, script and interpreter because each of
  4454.      * these may be deleted in the evaluation. If an error later occurs, we
  4455.      * want to have the relevant data around for error reporting and so we
  4456.      * can safely delete it.
  4457.      */
  4458.     
  4459.     Tcl_Preserve((ClientData) chanPtr);
  4460.     Tcl_Preserve((ClientData) script);
  4461.     Tcl_Preserve((ClientData) interp);
  4462.     result = Tcl_GlobalEval(esPtr->interp, script);
  4463.  
  4464.     /*
  4465.      * On error, cause a background error and remove the channel handler
  4466.      * and the script record.
  4467.      */
  4468.     
  4469.     if (result != TCL_OK) {
  4470.         Tcl_BackgroundError(interp);
  4471.         DeleteScriptRecord(interp, chanPtr, mask);
  4472.     }
  4473.     Tcl_Release((ClientData) chanPtr);
  4474.     Tcl_Release((ClientData) script);
  4475.     Tcl_Release((ClientData) interp);
  4476. }
  4477.  
  4478. /*
  4479.  *----------------------------------------------------------------------
  4480.  *
  4481.  * Tcl_FileEventCmd --
  4482.  *
  4483.  *    This procedure implements the "fileevent" Tcl command. See the
  4484.  *    user documentation for details on what it does. This command is
  4485.  *    based on the Tk command "fileevent" which in turn is based on work
  4486.  *    contributed by Mark Diekhans.
  4487.  *
  4488.  * Results:
  4489.  *    A standard Tcl result.
  4490.  *
  4491.  * Side effects:
  4492.  *    May create a channel handler for the specified channel.
  4493.  *
  4494.  *----------------------------------------------------------------------
  4495.  */
  4496.  
  4497.     /* ARGSUSED */
  4498. int
  4499. Tcl_FileEventCmd(clientData, interp, argc, argv)
  4500.     ClientData clientData;        /* Not used. */
  4501.     Tcl_Interp *interp;            /* Interpreter in which the channel
  4502.                                          * for which to create the handler
  4503.                                          * is found. */
  4504.     int argc;                /* Number of arguments. */
  4505.     char **argv;            /* Argument strings. */
  4506. {
  4507.     Channel *chanPtr;            /* The channel to create
  4508.                                          * the handler for. */
  4509.     Tcl_Channel chan;            /* The opaque type for the channel. */
  4510.     int c;                /* First char of mode argument. */
  4511.     int mask;                /* Mask for events of interest. */
  4512.     size_t length;            /* Length of mode argument. */
  4513.  
  4514.     /*
  4515.      * Parse arguments.
  4516.      */
  4517.  
  4518.     if ((argc != 3) && (argc != 4)) {
  4519.     Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0],
  4520.         " channelId event ?script?", (char *) NULL);
  4521.     return TCL_ERROR;
  4522.     }
  4523.     c = argv[2][0];
  4524.     length = strlen(argv[2]);
  4525.     if ((c == 'r') && (strncmp(argv[2], "readable", length) == 0)) {
  4526.         mask = TCL_READABLE;
  4527.     } else if ((c == 'w') && (strncmp(argv[2], "writable", length) == 0)) {
  4528.         mask = TCL_WRITABLE;
  4529.     } else {
  4530.     Tcl_AppendResult(interp, "bad event name \"", argv[2],
  4531.         "\": must be readable or writable", (char *) NULL);
  4532.     return TCL_ERROR;
  4533.     }
  4534.     chan = Tcl_GetChannel(interp, argv[1], NULL);
  4535.     if (chan == (Tcl_Channel) NULL) {
  4536.         return TCL_ERROR;
  4537.     }
  4538.     
  4539.     chanPtr = (Channel *) chan;
  4540.     if ((chanPtr->flags & mask) == 0) {
  4541.         Tcl_AppendResult(interp, "channel is not ",
  4542.                 (mask == TCL_READABLE) ? "readable" : "writable",
  4543.                 (char *) NULL);
  4544.         return TCL_ERROR;
  4545.     }
  4546.     
  4547.     /*
  4548.      * If we are supposed to return the script, do so.
  4549.      */
  4550.  
  4551.     if (argc == 3) {
  4552.         ReturnScriptRecord(interp, chanPtr, mask);
  4553.         return TCL_OK;
  4554.     }
  4555.  
  4556.     /*
  4557.      * If we are supposed to delete a stored script, do so.
  4558.      */
  4559.  
  4560.     if (argv[3][0] == 0) {
  4561.         DeleteScriptRecord(interp, chanPtr, mask);
  4562.         return TCL_OK;
  4563.     }
  4564.  
  4565.     /*
  4566.      * Make the script record that will link between the event and the
  4567.      * script to invoke. This also creates a channel event handler which
  4568.      * will evaluate the script in the supplied interpreter.
  4569.      */
  4570.  
  4571.     CreateScriptRecord(interp, chanPtr, mask, argv[3]);
  4572.     
  4573.     return TCL_OK;
  4574. }
  4575.  
  4576. /*
  4577.  *----------------------------------------------------------------------
  4578.  *
  4579.  * TclTestChannelCmd --
  4580.  *
  4581.  *    Implements the Tcl "testchannel" debugging command and its
  4582.  *    subcommands. This is part of the testing environment but must be
  4583.  *    in this file instead of tclTest.c because it needs access to the
  4584.  *    fields of struct Channel.
  4585.  *
  4586.  * Results:
  4587.  *    A standard Tcl result.
  4588.  *
  4589.  * Side effects:
  4590.  *    None.
  4591.  *
  4592.  *----------------------------------------------------------------------
  4593.  */
  4594.  
  4595.     /* ARGSUSED */
  4596. int
  4597. TclTestChannelCmd(clientData, interp, argc, argv)
  4598.     ClientData clientData;    /* Not used. */
  4599.     Tcl_Interp *interp;        /* Interpreter for result. */
  4600.     int argc;            /* Count of additional args. */
  4601.     char **argv;        /* Additional arg strings. */
  4602. {
  4603.     char *cmdName;        /* Sub command. */
  4604.     Tcl_HashTable *hTblPtr;    /* Hash table of channels. */
  4605.     Tcl_HashSearch hSearch;    /* Search variable. */
  4606.     Tcl_HashEntry *hPtr;    /* Search variable. */
  4607.     Channel *chanPtr;        /* The actual channel. */
  4608.     Tcl_Channel chan;        /* The opaque type. */
  4609.     size_t len;            /* Length of subcommand string. */
  4610.     int IOQueued;        /* How much IO is queued inside channel? */
  4611.     ChannelBuffer *bufPtr;    /* For iterating over queued IO. */
  4612.     char buf[128];        /* For sprintf. */
  4613.     
  4614.     if (argc < 2) {
  4615.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  4616.                 " subcommand ?additional args..?\"", (char *) NULL);
  4617.         return TCL_ERROR;
  4618.     }
  4619.     cmdName = argv[1];
  4620.     len = strlen(cmdName);
  4621.  
  4622.     chanPtr = (Channel *) NULL;
  4623.     if (argc > 2) {
  4624.         chan = Tcl_GetChannel(interp, argv[2], NULL);
  4625.         if (chan == (Tcl_Channel) NULL) {
  4626.             return TCL_ERROR;
  4627.         }
  4628.         chanPtr = (Channel *) chan;
  4629.     }
  4630.     
  4631.     if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
  4632.         if (argc != 3) {
  4633.             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  4634.                     " info channelName\"", (char *) NULL);
  4635.             return TCL_ERROR;
  4636.         }
  4637.         Tcl_AppendElement(interp, argv[2]);
  4638.         Tcl_AppendElement(interp, chanPtr->typePtr->typeName);
  4639.         if (chanPtr->flags & TCL_READABLE) {
  4640.             Tcl_AppendElement(interp, "read");
  4641.         } else {
  4642.             Tcl_AppendElement(interp, "");
  4643.         }
  4644.         if (chanPtr->flags & TCL_WRITABLE) {
  4645.             Tcl_AppendElement(interp, "write");
  4646.         } else {
  4647.             Tcl_AppendElement(interp, "");
  4648.         }
  4649.         if (chanPtr->flags & CHANNEL_NONBLOCKING) {
  4650.             Tcl_AppendElement(interp, "nonblocking");
  4651.         } else {
  4652.             Tcl_AppendElement(interp, "blocking");
  4653.         }
  4654.         if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
  4655.             Tcl_AppendElement(interp, "line");
  4656.         } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
  4657.             Tcl_AppendElement(interp, "none");
  4658.         } else {
  4659.             Tcl_AppendElement(interp, "full");
  4660.         }
  4661.         if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
  4662.             Tcl_AppendElement(interp, "async_flush");
  4663.         } else {
  4664.             Tcl_AppendElement(interp, "");
  4665.         }
  4666.         if (chanPtr->flags & CHANNEL_EOF) {
  4667.             Tcl_AppendElement(interp, "eof");
  4668.         } else {
  4669.             Tcl_AppendElement(interp, "");
  4670.         }
  4671.         if (chanPtr->flags & CHANNEL_BLOCKED) {
  4672.             Tcl_AppendElement(interp, "blocked");
  4673.         } else {
  4674.             Tcl_AppendElement(interp, "unblocked");
  4675.         }
  4676.         if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
  4677.             Tcl_AppendElement(interp, "auto");
  4678.             if (chanPtr->flags & INPUT_SAW_CR) {
  4679.                 Tcl_AppendElement(interp, "saw_cr");
  4680.             } else {
  4681.                 Tcl_AppendElement(interp, "");
  4682.             }
  4683.         } else if (chanPtr->inputTranslation == TCL_TRANSLATE_LF) {
  4684.             Tcl_AppendElement(interp, "lf");
  4685.             Tcl_AppendElement(interp, "");
  4686.         } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
  4687.             Tcl_AppendElement(interp, "cr");
  4688.             Tcl_AppendElement(interp, "");
  4689.         } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
  4690.             Tcl_AppendElement(interp, "crlf");
  4691.             if (chanPtr->flags & INPUT_SAW_CR) {
  4692.                 Tcl_AppendElement(interp, "queued_cr");
  4693.             } else {
  4694.                 Tcl_AppendElement(interp, "");
  4695.             }
  4696.         }
  4697.         if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
  4698.             Tcl_AppendElement(interp, "auto");
  4699.         } else if (chanPtr->outputTranslation == TCL_TRANSLATE_LF) {
  4700.             Tcl_AppendElement(interp, "lf");
  4701.         } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
  4702.             Tcl_AppendElement(interp, "cr");
  4703.         } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
  4704.             Tcl_AppendElement(interp, "crlf");
  4705.         }
  4706.         for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
  4707.                  bufPtr != (ChannelBuffer *) NULL;
  4708.                  bufPtr = bufPtr->nextPtr) {
  4709.             IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
  4710.         }
  4711.         sprintf(buf, "%d", IOQueued);
  4712.         Tcl_AppendElement(interp, buf);
  4713.         
  4714.         IOQueued = 0;
  4715.         if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
  4716.             IOQueued = chanPtr->curOutPtr->nextAdded -
  4717.                 chanPtr->curOutPtr->nextRemoved;
  4718.         }
  4719.         for (bufPtr = chanPtr->outQueueHead;
  4720.                  bufPtr != (ChannelBuffer *) NULL;
  4721.                  bufPtr = bufPtr->nextPtr) {
  4722.             IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
  4723.         }
  4724.         sprintf(buf, "%d", IOQueued);
  4725.         Tcl_AppendElement(interp, buf);
  4726.         
  4727.         sprintf(buf, "%d", Tcl_Tell((Tcl_Channel) chanPtr));
  4728.         Tcl_AppendElement(interp, buf);
  4729.  
  4730.         sprintf(buf, "%d", chanPtr->refCount);
  4731.         Tcl_AppendElement(interp, buf);
  4732.  
  4733.         return TCL_OK;
  4734.     }
  4735.  
  4736.     if ((cmdName[0] == 'i') &&
  4737.             (strncmp(cmdName, "inputbuffered", len) == 0)) {
  4738.         if (argc != 3) {
  4739.             Tcl_AppendResult(interp, "channel name required",
  4740.                     (char *) NULL);
  4741.             return TCL_ERROR;
  4742.         }
  4743.         
  4744.         for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
  4745.                  bufPtr != (ChannelBuffer *) NULL;
  4746.                  bufPtr = bufPtr->nextPtr) {
  4747.             IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
  4748.         }
  4749.         sprintf(buf, "%d", IOQueued);
  4750.         Tcl_AppendResult(interp, buf, (char *) NULL);
  4751.         return TCL_OK;
  4752.     }
  4753.         
  4754.     if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
  4755.         if (argc != 3) {
  4756.             Tcl_AppendResult(interp, "channel name required",
  4757.                     (char *) NULL);
  4758.             return TCL_ERROR;
  4759.         }
  4760.         
  4761.         if (chanPtr->flags & TCL_READABLE) {
  4762.             Tcl_AppendElement(interp, "read");
  4763.         } else {
  4764.             Tcl_AppendElement(interp, "");
  4765.         }
  4766.         if (chanPtr->flags & TCL_WRITABLE) {
  4767.             Tcl_AppendElement(interp, "write");
  4768.         } else {
  4769.             Tcl_AppendElement(interp, "");
  4770.         }
  4771.         return TCL_OK;
  4772.     }
  4773.     
  4774.     if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
  4775.         if (argc != 3) {
  4776.             Tcl_AppendResult(interp, "channel name required",
  4777.                     (char *) NULL);
  4778.             return TCL_ERROR;
  4779.         }
  4780.         Tcl_AppendResult(interp, chanPtr->channelName, (char *) NULL);
  4781.         return TCL_OK;
  4782.     }
  4783.     
  4784.     if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
  4785.         hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
  4786.         if (hTblPtr == (Tcl_HashTable *) NULL) {
  4787.             return TCL_OK;
  4788.         }
  4789.         for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
  4790.                  hPtr != (Tcl_HashEntry *) NULL;
  4791.                  hPtr = Tcl_NextHashEntry(&hSearch)) {
  4792.             Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
  4793.         }
  4794.         return TCL_OK;
  4795.     }
  4796.  
  4797.     if ((cmdName[0] == 'o') &&
  4798.             (strncmp(cmdName, "outputbuffered", len) == 0)) {
  4799.         if (argc != 3) {
  4800.             Tcl_AppendResult(interp, "channel name required",
  4801.                     (char *) NULL);
  4802.             return TCL_ERROR;
  4803.         }
  4804.         
  4805.         IOQueued = 0;
  4806.         if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
  4807.             IOQueued = chanPtr->curOutPtr->nextAdded -
  4808.                 chanPtr->curOutPtr->nextRemoved;
  4809.         }
  4810.         for (bufPtr = chanPtr->outQueueHead;
  4811.                  bufPtr != (ChannelBuffer *) NULL;
  4812.                  bufPtr = bufPtr->nextPtr) {
  4813.             IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
  4814.         }
  4815.         sprintf(buf, "%d", IOQueued);
  4816.         Tcl_AppendResult(interp, buf, (char *) NULL);
  4817.         return TCL_OK;
  4818.     }
  4819.         
  4820.     if ((cmdName[0] == 'q') &&
  4821.             (strncmp(cmdName, "queuedcr", len) == 0)) {
  4822.         if (argc != 3) {
  4823.             Tcl_AppendResult(interp, "channel name required",
  4824.                     (char *) NULL);
  4825.             return TCL_ERROR;
  4826.         }
  4827.         
  4828.         Tcl_AppendResult(interp,
  4829.                 (chanPtr->flags & INPUT_SAW_CR) ? "1" : "0",
  4830.                 (char *) NULL);
  4831.         return TCL_OK;
  4832.     }
  4833.     
  4834.     if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
  4835.         hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
  4836.         if (hTblPtr == (Tcl_HashTable *) NULL) {
  4837.             return TCL_OK;
  4838.         }
  4839.         for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
  4840.                  hPtr != (Tcl_HashEntry *) NULL;
  4841.                  hPtr = Tcl_NextHashEntry(&hSearch)) {
  4842.             chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
  4843.             if (chanPtr->flags & TCL_READABLE) {
  4844.                 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
  4845.             }
  4846.         }
  4847.         return TCL_OK;
  4848.     }
  4849.  
  4850.     if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
  4851.         if (argc != 3) {
  4852.             Tcl_AppendResult(interp, "channel name required",
  4853.                     (char *) NULL);
  4854.             return TCL_ERROR;
  4855.         }
  4856.         
  4857.         sprintf(buf, "%d", chanPtr->refCount);
  4858.         Tcl_AppendResult(interp, buf, (char *) NULL);
  4859.         return TCL_OK;
  4860.     }
  4861.     
  4862.     if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
  4863.         if (argc != 3) {
  4864.             Tcl_AppendResult(interp, "channel name required",
  4865.                     (char *) NULL);
  4866.             return TCL_ERROR;
  4867.         }
  4868.         Tcl_AppendResult(interp, chanPtr->typePtr->typeName, (char *) NULL);
  4869.         return TCL_OK;
  4870.     }
  4871.     
  4872.     if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
  4873.         hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
  4874.         if (hTblPtr == (Tcl_HashTable *) NULL) {
  4875.             return TCL_OK;
  4876.         }
  4877.         for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
  4878.                  hPtr != (Tcl_HashEntry *) NULL;
  4879.                  hPtr = Tcl_NextHashEntry(&hSearch)) {
  4880.             chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
  4881.             if (chanPtr->flags & TCL_WRITABLE) {
  4882.                 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
  4883.             }
  4884.         }
  4885.         return TCL_OK;
  4886.     }
  4887.  
  4888.     Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
  4889.             "info, open, readable, or writable",
  4890.             (char *) NULL);
  4891.     return TCL_ERROR;
  4892. }
  4893.  
  4894. /*
  4895.  *----------------------------------------------------------------------
  4896.  *
  4897.  * TclTestChannelEventCmd --
  4898.  *
  4899.  *    This procedure implements the "testchannelevent" command. It is
  4900.  *    used to test the Tcl channel event mechanism. It is present in
  4901.  *    this file instead of tclTest.c because it needs access to the
  4902.  *    internal structure of the channel.
  4903.  *
  4904.  * Results:
  4905.  *    A standard Tcl result.
  4906.  *
  4907.  * Side effects:
  4908.  *    Creates, deletes and returns channel event handlers.
  4909.  *
  4910.  *----------------------------------------------------------------------
  4911.  */
  4912.  
  4913.     /* ARGSUSED */
  4914. int
  4915. TclTestChannelEventCmd(dummy, interp, argc, argv)
  4916.     ClientData dummy;            /* Not used. */
  4917.     Tcl_Interp *interp;            /* Current interpreter. */
  4918.     int argc;                /* Number of arguments. */
  4919.     char **argv;            /* Argument strings. */
  4920. {
  4921.     Channel *chanPtr;
  4922.     EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
  4923.     char *cmd;
  4924.     int index, i, mask, len;
  4925.  
  4926.     if ((argc < 3) || (argc > 5)) {
  4927.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  4928.                 " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
  4929.         return TCL_ERROR;
  4930.     }
  4931.     chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
  4932.     if (chanPtr == (Channel *) NULL) {
  4933.         return TCL_ERROR;
  4934.     }
  4935.     cmd = argv[2];
  4936.     len = strlen(cmd);
  4937.     if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
  4938.         if (argc != 5) {
  4939.             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  4940.                     " channelName add eventSpec script\"", (char *) NULL);
  4941.             return TCL_ERROR;
  4942.         }
  4943.         if (strcmp(argv[3], "readable") == 0) {
  4944.             mask = TCL_READABLE;
  4945.         } else if (strcmp(argv[3], "writable") == 0) {
  4946.             mask = TCL_WRITABLE;
  4947.         } else {
  4948.             Tcl_AppendResult(interp, "bad event name \"", argv[3],
  4949.                     "\": must be readable or writable", (char *) NULL);
  4950.             return TCL_ERROR;
  4951.         }
  4952.  
  4953.         esPtr = (EventScriptRecord *) ckalloc((unsigned)
  4954.                 sizeof(EventScriptRecord));
  4955.         esPtr->nextPtr = chanPtr->scriptRecordPtr;
  4956.         chanPtr->scriptRecordPtr = esPtr;
  4957.         
  4958.         esPtr->chanPtr = chanPtr;
  4959.         esPtr->interp = interp;
  4960.         esPtr->mask = mask;
  4961.         esPtr->script = ckalloc((unsigned) (strlen(argv[4]) + 1));
  4962.         strcpy(esPtr->script, argv[4]);
  4963.  
  4964.         Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
  4965.                 ChannelEventScriptInvoker, (ClientData) esPtr);
  4966.         
  4967.         return TCL_OK;
  4968.     }
  4969.  
  4970.     if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
  4971.         if (argc != 4) {
  4972.             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  4973.                     " channelName delete index\"", (char *) NULL);
  4974.             return TCL_ERROR;
  4975.         }
  4976.         if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
  4977.             return TCL_ERROR;
  4978.         }
  4979.         if (index < 0) {
  4980.             Tcl_AppendResult(interp, "bad event index: ", argv[3],
  4981.                     ": must be nonnegative", (char *) NULL);
  4982.             return TCL_ERROR;
  4983.         }
  4984.         for (i = 0, esPtr = chanPtr->scriptRecordPtr;
  4985.                  (i < index) && (esPtr != (EventScriptRecord *) NULL);
  4986.                  i++, esPtr = esPtr->nextPtr) {
  4987.         /* Empty loop body. */
  4988.         }
  4989.         if (esPtr == (EventScriptRecord *) NULL) {
  4990.             Tcl_AppendResult(interp, "bad event index ", argv[3],
  4991.                     ": out of range", (char *) NULL);
  4992.             return TCL_ERROR;
  4993.         }
  4994.         if (esPtr == chanPtr->scriptRecordPtr) {
  4995.             chanPtr->scriptRecordPtr = esPtr->nextPtr;
  4996.         } else {
  4997.             for (prevEsPtr = chanPtr->scriptRecordPtr;
  4998.                      (prevEsPtr != (EventScriptRecord *) NULL) &&
  4999.                          (prevEsPtr->nextPtr != esPtr);
  5000.                      prevEsPtr = prevEsPtr->nextPtr) {
  5001.                 /* Empty loop body. */
  5002.             }
  5003.             if (prevEsPtr == (EventScriptRecord *) NULL) {
  5004.                 panic("TclTestChannelEventCmd: damaged event script list");
  5005.             }
  5006.             prevEsPtr->nextPtr = esPtr->nextPtr;
  5007.         }
  5008.         Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
  5009.                 ChannelEventScriptInvoker, (ClientData) esPtr);
  5010.         Tcl_EventuallyFree((ClientData)esPtr->script, TCL_DYNAMIC);
  5011.         ckfree((char *) esPtr);
  5012.  
  5013.         return TCL_OK;
  5014.     }
  5015.  
  5016.     if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
  5017.         if (argc != 3) {
  5018.             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  5019.                     " channelName list\"", (char *) NULL);
  5020.             return TCL_ERROR;
  5021.         }
  5022.         for (esPtr = chanPtr->scriptRecordPtr;
  5023.                  esPtr != (EventScriptRecord *) NULL;
  5024.                  esPtr = esPtr->nextPtr) {
  5025.             Tcl_AppendElement(interp,
  5026.                     esPtr->mask == TCL_READABLE ? "readable" : "writable");
  5027.             Tcl_AppendElement(interp, esPtr->script);
  5028.         }
  5029.         return TCL_OK;
  5030.     }
  5031.  
  5032.     if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
  5033.         if (argc != 3) {
  5034.             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  5035.                     " channelName removeall\"", (char *) NULL);
  5036.             return TCL_ERROR;
  5037.         }
  5038.         for (esPtr = chanPtr->scriptRecordPtr;
  5039.                  esPtr != (EventScriptRecord *) NULL;
  5040.                  esPtr = nextEsPtr) {
  5041.             nextEsPtr = esPtr->nextPtr;
  5042.             Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
  5043.                     ChannelEventScriptInvoker, (ClientData) esPtr);
  5044.             Tcl_EventuallyFree((ClientData)esPtr->script, TCL_DYNAMIC);
  5045.             ckfree((char *) esPtr);
  5046.         }
  5047.         chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
  5048.         return TCL_OK;
  5049.     }
  5050.  
  5051.     Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
  5052.             "add, delete, list, or removeall", (char *) NULL);
  5053.     return TCL_ERROR;
  5054.  
  5055. }
  5056.