Ck console graphics toolkit

[oss/ck.git] / tkEvent.c

/* 
 * tkEvent.c --
 *
 *      This file provides basic event-managing facilities, whereby
 *      procedure callbacks may be attached to certain events.  It
 *      also contains the command procedures for the commands "after"
 *      and "fileevent", plus abridged versions of "tkwait" and
 *      "update", for use with Tk_EventInit.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "ckPort.h"
#include "ck.h"

#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4)

/*
 * For each timer callback that's pending, there is one record
 * of the following type, chained together in a list sorted by
 * time (earliest event first).
 */

typedef struct TimerEvent {
    struct timeval time;        /* When timer is to fire. */
    void (*proc)  _ANSI_ARGS_((ClientData clientData));
                                /* Procedure to call. */
    ClientData clientData;      /* Argument to pass to proc. */
    Tk_TimerToken token;        /* Identifies event so it can be
                                 * deleted. */
    struct TimerEvent *nextPtr; /* Next event in queue, or NULL for
                                 * end of queue. */
} TimerEvent;

static TimerEvent *firstTimerHandlerPtr;
                                /* First event in queue. */

/*
 * The information below is used to provide read, write, and
 * exception masks to select during calls to Tk_DoOneEvent.
 */

static fd_mask ready[3*MASK_SIZE];
                                /* Masks passed to select and modified
                                 * by kernel to indicate which files are
                                 * actually ready. */
static fd_mask check[3*MASK_SIZE];
                                /* Temporary set of masks, built up during
                                 * Tk_DoOneEvent, that reflects what files
                                 * we should wait for in the next select
                                 * (doesn't include things that we've been
                                 * asked to ignore in this call). */
static int numFds = 0;          /* Number of valid bits in mask
                                 * arrays (this value is passed
                                 * to select). */

/*
 * For each file registered in a call to Tk_CreateFileHandler,
 * and for each display that's currently active, there is one
 * record of the following type.  All of these records are
 * chained together into a single list.
 */

typedef struct FileHandler {
    int fd;                     /* POSIX file descriptor for file. */
    fd_mask *readPtr;           /* Pointer to word in ready array
                                 * for this file's read mask bit. */
    fd_mask *writePtr;          /* Same for write mask bit. */
    fd_mask *exceptPtr;         /* Same for except mask bit. */
    fd_mask *checkReadPtr;      /* Pointer to word in check array for
                                 * this file's read mask bit. */
    fd_mask *checkWritePtr;     /* Same for write mask bit. */
    fd_mask *checkExceptPtr;    /* Same for except mask bit. */
    fd_mask bitSelect;          /* Value to AND with *readPtr etc. to
                                 * select just this file's bit. */
    int mask;                   /* Mask of desired events: TK_READABLE, etc. */
    Tk_FileProc *proc;          /* Procedure to call, in the style of
                                 * Tk_CreateFileHandler.  This is NULL
                                 * if the handler was created by
                                 * Tk_CreateFileHandler2. */
    Tk_FileProc2 *proc2;        /* Procedure to call, in the style of
                                 * Tk_CreateFileHandler2.  NULL means that
                                 * the handler was created by
                                 * Tk_CreateFileHandler. */
    ClientData clientData;      /* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we
                                 * care about (NULL for end of
                                 * list). */
} FileHandler;

static FileHandler *firstFileHandlerPtr;
                                /* List of all file events. */

/*
 * There is one of the following structures for each of the
 * handlers declared in a call to Tk_DoWhenIdle.  All of the
 * currently-active handlers are linked together into a list.
 */

typedef struct IdleHandler {
    void (*proc)  _ANSI_ARGS_((ClientData clientData));
                                /* Procedure to call. */
    ClientData clientData;      /* Value to pass to proc. */
    int generation;             /* Used to distinguish older handlers from
                                 * recently-created ones. */
    struct IdleHandler *nextPtr;/* Next in list of active handlers. */
} IdleHandler;

static IdleHandler *idleList = NULL;
                                /* First in list of all idle handlers. */
static IdleHandler *lastIdlePtr = NULL;
                                /* Last in list (or NULL for empty list). */
static int idleGeneration = 0;  /* Used to fill in the "generation" fields
                                 * of IdleHandler structures.  Increments
                                 * each time Tk_DoOneEvent starts calling
                                 * idle handlers, so that all old handlers
                                 * can be called without calling any of the
                                 * new ones created by old ones. */
static int oldGeneration = 0;   /* "generation" currently being handled. */

/*
 * The following procedure provides a secret hook for tkXEvent.c so that
 * it can handle delayed mouse motion events at the right time.
 */

void (*tkDelayedEventProc) _ANSI_ARGS_((void)) = NULL;

/*
 * One of the following structures exists for each file with a handler
 * created by the "fileevent" command.  Several of the fields are
 * two-element arrays, in which the first element is used for read
 * events and the second for write events.
 */

typedef struct FileEvent {
    FILE *f;                            /* Stdio handle for file. */
    Tcl_Interp *interps[2];             /* Interpreters in which to execute
                                         * scripts.  NULL means no handler
                                         * for event. */
    char *scripts[2];                   /* Scripts to evaluate in response to
                                         * events (malloc'ed).  NULL means no
                                         * handler for event. */
    struct FileEvent *nextPtr;          /* Next in list of all file events
                                         * currently defined. */
} FileEvent;

static FileEvent *firstFileEventPtr = NULL;
                                        /* First in list of all existing
                                         * file events. */

/*
 * The data structure below is used by the "after" command to remember
 * the command to be executed later.
 */

typedef struct AfterInfo {
    Tcl_Interp *interp;         /* Interpreter in which to execute command. */
    char *command;              /* Command to execute.  Malloc'ed, so must
                                 * be freed when structure is deallocated. */
    int id;                     /* Integer identifier for command;  used to
                                 * cancel it. */
    Tk_TimerToken token;        /* Used to cancel the "after" command.  NULL
                                 * means that the command is run as an
                                 * idle handler rather than as a timer
                                 * handler. */
    struct AfterInfo *nextPtr;  /* Next in list of all "after" commands for
                                 * the application. */
} AfterInfo;

static AfterInfo *firstAfterPtr = NULL;
                                /* First in list of all pending "after"
                                 * commands. */

/*
 * The data structure below is used to report background errors.  One
 * such structure is allocated for each error;  it holds information
 * about the interpreter and the error until tkerror can be invoked
 * later as an idle handler.
 */

typedef struct BgError {
    Tcl_Interp *interp;         /* Interpreter in which error occurred.  NULL
                                 * means this error report has been cancelled
                                 * (a previous report generated a break). */
    char *errorMsg;             /* The error message (interp->result when
                                 * the error occurred).  Malloc-ed. */
    char *errorInfo;            /* Value of the errorInfo variable
                                 * (malloc-ed). */
    char *errorCode;            /* Value of the errorCode variable
                                 * (malloc-ed). */
    struct BgError *nextPtr;    /* Next in list of all pending error
                                 * reports. */
} BgError;

static BgError *firstBgPtr = NULL;
                                /* First in list of all background errors
                                 * waiting to be processed (NULL if none). */
static BgError *lastBgPtr = NULL;
                                /* First in list of all background errors
                                 * waiting to be processed (NULL if none). */

/*
 * Prototypes for procedures referenced only in this file:
 */

static void             AfterProc _ANSI_ARGS_((ClientData clientData));
static void             DeleteFileEvent _ANSI_ARGS_((FILE *f));
static int              FileEventProc _ANSI_ARGS_((ClientData clientData,
                            int mask, int flags));
static void             FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr));
static void             HandleBgErrors _ANSI_ARGS_((ClientData clientData));
static int              TkwaitCmd2 _ANSI_ARGS_((ClientData clientData,
                            Tcl_Interp *interp, int argc, char **argv));
static int              UpdateCmd2 _ANSI_ARGS_((ClientData clientData,
                            Tcl_Interp *interp, int argc, char **argv));
static char *           WaitVariableProc2 _ANSI_ARGS_((ClientData clientData,
                            Tcl_Interp *interp, char *name1, char *name2,
                            int flags));
\f
/*
 *--------------------------------------------------------------
 *
 * Tk_CreateFileHandler --
 *
 *      Arrange for a given procedure to be invoked whenever
 *      a given file becomes readable or writable.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      From now on, whenever the I/O channel given by fd becomes
 *      ready in the way indicated by mask, proc will be invoked.
 *      See the manual entry for details on the calling sequence
 *      to proc.  If fd is already registered then the old mask
 *      and proc and clientData values will be replaced with
 *      new ones.
 *
 *--------------------------------------------------------------
 */

void
Tk_CreateFileHandler(fd, mask, proc, clientData)
    int fd;                     /* Integer identifier for stream. */
    int mask;                   /* OR'ed combination of TK_READABLE,
                                 * TK_WRITABLE, and TK_EXCEPTION:
                                 * indicates conditions under which
                                 * proc should be called.  TK_IS_DISPLAY
                                 * indicates that this is a display and that
                                 * clientData is the (Display *) for it,
                                 * and that events should be handled
                                 * automatically.*/
    Tk_FileProc *proc;          /* Procedure to call for each
                                 * selected event. */
    ClientData clientData;      /* Arbitrary data to pass to proc. */
{
    register FileHandler *filePtr;
    int index;

    if (fd >= FD_SETSIZE) {
        panic("Tk_CreatefileHandler can't handle file id %d", fd);
    }

    /*
     * Make sure the file isn't already registered.  Create a
     * new record in the normal case where there's no existing
     * record.
     */

    for (filePtr = firstFileHandlerPtr; filePtr != NULL;
            filePtr = filePtr->nextPtr) {
        if (filePtr->fd == fd) {
            break;
        }
    }
    index = fd/(NBBY*sizeof(fd_mask));
    if (filePtr == NULL) {
        filePtr = (FileHandler *) ckalloc(sizeof(FileHandler));
        filePtr->fd = fd;
        filePtr->readPtr = &ready[index];
        filePtr->writePtr = &ready[index+MASK_SIZE];
        filePtr->exceptPtr = &ready[index+2*MASK_SIZE];
        filePtr->checkReadPtr = &check[index];
        filePtr->checkWritePtr = &check[index+MASK_SIZE];
        filePtr->checkExceptPtr = &check[index+2*MASK_SIZE];
        filePtr->bitSelect = 1 << (fd%(NBBY*sizeof(fd_mask)));
        filePtr->nextPtr = firstFileHandlerPtr;
        firstFileHandlerPtr = filePtr;
    }

    /*
     * The remainder of the initialization below is done
     * regardless of whether or not this is a new record
     * or a modification of an old one.
     */

    filePtr->mask = mask;
    filePtr->proc = proc;
    filePtr->proc2 = NULL;
    filePtr->clientData = clientData;

    if (numFds <= fd) {
        numFds = fd+1;
    }
}
\f
/*
 *--------------------------------------------------------------
 *
 * Tk_CreateFileHandler2 --
 *
 *      Arrange for a given procedure to be invoked during the
 *      event loop to handle a particular file.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      In each pass through Tk_DoOneEvent, proc will be invoked to
 *      decide whether fd is "ready" and take appropriate action if
 *      it is.  See the manual entry for details on the calling
 *      sequence to proc.  If a handler for fd has already been
 *      registered then it is superseded by the new one.
 *
 *--------------------------------------------------------------
 */

void
Tk_CreateFileHandler2(fd, proc, clientData)
    int fd;                     /* Integer identifier for stream. */
    Tk_FileProc2 *proc;         /* Procedure to call from the event
                                 * dispatcher. */
    ClientData clientData;      /* Arbitrary data to pass to proc. */
{
    register FileHandler *filePtr;

    /*
     * Let Tk_CreateFileHandler do all of the work of setting up
     * the handler, then just modify things a bit after it returns.
     */

    Tk_CreateFileHandler(fd, 0, (Tk_FileProc *) NULL, clientData);
    for (filePtr = firstFileHandlerPtr; filePtr->fd != fd;
            filePtr = filePtr->nextPtr) {
        /* Empty loop body. */
    }
    filePtr->proc = NULL;
    filePtr->proc2 = proc;
}
\f
/*
 *--------------------------------------------------------------
 *
 * Tk_DeleteFileHandler --
 *
 *      Cancel a previously-arranged callback arrangement for
 *      a file.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      If a callback was previously registered on fd, remove it.
 *
 *--------------------------------------------------------------
 */

void
Tk_DeleteFileHandler(fd)
    int fd;                     /* Stream id for which to remove
                                 * callback procedure. */
{
    register FileHandler *filePtr;
    FileHandler *prevPtr;

    /*
     * Find the entry for the given file (and return if there
     * isn't one).
     */

    for (prevPtr = NULL, filePtr = firstFileHandlerPtr; ;
            prevPtr = filePtr, filePtr = filePtr->nextPtr) {
        if (filePtr == NULL) {
            return;
        }
        if (filePtr->fd == fd) {
            break;
        }
    }

    /*
     * Clean up information in the callback record.
     */

    if (prevPtr == NULL) {
        firstFileHandlerPtr = filePtr->nextPtr;
    } else {
        prevPtr->nextPtr = filePtr->nextPtr;
    }
    ckfree((char *) filePtr);

    /*
     * Recompute numFds.
     */

    numFds = 0;
    for (filePtr = firstFileHandlerPtr; filePtr != NULL;
            filePtr = filePtr->nextPtr) {
        if (numFds <= filePtr->fd) {
            numFds = filePtr->fd+1;
        }
    }
}
\f
/*
 *--------------------------------------------------------------
 *
 * Tk_CreateTimerHandler --
 *
 *      Arrange for a given procedure to be invoked at a particular
 *      time in the future.
 *
 * Results:
 *      The return value is a token for the timer event, which
 *      may be used to delete the event before it fires.
 *
 * Side effects:
 *      When milliseconds have elapsed, proc will be invoked
 *      exactly once.
 *
 *--------------------------------------------------------------
 */

Tk_TimerToken
Tk_CreateTimerHandler(milliseconds, proc, clientData)
    int milliseconds;           /* How many milliseconds to wait
                                 * before invoking proc. */
    Tk_TimerProc *proc;         /* Procedure to invoke. */
    ClientData clientData;      /* Arbitrary data to pass to proc. */
{
    register TimerEvent *timerPtr, *tPtr2, *prevPtr;
    static int id = 0;

    timerPtr = (TimerEvent *) ckalloc(sizeof(TimerEvent));

    /*
     * Compute when the event should fire.
     */

    (void) gettimeofday(&timerPtr->time, (struct timezone *) NULL);
    timerPtr->time.tv_sec += milliseconds/1000;
    timerPtr->time.tv_usec += (milliseconds%1000)*1000;
    if (timerPtr->time.tv_usec >= 1000000) {
        timerPtr->time.tv_usec -= 1000000;
        timerPtr->time.tv_sec += 1;
    }

    /*
     * Fill in other fields for the event.
     */

    timerPtr->proc = proc;
    timerPtr->clientData = clientData;
    id++;
    timerPtr->token = (Tk_TimerToken) id;

    /*
     * Add the event to the queue in the correct position
     * (ordered by event firing time).
     */

    for (tPtr2 = firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;
            prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) {
        if ((tPtr2->time.tv_sec > timerPtr->time.tv_sec)
                || ((tPtr2->time.tv_sec == timerPtr->time.tv_sec)
                && (tPtr2->time.tv_usec > timerPtr->time.tv_usec))) {
            break;
        }
    }
    if (prevPtr == NULL) {
        timerPtr->nextPtr = firstTimerHandlerPtr;
        firstTimerHandlerPtr = timerPtr;
    } else {
        timerPtr->nextPtr = prevPtr->nextPtr;
        prevPtr->nextPtr = timerPtr;
    }
    return timerPtr->token;
}
\f
/*
 *--------------------------------------------------------------
 *
 * Tk_DeleteTimerHandler --
 *
 *      Delete a previously-registered timer handler.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Destroy the timer callback identified by TimerToken,
 *      so that its associated procedure will not be called.
 *      If the callback has already fired, or if the given
 *      token doesn't exist, then nothing happens.
 *
 *--------------------------------------------------------------
 */

void
Tk_DeleteTimerHandler(token)
    Tk_TimerToken token;        /* Result previously returned by
                                 * Tk_DeleteTimerHandler. */
{
    register TimerEvent *timerPtr, *prevPtr;

    for (timerPtr = firstTimerHandlerPtr, prevPtr = NULL; timerPtr != NULL;
            prevPtr = timerPtr, timerPtr = timerPtr->nextPtr) {
        if (timerPtr->token != token) {
            continue;
        }
        if (prevPtr == NULL) {
            firstTimerHandlerPtr = timerPtr->nextPtr;
        } else {
            prevPtr->nextPtr = timerPtr->nextPtr;
        }
        ckfree((char *) timerPtr);
        return;
    }
}
\f
/*
 *--------------------------------------------------------------
 *
 * Tk_DoWhenIdle --
 *
 *      Arrange for proc to be invoked the next time the
 *      system is idle (i.e., just before the next time
 *      that Tk_DoOneEvent would have to wait for something
 *      to happen).
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Proc will eventually be called, with clientData
 *      as argument.  See the manual entry for details.
 *
 *--------------------------------------------------------------
 */

void
Tk_DoWhenIdle(proc, clientData)
    Tk_IdleProc *proc;          /* Procedure to invoke. */
    ClientData clientData;      /* Arbitrary value to pass to proc. */
{
    register IdleHandler *idlePtr;

    idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));
    idlePtr->proc = proc;
    idlePtr->clientData = clientData;
    idlePtr->generation = idleGeneration;
    idlePtr->nextPtr = NULL;
    if (lastIdlePtr == NULL) {
        idleList = idlePtr;
    } else {
        lastIdlePtr->nextPtr = idlePtr;
    }
    lastIdlePtr = idlePtr;
}
\f
/*
 *--------------------------------------------------------------
 *
 * Tk_DoWhenIdle2 --
 *
 *      Arrange for proc to be invoked when the system is idle
 *      (i.e., if currently idle or just before the next time
 *      that Tk_DoOneEvent would have to wait for something
 *      to happen).
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Proc will eventually be called, with clientData
 *      as argument.  See the manual entry for details.
 *
 *--------------------------------------------------------------
 */

void
Tk_DoWhenIdle2(proc, clientData)
    Tk_IdleProc *proc;          /* Procedure to invoke. */
    ClientData clientData;      /* Arbitrary value to pass to proc. */
{
    register IdleHandler *idlePtr;

    idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));
    idlePtr->proc = proc;
    idlePtr->clientData = clientData;
    idlePtr->generation = idleList == NULL ? oldGeneration :
        idleList->generation;
    idlePtr->nextPtr = NULL;
    if (lastIdlePtr == NULL) {
        idleList = idlePtr;
    } else {
        lastIdlePtr->nextPtr = idlePtr;
    }
    lastIdlePtr = idlePtr;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * Tk_CancelIdleCall --
 *
 *      If there are any when-idle calls requested to a given procedure
 *      with given clientData, cancel all of them.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      If the proc/clientData combination were on the when-idle list,
 *      they are removed so that they will never be called.
 *
 *----------------------------------------------------------------------
 */

void
Tk_CancelIdleCall(proc, clientData)
    Tk_IdleProc *proc;          /* Procedure that was previously registered. */
    ClientData clientData;      /* Arbitrary value to pass to proc. */
{
    register IdleHandler *idlePtr, *prevPtr;
    IdleHandler *nextPtr;

    for (prevPtr = NULL, idlePtr = idleList; idlePtr != NULL;
            prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {
        while ((idlePtr->proc == proc)
                && (idlePtr->clientData == clientData)) {
            nextPtr = idlePtr->nextPtr;
            ckfree((char *) idlePtr);
            idlePtr = nextPtr;
            if (prevPtr == NULL) {
                idleList = idlePtr;
            } else {
                prevPtr->nextPtr = idlePtr;
            }
            if (idlePtr == NULL) {
                lastIdlePtr = prevPtr;
                return;
            }
        }
    }
}
\f
/*
 *--------------------------------------------------------------
 *
 * Tk_DoOneEvent --
 *
 *      Process a single event of some sort.  If there's no
 *      work to do, wait for an event to occur, then process
 *      it.
 *
 * Results:
 *      The return value is 1 if the procedure actually found
 *      an event to process.  If no event was found then 0 is
 *      returned.
 *
 * Side effects:
 *      May delay execution of process while waiting for an
 *      X event, X error, file-ready event, or timer event.
 *      The handling of the event could cause additional
 *      side effects.  Collapses sequences of mouse-motion
 *      events for the same window into a single event by
 *      delaying motion event processing.
 *
 *--------------------------------------------------------------
 */

int
Tk_DoOneEvent(flags)
    int flags;                  /* Miscellaneous flag values:  may be any
                                 * combination of TK_DONT_WAIT, TK_X_EVENTS,
                                 * TK_FILE_EVENTS, TK_TIMER_EVENTS, and
                                 * TK_IDLE_EVENTS. */
{
    register FileHandler *filePtr;
    struct timeval curTime, timeoutVal, *timeoutPtr;
    int numFound, mask, anyFilesToWaitFor;

    if ((flags & TK_ALL_EVENTS) == 0) {
        flags |= TK_ALL_EVENTS;
    }

    /*
     * Phase One: see if there's a ready file that was left over
     * from before (i.e don't do a select, just check the bits from
     * the last select).
     */

    checkFiles:
    if (tcl_AsyncReady) {
        (void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
        return 1;
    }
    memset((VOID *) check, 0, 3*MASK_SIZE*sizeof(fd_mask));
    anyFilesToWaitFor = 0;
    for (filePtr = firstFileHandlerPtr; filePtr != NULL;
            filePtr = filePtr->nextPtr) {
        mask = 0;
        if (*filePtr->readPtr & filePtr->bitSelect) {
            mask |= TK_READABLE;
            *filePtr->readPtr &= ~filePtr->bitSelect;
        }
        if (*filePtr->writePtr & filePtr->bitSelect) {
            mask |= TK_WRITABLE;
            *filePtr->writePtr &= ~filePtr->bitSelect;
        }
        if (*filePtr->exceptPtr & filePtr->bitSelect) {
            mask |= TK_EXCEPTION;
            *filePtr->exceptPtr &= ~filePtr->bitSelect;
        }
        if (filePtr->proc2 != NULL) {
            /*
             * Handler created by Tk_CreateFileHandler2.
             */

            mask = (*filePtr->proc2)(filePtr->clientData, mask, flags);
            if (mask == TK_FILE_HANDLED) {
                return 1;
            }
        } else {
            /*
             * Handler created by Tk_CreateFileHandler.
             */

            if (!(flags & TK_FILE_EVENTS)) {
                continue;
            }
            if (mask != 0) {
                (*filePtr->proc)(filePtr->clientData, mask);
                return 1;
            }
            mask = filePtr->mask;
        }
        if (mask != 0) {
            anyFilesToWaitFor = 1;
            if (mask & TK_READABLE) {
                *filePtr->checkReadPtr |= filePtr->bitSelect;
            }
            if (mask & TK_WRITABLE) {
                *filePtr->checkWritePtr |= filePtr->bitSelect;
            }
            if (mask & TK_EXCEPTION) {
                *filePtr->checkExceptPtr |= filePtr->bitSelect;
            }
        }
    }

    /*
     * Phase Two: get the current time and see if any timer
     * events are ready to fire.  If so, fire one and return.
     */

    checkTime:
    if ((firstTimerHandlerPtr != NULL) && (flags & TK_TIMER_EVENTS)) {
        register TimerEvent *timerPtr = firstTimerHandlerPtr;

        (void) gettimeofday(&curTime, (struct timezone *) NULL);
        if ((timerPtr->time.tv_sec < curTime.tv_sec)
                || ((timerPtr->time.tv_sec == curTime.tv_sec)
                &&  (timerPtr->time.tv_usec < curTime.tv_usec))) {
            firstTimerHandlerPtr = timerPtr->nextPtr;
            (*timerPtr->proc)(timerPtr->clientData);
            ckfree((char *) timerPtr);
            return 1;
        }
    }

    /*
     * Phase Three: if there are DoWhenIdle requests pending (or
     * if we're not allowed to block), then do a select with an
     * instantaneous timeout.  If a ready file is found, then go
     * back to process it.
     */

    if (((idleList != NULL) && (flags & TK_IDLE_EVENTS))
            || (flags & TK_DONT_WAIT)) {
        if (flags & (TK_X_EVENTS|TK_FILE_EVENTS)) {
            memcpy((VOID *) ready, (VOID *) check,
                    3*MASK_SIZE*sizeof(fd_mask));
            timeoutVal.tv_sec = timeoutVal.tv_usec = 0;
            numFound = select(numFds, (SELECT_MASK *) &ready[0],
                    (SELECT_MASK *) &ready[MASK_SIZE],
                    (SELECT_MASK *) &ready[2*MASK_SIZE], &timeoutVal);
            if (numFound <= 0) {
                /*
                 * Some systems don't clear the masks after an error, so
                 * we have to do it here.
                 */

                memset((VOID *) ready, 0, 3*MASK_SIZE*sizeof(fd_mask));
            }
            if ((numFound > 0) || ((numFound == -1) && (errno == EINTR))) {
                goto checkFiles;
            }
        }
    }

    /*
     * Phase Four: if there is a delayed motion event then call a procedure
     * to handle it.  Do it now, before calling any DoWhenIdle handlers,
     * since the goal of idle handlers is to delay until after all pending
     * events have been processed.
     *
     * The particular implementation of this (a procedure variable shared
     * with tkXEvent.c) is a bit kludgy, but it allows this file to be used
     * separately without any of the rest of Tk.
     */

    if ((tkDelayedEventProc != NULL) && (flags & TK_X_EVENTS)) {
        (*tkDelayedEventProc)();
        return 1;
    }

    /*
     * Phase Five:  process all pending DoWhenIdle requests.
     */

    if ((idleList != NULL) && (flags & TK_IDLE_EVENTS)) {
        register IdleHandler *idlePtr;
        int myGeneration;

        oldGeneration = myGeneration = idleList->generation;
        idleGeneration++;

        /*
         * The code below is trickier than it may look, for the following
         * reasons:
         *
         * 1. New handlers can get added to the list while the current
         *    one is being processed.  If new ones get added, we don't
         *    want to process them during this pass through the list (want
         *    to check for other work to do first).  This is implemented
         *    using the generation number in the handler:  new handlers
         *    will have a different generation than any of the ones currently
         *    on the list.
         * 2. The handler can call Tk_DoOneEvent, so we have to remove
         *    the hander from the list before calling it. Otherwise an
         *    infinite loop could result.
         * 3. Tk_CancelIdleCall can be called to remove an element from
         *    the list while a handler is executing, so the list could
         *    change structure during the call.
         */

        for (idlePtr = idleList;
                ((idlePtr != NULL) && (idlePtr->generation == myGeneration));
                idlePtr = idleList) {
            idleList = idlePtr->nextPtr;
            if (idleList == NULL) {
                lastIdlePtr = NULL;
            }
            (*idlePtr->proc)(idlePtr->clientData);
            ckfree((char *) idlePtr);
        }
        return 1;
    }

    /*
     * Phase Six: do a select to wait for either one of the
     * files to become ready or for the first timer event to
     * fire.  Then go back to process the event.
     */

    if ((flags & TK_DONT_WAIT)
            || !(flags & (TK_TIMER_EVENTS|TK_FILE_EVENTS|TK_X_EVENTS))) {
        return 0;
    }
    if ((firstTimerHandlerPtr == NULL) || !(flags & TK_TIMER_EVENTS)) {
        timeoutPtr = NULL;
    } else {
        timeoutPtr = &timeoutVal;
        timeoutVal.tv_sec = firstTimerHandlerPtr->time.tv_sec
            - curTime.tv_sec;
        timeoutVal.tv_usec = firstTimerHandlerPtr->time.tv_usec
            - curTime.tv_usec;
        if (timeoutVal.tv_usec < 0) {
            timeoutVal.tv_sec -= 1;
            timeoutVal.tv_usec += 1000000;
        }
    }
    if ((timeoutPtr == NULL) && !anyFilesToWaitFor) {
        return 0;
    }
    memcpy((VOID *) ready, (VOID *) check, 3*MASK_SIZE*sizeof(fd_mask));
    numFound = select(numFds, (SELECT_MASK *) &ready[0],
            (SELECT_MASK *) &ready[MASK_SIZE],
            (SELECT_MASK *) &ready[2*MASK_SIZE], timeoutPtr);
    if (numFound == -1) {
        /*
         * Some systems don't clear the masks after an error, so
         * we have to do it here.
         */

        memset((VOID *) ready, 0, 3*MASK_SIZE*sizeof(fd_mask));
    }
    if (numFound == 0) {
        goto checkTime;
    }
    goto checkFiles;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * Tk_Sleep --
 *
 *      Delay execution for the specified number of milliseconds.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Time passes.
 *
 *----------------------------------------------------------------------
 */

void
Tk_Sleep(ms)
    int ms;                     /* Number of milliseconds to sleep. */
{
    static struct timeval delay;

    delay.tv_sec = ms/1000;
    delay.tv_usec = (ms%1000)*1000;
    (void) select(0, (SELECT_MASK *) 0, (SELECT_MASK *) 0,
            (SELECT_MASK *) 0, &delay);
}
\f
/*
 *----------------------------------------------------------------------
 *
 * Tk_BackgroundError --
 *
 *      This procedure is invoked to handle errors that occur in Tcl
 *      commands that are invoked in "background" (e.g. from event or
 *      timer bindings).
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The command "tkerror" is invoked later as an idle handler to
 *      process the error, passing it the error message.  If that fails,
 *      then an error message is output on stderr.
 *
 *----------------------------------------------------------------------
 */

void
Tk_BackgroundError(interp)
    Tcl_Interp *interp;         /* Interpreter in which an error has
                                 * occurred. */
{
    BgError *errPtr;
    char *varValue;

    /*
     * The Tcl_AddErrorInfo call below (with an empty string) ensures that
     * errorInfo gets properly set.  It's needed in cases where the error
     * came from a utility procedure like Tcl_GetVar instead of Tcl_Eval;
     * in these cases errorInfo still won't have been set when this
     * procedure is called.
     */

    Tcl_AddErrorInfo(interp, "");
    errPtr = (BgError *) ckalloc(sizeof(BgError));
    errPtr->interp = interp;
    errPtr->errorMsg = (char *) ckalloc((unsigned) (strlen(interp->result)
            + 1));
    strcpy(errPtr->errorMsg, interp->result);
    varValue = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
    if (varValue == NULL) {
        varValue = errPtr->errorMsg;
    }
    errPtr->errorInfo = (char *) ckalloc((unsigned) (strlen(varValue) + 1));
    strcpy(errPtr->errorInfo, varValue);
    varValue = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
    if (varValue == NULL) {
        varValue = "";
    }
    errPtr->errorCode = (char *) ckalloc((unsigned) (strlen(varValue) + 1));
    strcpy(errPtr->errorCode, varValue);
    errPtr->nextPtr = NULL;
    if (firstBgPtr == NULL) {
        firstBgPtr = errPtr;
        Tk_DoWhenIdle(HandleBgErrors, (ClientData) NULL);
    } else {
        lastBgPtr->nextPtr = errPtr;
    }
    lastBgPtr = errPtr;
    Tcl_ResetResult(interp);
}
\f
/*
 *----------------------------------------------------------------------
 *
 * HandleBgErrors --
 *
 *      This procedure is invoked as an idle handler to process all of
 *      the accumulated background errors.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Depends on what actions "tkerror" takes for the errors.
 *
 *----------------------------------------------------------------------
 */

static void
HandleBgErrors(clientData)
    ClientData clientData;              /* Not used. */
{
    Tcl_Interp *interp;
    char *command;
    char *argv[2];
    int code;
    BgError *errPtr;

    while (firstBgPtr != NULL) {
        interp = firstBgPtr->interp;
        if (interp == NULL) {
            goto doneWithReport;
        }

        /*
         * Restore important state variables to what they were at
         * the time the error occurred.
         */

        Tcl_SetVar(interp, "errorInfo", firstBgPtr->errorInfo,
                TCL_GLOBAL_ONLY);
        Tcl_SetVar(interp, "errorCode", firstBgPtr->errorCode,
                TCL_GLOBAL_ONLY);

        /*
         * Create and invoke the tkerror command.
         */

        argv[0] = "tkerror";
        argv[1] = firstBgPtr->errorMsg;
        command = Tcl_Merge(2, argv);
        Tcl_AllowExceptions(interp);
        code = Tcl_GlobalEval(interp, command);
        ckfree(command);
        if (code == TCL_ERROR) {
            if (strcmp(interp->result, "\"tkerror\" is an invalid command name or ambiguous abbreviation") == 0) {
                fprintf(stderr, "%s\n", firstBgPtr->errorInfo);
            } else {
                fprintf(stderr, "tkerror failed to handle background error.\n");
                fprintf(stderr, "    Original error: %s\n",
                        firstBgPtr->errorMsg);
                fprintf(stderr, "    Error in tkerror: %s\n", interp->result);
            }
        } else if (code == TCL_BREAK) {
            /*
             * Break means cancel any remaining error reports for this
             * interpreter.
             */

            for (errPtr = firstBgPtr; errPtr != NULL;
                    errPtr = errPtr->nextPtr) {
                if (errPtr->interp == interp) {
                    errPtr->interp = NULL;
                }
            }
        }

        /*
         * Discard the command and the information about the error report.
         */

        doneWithReport:
        ckfree(firstBgPtr->errorMsg);
        ckfree(firstBgPtr->errorInfo);
        ckfree(firstBgPtr->errorCode);
        errPtr = firstBgPtr->nextPtr;
        ckfree((char *) firstBgPtr);
        firstBgPtr = errPtr;
    }
    lastBgPtr = NULL;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * Tk_AfterCmd --
 *
 *      This procedure is invoked to process the "after" Tcl command.
 *      See the user documentation for details on what it does.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      See the user documentation.
 *
 *----------------------------------------------------------------------
 */

        /* ARGSUSED */
int
Tk_AfterCmd(clientData, interp, argc, argv)
    ClientData clientData;      /* Main window associated with
                                 * interpreter.  Not used.*/
    Tcl_Interp *interp;         /* Current interpreter. */
    int argc;                   /* Number of arguments. */
    char **argv;                /* Argument strings. */
{
    /*
     * The variable below is used to generate unique identifiers for
     * after commands.  This id can wrap around, which can potentially
     * cause problems.  However, there are not likely to be problems
     * in practice, because after commands can only be requested to
     * about a month in the future, and wrap-around is unlikely to
     * occur in less than about 1-10 years.  Thus it's unlikely that
     * any old ids will still be around when wrap-around occurs.
     */

    static int nextId = 1;
    int ms, id;
    AfterInfo *afterPtr;

    if (argc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"",
                argv[0], " milliseconds ?command? ?arg arg ...?\" or \"",
                argv[0], " cancel id|command\"", (char *) NULL);
        return TCL_ERROR;
    }

    if (isdigit((unsigned char) argv[1][0])) {
        if (Tcl_GetInt(interp, argv[1], &ms) != TCL_OK) {
            return TCL_ERROR;
        }
        if (ms < 0) {
            ms = 0;
        }
        if (argc == 2) {
            Tk_Sleep(ms);
            return TCL_OK;
        }
        afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
        afterPtr->interp = interp;
        if (argc == 3) {
            afterPtr->command = (char *) ckalloc((unsigned)
                    (strlen(argv[2]) + 1));
            strcpy(afterPtr->command, argv[2]);
        } else {
            afterPtr->command = Tcl_Concat(argc-2, argv+2);
        }
        afterPtr->id = nextId;
        nextId += 1;
        afterPtr->token = Tk_CreateTimerHandler(ms, AfterProc,
                (ClientData) afterPtr);
        afterPtr->nextPtr = firstAfterPtr;
        firstAfterPtr = afterPtr;
        sprintf(interp->result, "after#%d", afterPtr->id);
    } else if (strncmp(argv[1], "cancel", strlen(argv[1])) == 0) {
        char *arg;

        if (argc < 3) {
            Tcl_AppendResult(interp, "wrong # args: should be \"",
                    argv[0], " cancel id|command\"", (char *) NULL);
            return TCL_ERROR;
        }
        if (argc == 3) {
            arg = argv[2];
        } else {
            arg = Tcl_Concat(argc-2, argv+2);
        }
        if (strncmp(arg, "after#", 6) == 0) {
            if (Tcl_GetInt(interp, arg+6, &id) != TCL_OK) {
                return TCL_ERROR;
            }
            for (afterPtr = firstAfterPtr; afterPtr != NULL;
                    afterPtr = afterPtr->nextPtr) {
                if (afterPtr->id == id) {
                    break;
                }
            }
        } else {
            for (afterPtr = firstAfterPtr; afterPtr != NULL;
                    afterPtr = afterPtr->nextPtr) {
                if (strcmp(afterPtr->command, arg) == 0) {
                    break;
                }
            }
        }
        if (arg != argv[2]) {
            ckfree(arg);
        }
        if (afterPtr != NULL) {
            if (afterPtr->token != NULL) {
                Tk_DeleteTimerHandler(afterPtr->token);
            } else {
                Tk_CancelIdleCall(AfterProc, (ClientData) afterPtr);
            }
            FreeAfterPtr(afterPtr);
        }
    } else if (strncmp(argv[1], "idle", strlen(argv[1])) == 0) {
        if (argc < 3) {
            Tcl_AppendResult(interp, "wrong # args: should be \"",
                    argv[0], " idle script script ...\"", (char *) NULL);
            return TCL_ERROR;
        }
        afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
        afterPtr->interp = interp;
        if (argc == 3) {
            afterPtr->command = (char *) ckalloc((unsigned)
                    (strlen(argv[2]) + 1));
            strcpy(afterPtr->command, argv[2]);
        } else {
            afterPtr->command = Tcl_Concat(argc-2, argv+2);
        }
        afterPtr->id = nextId;
        nextId += 1;
        afterPtr->token = NULL;
        afterPtr->nextPtr = firstAfterPtr;
        firstAfterPtr = afterPtr;
        Tk_DoWhenIdle(AfterProc, (ClientData) afterPtr);
        sprintf(interp->result, "after#%d", afterPtr->id);
    } else {
        Tcl_AppendResult(interp, "bad argument \"", argv[1],
                "\": must be cancel, idle, or a number", (char *) NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * AfterProc --
 *
 *      Timer callback to execute commands registered with the
 *      "after" command.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Executes whatever command was specified.  If the command
 *      returns an error, then the command "tkerror" is invoked
 *      to process the error;  if tkerror fails then information
 *      about the error is output on stderr.
 *
 *----------------------------------------------------------------------
 */

static void
AfterProc(clientData)
    ClientData clientData;      /* Describes command to execute. */
{
    AfterInfo *afterPtr = (AfterInfo *) clientData;
    AfterInfo *prevPtr;
    int result;

    /*
     * First remove the callback from our list of callbacks;  otherwise
     * someone could delete the callback while it's being executed, which
     * could cause a core dump.
     */

    if (firstAfterPtr == afterPtr) {
        firstAfterPtr = afterPtr->nextPtr;
    } else {
        for (prevPtr = firstAfterPtr; prevPtr->nextPtr != afterPtr;
                prevPtr = prevPtr->nextPtr) {
            /* Empty loop body. */
        }
        prevPtr->nextPtr = afterPtr->nextPtr;
    }

    /*
     * Execute the callback.
     */

    result = Tcl_GlobalEval(afterPtr->interp, afterPtr->command);
    if (result != TCL_OK) {
        Tcl_AddErrorInfo(afterPtr->interp, "\n    (\"after\" script)");
        Tk_BackgroundError(afterPtr->interp);
    }

    /*
     * Free the memory for the callback.
     */

    ckfree(afterPtr->command);
    ckfree((char *) afterPtr);
}
\f
/*
 *----------------------------------------------------------------------
 *
 * FreeAfterPtr --
 *
 *      This procedure removes an "after" command from the list of
 *      those that are pending and frees its resources.  This procedure
 *      does *not* cancel the timer handler;  if that's needed, the
 *      caller must do it.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The memory associated with afterPtr is released.
 *
 *----------------------------------------------------------------------
 */

static void
FreeAfterPtr(afterPtr)
    AfterInfo *afterPtr;                /* Command to be deleted. */
{
    AfterInfo *prevPtr;
    if (firstAfterPtr == afterPtr) {
        firstAfterPtr = afterPtr->nextPtr;
    } else {
        for (prevPtr = firstAfterPtr; prevPtr->nextPtr != afterPtr;
                prevPtr = prevPtr->nextPtr) {
            /* Empty loop body. */
        }
        prevPtr->nextPtr = afterPtr->nextPtr;
    }
    ckfree(afterPtr->command);
    ckfree((char *) afterPtr);
}
\f
/*
 *----------------------------------------------------------------------
 *
 * Tk_FileeventCmd --
 *
 *      This procedure is invoked to process the "fileevent" Tcl
 *      command. See the user documentation for details on what it does.
 *      This command is based on Mark Diekhans' "addinput" command.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      See the user documentation.
 *
 *----------------------------------------------------------------------
 */

        /* ARGSUSED */
int
Tk_FileeventCmd(clientData, interp, argc, argv)
    ClientData clientData;      /* Main window associated with interpreter.
                                 * Not used.*/
    Tcl_Interp *interp;         /* Current interpreter. */
    int argc;                   /* Number of arguments. */
    char **argv;                /* Argument strings. */
{
    FILE *f;
    int index, fd, c;
    size_t length;
    FileEvent *fevPtr, *prevPtr;

    /*
     * Parse arguments.
     */

    if ((argc != 3) && (argc != 4)) {
        Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0],
                " fileId event ?script?", (char *) NULL);
        return TCL_ERROR;
    }
    c = argv[2][0];
    length = strlen(argv[2]);
    if ((c == 'r') && (strncmp(argv[2], "readable", length) == 0)) {
        index = 0;
    } else if ((c == 'w') && (strncmp(argv[2], "writable", length) == 0)) {
        index = 1;
    } else {
        Tcl_AppendResult(interp, "bad event name \"", argv[2],
                "\": must be readable or writable", (char *) NULL);
        return TCL_ERROR;
    }
    if (Tcl_GetOpenFile(interp, argv[1], index, 1, &f) != TCL_OK) {
        return TCL_ERROR;
    }
    fd = fileno(f);

    /*
     * Locate an existing file handler for this file, if one exists,
     * and make a new one if none currently exists.
     */

    for (fevPtr = firstFileEventPtr; ; fevPtr = fevPtr->nextPtr) {
        if (fevPtr == NULL) {
            if ((argc == 3) || (argv[3][0] == 0)) {
                return TCL_OK;
            }
            fevPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
            fevPtr->f = f;
            fevPtr->interps[0] = NULL;
            fevPtr->interps[1] = NULL;
            fevPtr->scripts[0] = NULL;
            fevPtr->scripts[1] = NULL;
            fevPtr->nextPtr = firstFileEventPtr;
            firstFileEventPtr = fevPtr;
            Tk_CreateFileHandler2(fileno(f), FileEventProc,
                    (ClientData) fevPtr);
            tcl_FileCloseProc = DeleteFileEvent;
            break;
        }
        if (fevPtr->f == f) {
            break;
        }
    }

    /*
     * If we're just supposed to return the current script, do so.
     */

    if (argc == 3) {
        if (fevPtr->scripts[index] != NULL) {
            interp->result = fevPtr->scripts[index];
        }
        return TCL_OK;
    }

    /*
     * If we're supposed to delete the event handler, do so.
     */

    if (argv[3][0] == 0) {
        if (fevPtr->scripts[index] != NULL) {
            fevPtr->interps[index] = NULL;
            ckfree(fevPtr->scripts[index]);
            fevPtr->scripts[index] = NULL;
        }
        if ((fevPtr->scripts[0] == NULL) && (fevPtr->scripts[1] == NULL)) {
            if (firstFileEventPtr == fevPtr) {
                firstFileEventPtr = fevPtr->nextPtr;
            } else {
                for (prevPtr = firstFileEventPtr; prevPtr->nextPtr != fevPtr;
                        prevPtr = prevPtr->nextPtr) {
                    /* Empty loop body. */
                }
                prevPtr->nextPtr = fevPtr->nextPtr;
            }
            Tk_DeleteFileHandler(fileno(fevPtr->f));
            ckfree((char *) fevPtr);
        }
        return TCL_OK;
    }

    /*
     * This is a new handler being created.  Save its script.
     */

    fevPtr->interps[index] = interp;
    if (fevPtr->scripts[index] != NULL) {
        ckfree(fevPtr->scripts[index]);
    }
    fevPtr->scripts[index] = ckalloc((unsigned) (strlen(argv[3]) + 1));
    strcpy(fevPtr->scripts[index], argv[3]);
    return TCL_OK;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * FileEventProc --
 *
 *      This procedure is invoked by Tk's event loop to deal with file
 *      event bindings created by the "fileevent" command.
 *
 * Results:
 *      The return value is TK_FILE_HANDLED if the file was ready and
 *      a script was invoked to handle it.  Otherwise an OR-ed combination
 *      of TK_READABLE and TK_WRITABLE is returned, indicating the events
 *      that should be checked in future calls to select.
 *
 * Side effects:
 *      Whatever the event script does.
 *
 *----------------------------------------------------------------------
 */

static int
FileEventProc(clientData, mask, flags)
    ClientData clientData;      /* Pointer to FileEvent structure for file. */
    int mask;                   /* OR-ed combination of the bits TK_READABLE,
                                 * TK_WRITABLE, and TK_EXCEPTION, indicating
                                 * current state of file. */
    int flags;                  /* Flag bits passed to Tk_DoOneEvent;
                                 * contains bits such as TK_DONT_WAIT,
                                 * TK_X_EVENTS, Tk_FILE_EVENTS, etc. */
{
    FileEvent *fevPtr = (FileEvent *) clientData;
    Tcl_DString script;
    Tcl_Interp *interp;
    FILE *f;
    int code, checkMask;

    if (!(flags & TK_FILE_EVENTS)) {
        return 0;
    }

    /*
     * The code here is a little tricky, because the script for an
     * event could delete the event handler.  Thus, after we call
     * Tcl_GlobalEval we can't use fevPtr anymore.  We also have to
     * copy the script to make sure that it doesn't get freed while
     * being evaluated.
     */

    checkMask = 0;
    f = fevPtr->f;
    if (fevPtr->scripts[1] != NULL) {
        if (mask & TK_WRITABLE) {
            Tcl_DStringInit(&script);
            Tcl_DStringAppend(&script, fevPtr->scripts[1], -1);
            interp = fevPtr->interps[1];
            code = Tcl_GlobalEval(interp, Tcl_DStringValue(&script));
            Tcl_DStringFree(&script);
            if (code != TCL_OK) {
                goto error;
            }
            return TK_FILE_HANDLED;
        } else {
            checkMask |= TK_WRITABLE;
        }
    }
    if (fevPtr->scripts[0] != NULL) {
        if ((mask & TK_READABLE) || TK_READ_DATA_PENDING(f)) {
            Tcl_DStringInit(&script);
            Tcl_DStringAppend(&script, fevPtr->scripts[0], -1);
            interp = fevPtr->interps[0];
            code = Tcl_GlobalEval(interp, Tcl_DStringValue(&script));
            Tcl_DStringFree(&script);
            if (code != TCL_OK) {
                goto error;
            }
            return TK_FILE_HANDLED;
        } else {
            checkMask |= TK_READABLE;
        }
    }
    return checkMask;

    /*
     * An error occurred in the script, so we have to call
     * Tk_BackgroundError.  However, it's possible that the file ready
     * condition didn't get cleared for the file, so we could end
     * up in an infinite loop if we're not careful.  To be safe,
     * delete the event handler.
     */

    error:
    DeleteFileEvent(f);
    Tcl_AddErrorInfo(interp,
            "\n    (script bound to file event - binding deleted)");
    Tk_BackgroundError(interp);
    return TK_FILE_HANDLED;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * DeleteFileEvent --
 *
 *      This procedure is invoked to delete all file event handlers
 *      for a file.  For example, this is necessary if a file is closed,
 *      or if an error occurs in a handler for a file.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The file event handler is removed, so it will never be invoked
 *      again.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteFileEvent(f)
    FILE *f;                    /* Stdio structure describing open file. */
{
    register FileEvent *fevPtr;
    FileEvent *prevPtr;

    /*
     * See if there exists a file handler for the given file.
     */

    for (prevPtr = NULL, fevPtr = firstFileEventPtr; ;
            prevPtr = fevPtr, fevPtr = fevPtr->nextPtr) {
        if (fevPtr == NULL) {
            return;
        }
        if (fevPtr->f == f) {
            break;
        }
    }

    /*
     * Unlink it from the list, then free it.
     */

    if (prevPtr == NULL) {
        firstFileEventPtr = fevPtr->nextPtr;
    } else {
        prevPtr->nextPtr = fevPtr->nextPtr;
    }
    Tk_DeleteFileHandler(fileno(fevPtr->f));
    if (fevPtr->scripts[0] != NULL) {
        ckfree(fevPtr->scripts[0]);
    }
    if (fevPtr->scripts[1] != NULL) {
        ckfree(fevPtr->scripts[1]);
    }
    ckfree((char *) fevPtr);
}
\f
/*
 *----------------------------------------------------------------------
 *
 * TkEventCleanupProc --
 *
 *      This procedure is invoked whenever an interpreter is deleted.
 *      It deletes any file events and after commands that refer to
 *      that interpreter.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      File event handlers and after commands are removed.
 *
 *----------------------------------------------------------------------
 */

        /* ARGSUSED */
void
TkEventCleanupProc(clientData, interp)
    ClientData clientData;      /* Not used. */
    Tcl_Interp *interp;         /* Interpreter that is being deleted. */
{
    FileEvent *fevPtr, *prevPtr, *nextPtr;
    AfterInfo *afterPtr, *prevAfterPtr, *nextAfterPtr;
    int i;

    prevPtr = NULL;
    fevPtr = firstFileEventPtr;
    while (fevPtr != NULL) {
        for (i = 0; i < 2; i++) {
            if (fevPtr->interps[i] == interp) {
                fevPtr->interps[i] = NULL;
                ckfree((char *) fevPtr->scripts[i]);
                fevPtr->scripts[i] = NULL;
            }
        }
        if ((fevPtr->scripts[0] != NULL) || (fevPtr->scripts[1] != NULL)) {
            prevPtr = fevPtr;
            fevPtr = fevPtr->nextPtr;
            continue;
        }
        nextPtr = fevPtr->nextPtr;
        if (prevPtr == NULL) {
            firstFileEventPtr = nextPtr;
        } else {
            prevPtr->nextPtr = nextPtr;
        }
        Tk_DeleteFileHandler(fileno(fevPtr->f));
        ckfree((char *) fevPtr);
        fevPtr = nextPtr;
    }

    prevAfterPtr = NULL;
    afterPtr = firstAfterPtr;
    while (afterPtr != NULL) {
        if (afterPtr->interp != interp) {
            prevAfterPtr = afterPtr;
            afterPtr = afterPtr->nextPtr;
            continue;
        }
        nextAfterPtr = afterPtr->nextPtr;
        if (prevAfterPtr == NULL) {
            firstAfterPtr = nextAfterPtr;
        } else {
            prevAfterPtr->nextPtr = nextAfterPtr;
        }
        if (afterPtr->token != NULL) {
            Tk_DeleteTimerHandler(afterPtr->token);
        } else {
            Tk_CancelIdleCall(AfterProc, (ClientData) afterPtr);
        }
        ckfree(afterPtr->command);
        ckfree((char *) afterPtr);
        afterPtr = nextAfterPtr;
    }
}
\f
/*
 *----------------------------------------------------------------------
 *
 * TkwaitCmd2 --
 *
 *      This procedure is invoked to process the "tkwait" Tcl command.
 *      See the user documentation for details on what it does.  This
 *      is a modified version of tkwait with only the "variable"
 *      option, suitable for use in stand-alone mode without the rest
 *      of Tk.  It's only used when Tk_EventInit has been called.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      See the user documentation.
 *
 *----------------------------------------------------------------------
 */

        /* ARGSUSED */
static int
TkwaitCmd2(clientData, interp, argc, argv)
    ClientData clientData;      /* Not used. */
    Tcl_Interp *interp;         /* Current interpreter. */
    int argc;                   /* Number of arguments. */
    char **argv;                /* Argument strings. */
{
    int c, done;
    size_t length;

    if (argc != 3) {
        Tcl_AppendResult(interp, "wrong # args: should be \"",
                argv[0], " variable name\"", (char *) NULL);
        return TCL_ERROR;
    }
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 'v') && (strncmp(argv[1], "variable", length) == 0)
            && (length >= 2)) {
        Tcl_TraceVar(interp, argv[2],
                TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
                WaitVariableProc2, (ClientData) &done);
        done = 0;
        while (!done) {
            Tk_DoOneEvent(0);
        }
        Tcl_UntraceVar(interp, argv[2],
                TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
                WaitVariableProc2, (ClientData) &done);
    } else {
        Tcl_AppendResult(interp, "bad option \"", argv[1],
                "\": must be variable", (char *) NULL);
        return TCL_ERROR;
    }

    /*
     * Clear out the interpreter's result, since it may have been set
     * by event handlers.
     */

    Tcl_ResetResult(interp);
    return TCL_OK;
}

        /* ARGSUSED */
static char *
WaitVariableProc2(clientData, interp, name1, name2, flags)
    ClientData clientData;      /* Pointer to integer to set to 1. */
    Tcl_Interp *interp;         /* Interpreter containing variable. */
    char *name1;                /* Name of variable. */
    char *name2;                /* Second part of variable name. */
    int flags;                  /* Information about what happened. */
{
    int *donePtr = (int *) clientData;

    *donePtr = 1;
    return (char *) NULL;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * UpdateCmd2 --
 *
 *      This procedure is invoked to process the "update" Tcl command.
 *      See the user documentation for details on what it does.  This
 *      is a modified version of the command that doesn't deal with
 *      windows, suitable for use in stand-alone mode without the rest
 *      of Tk.  It's only used when Tk_EventInit has been called.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      See the user documentation.
 *
 *----------------------------------------------------------------------
 */

        /* ARGSUSED */
static int
UpdateCmd2(clientData, interp, argc, argv)
    ClientData clientData;      /* Not used. */
    Tcl_Interp *interp;         /* Current interpreter. */
    int argc;                   /* Number of arguments. */
    char **argv;                /* Argument strings. */
{
    int flags;

    if (argc == 1) {
        flags = TK_DONT_WAIT|TK_FILE_EVENTS|TK_TIMER_EVENTS|TK_IDLE_EVENTS;
    } else if (argc == 2) {
        if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) {
            Tcl_AppendResult(interp, "bad argument \"", argv[1],
                    "\": must be idletasks", (char *) NULL);
            return TCL_ERROR;
        }
        flags = TK_IDLE_EVENTS;
    } else {
        Tcl_AppendResult(interp, "wrong # args: should be \"",
                argv[0], " ?idletasks?\"", (char *) NULL);
        return TCL_ERROR;
    }

    /*
     * Handle all pending events.
     */

    while (Tk_DoOneEvent(flags) != 0) {
        /* Empty loop body */
    }

    /*
     * Must clear the interpreter's result because event handlers could
     * have executed commands.
     */

    Tcl_ResetResult(interp);
    return TCL_OK;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * Tk_EventInit --
 *
 *      This procedure is invoked from Tcl_AppInit if the Tk event stuff
 *      is being used by itself (without the rest of Tk) in an application.
 *      It creates the "after" and "fileevent" commands.
 *
 * Results:
 *      Always returns TCL_OK.
 *
 * Side effects:
 *      New commands get added to interp.
 *
 *----------------------------------------------------------------------
 */

int
Tk_EventInit(interp)
    Tcl_Interp *interp;         /* Interpreter in which to set up
                                 * event-handling. */
{
    Tcl_CreateCommand(interp, "after", Tk_AfterCmd, (ClientData) NULL,
            (void (*)()) NULL);
    Tcl_CreateCommand(interp, "fileevent", Tk_FileeventCmd, (ClientData) NULL,
            (void (*)()) NULL);
    Tcl_CreateCommand(interp, "tkwait", TkwaitCmd2, (ClientData) NULL,
            (void (*)()) NULL);
    Tcl_CreateCommand(interp, "update", UpdateCmd2, (ClientData) NULL,
            (void (*)()) NULL);
    Tcl_CallWhenDeleted(interp, TkEventCleanupProc, (ClientData) NULL);
    return TCL_OK;
}

#endif /* TCL_MINOR_VERSION == 7 && TCL_MINOR_VERSION <= 4 */