/[dtapublic]/projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tcltimer.c
ViewVC logotype

Diff of /projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tcltimer.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

to_be_filed/sf_code/esrgpcpj/shared/tcl_base/tcltimer.c revision 29 by dashley, Sat Oct 8 07:08:47 2016 UTC projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tcltimer.c revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tcltimer.c,v 1.1.1.1 2001/06/13 04:46:38 dtashley Exp $ */  
   
 /*  
  * tclTimer.c --  
  *  
  *      This file provides timer event management facilities for Tcl,  
  *      including the "after" command.  
  *  
  * Copyright (c) 1997 by Sun Microsystems, Inc.  
  *  
  * See the file "license.terms" for information on usage and redistribution  
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.  
  *  
  * RCS: @(#) $Id: tcltimer.c,v 1.1.1.1 2001/06/13 04:46:38 dtashley Exp $  
  */  
   
 #include "tclInt.h"  
 #include "tclPort.h"  
   
 /*  
  * For each timer callback that's pending there is one record of the following  
  * type.  The normal handlers (created by Tcl_CreateTimerHandler) are chained  
  * together in a list sorted by time (earliest event first).  
  */  
   
 typedef struct TimerHandler {  
     Tcl_Time time;                      /* When timer is to fire. */  
     Tcl_TimerProc *proc;                /* Procedure to call. */  
     ClientData clientData;              /* Argument to pass to proc. */  
     Tcl_TimerToken token;               /* Identifies handler so it can be  
                                          * deleted. */  
     struct TimerHandler *nextPtr;       /* Next event in queue, or NULL for  
                                          * end of queue. */  
 } TimerHandler;  
   
 /*  
  * The data structure below is used by the "after" command to remember  
  * the command to be executed later.  All of the pending "after" commands  
  * for an interpreter are linked together in a list.  
  */  
   
 typedef struct AfterInfo {  
     struct AfterAssocData *assocPtr;  
                                 /* Pointer to the "tclAfter" assocData for  
                                  * the interp in which command will be  
                                  * executed. */  
     Tcl_Obj *commandPtr;        /* Command to execute. */  
     int id;                     /* Integer identifier for command;  used to  
                                  * cancel it. */  
     Tcl_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.  NULL means this is an "after  
                                  * idle" handler rather than a  
                                  * timer handler. */  
     struct AfterInfo *nextPtr;  /* Next in list of all "after" commands for  
                                  * this interpreter. */  
 } AfterInfo;  
   
 /*  
  * One of the following structures is associated with each interpreter  
  * for which an "after" command has ever been invoked.  A pointer to  
  * this structure is stored in the AssocData for the "tclAfter" key.  
  */  
   
 typedef struct AfterAssocData {  
     Tcl_Interp *interp;         /* The interpreter for which this data is  
                                  * registered. */  
     AfterInfo *firstAfterPtr;   /* First in list of all "after" commands  
                                  * still pending for this interpreter, or  
                                  * NULL if none. */  
 } AfterAssocData;  
   
 /*  
  * There is one of the following structures for each of the  
  * handlers declared in a call to Tcl_DoWhenIdle.  All of the  
  * currently-active handlers are linked together into a list.  
  */  
   
 typedef struct IdleHandler {  
     Tcl_IdleProc (*proc);       /* 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;  
   
 /*  
  * The timer and idle queues are per-thread because they are associated  
  * with the notifier, which is also per-thread.  
  *  
  * All static variables used in this file are collected into a single  
  * instance of the following structure.  For multi-threaded implementations,  
  * there is one instance of this structure for each thread.  
  *  
  * Notice that different structures with the same name appear in other  
  * files.  The structure defined below is used in this file only.  
  */  
   
 typedef struct ThreadSpecificData {  
     TimerHandler *firstTimerHandlerPtr; /* First event in queue. */  
     int lastTimerId;            /* Timer identifier of most recently  
                                  * created timer. */  
     int timerPending;           /* 1 if a timer event is in the queue. */  
     IdleHandler *idleList;      /* First in list of all idle handlers. */  
     IdleHandler *lastIdlePtr;   /* Last in list (or NULL for empty list). */  
     int idleGeneration;         /* Used to fill in the "generation" fields  
                                  * of IdleHandler structures.  Increments  
                                  * each time Tcl_DoOneEvent starts calling  
                                  * idle handlers, so that all old handlers  
                                  * can be called without calling any of the  
                                  * new ones created by old ones. */  
     int afterId;                /* For unique identifiers of after events. */  
 } ThreadSpecificData;  
   
 static Tcl_ThreadDataKey dataKey;  
   
 /*  
  * Prototypes for procedures referenced only in this file:  
  */  
   
 static void             AfterCleanupProc _ANSI_ARGS_((ClientData clientData,  
                             Tcl_Interp *interp));  
 static void             AfterProc _ANSI_ARGS_((ClientData clientData));  
 static void             FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr));  
 static AfterInfo *      GetAfterEvent _ANSI_ARGS_((AfterAssocData *assocPtr,  
                             Tcl_Obj *commandPtr));  
 static ThreadSpecificData *InitTimer _ANSI_ARGS_((void));  
 static void             TimerExitProc _ANSI_ARGS_((ClientData clientData));  
 static int              TimerHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,  
                             int flags));  
 static void             TimerCheckProc _ANSI_ARGS_((ClientData clientData,  
                             int flags));  
 static void             TimerSetupProc _ANSI_ARGS_((ClientData clientData,  
                             int flags));  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * InitTimer --  
  *  
  *      This function initializes the timer module.  
  *  
  * Results:  
  *      A pointer to the thread specific data.  
  *  
  * Side effects:  
  *      Registers the idle and timer event sources.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static ThreadSpecificData *  
 InitTimer()  
 {  
     ThreadSpecificData *tsdPtr =  
         (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);  
   
     if (tsdPtr == NULL) {  
         tsdPtr = TCL_TSD_INIT(&dataKey);  
         Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL);  
         Tcl_CreateThreadExitHandler(TimerExitProc, NULL);  
     }  
     return tsdPtr;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TimerExitProc --  
  *  
  *      This function is call at exit or unload time to remove the  
  *      timer and idle event sources.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Removes the timer and idle event sources.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 TimerExitProc(clientData)  
     ClientData clientData;      /* Not used. */  
 {  
     Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * Tcl_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.  
  *  
  *--------------------------------------------------------------  
  */  
   
 Tcl_TimerToken  
 Tcl_CreateTimerHandler(milliseconds, proc, clientData)  
     int milliseconds;           /* How many milliseconds to wait  
                                  * before invoking proc. */  
     Tcl_TimerProc *proc;        /* Procedure to invoke. */  
     ClientData clientData;      /* Arbitrary data to pass to proc. */  
 {  
     register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;  
     Tcl_Time time;  
     ThreadSpecificData *tsdPtr;  
   
     tsdPtr = InitTimer();  
   
     timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler));  
   
     /*  
      * Compute when the event should fire.  
      */  
   
     TclpGetTime(&time);  
     timerHandlerPtr->time.sec = time.sec + milliseconds/1000;  
     timerHandlerPtr->time.usec = time.usec + (milliseconds%1000)*1000;  
     if (timerHandlerPtr->time.usec >= 1000000) {  
         timerHandlerPtr->time.usec -= 1000000;  
         timerHandlerPtr->time.sec += 1;  
     }  
   
     /*  
      * Fill in other fields for the event.  
      */  
   
     timerHandlerPtr->proc = proc;  
     timerHandlerPtr->clientData = clientData;  
     tsdPtr->lastTimerId++;  
     timerHandlerPtr->token = (Tcl_TimerToken) tsdPtr->lastTimerId;  
   
     /*  
      * Add the event to the queue in the correct position  
      * (ordered by event firing time).  
      */  
   
     for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;  
             prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) {  
         if ((tPtr2->time.sec > timerHandlerPtr->time.sec)  
                 || ((tPtr2->time.sec == timerHandlerPtr->time.sec)  
                 && (tPtr2->time.usec > timerHandlerPtr->time.usec))) {  
             break;  
         }  
     }  
     timerHandlerPtr->nextPtr = tPtr2;  
     if (prevPtr == NULL) {  
         tsdPtr->firstTimerHandlerPtr = timerHandlerPtr;  
     } else {  
         prevPtr->nextPtr = timerHandlerPtr;  
     }  
   
     TimerSetupProc(NULL, TCL_ALL_EVENTS);  
   
     return timerHandlerPtr->token;  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * Tcl_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  
 Tcl_DeleteTimerHandler(token)  
     Tcl_TimerToken token;       /* Result previously returned by  
                                  * Tcl_DeleteTimerHandler. */  
 {  
     register TimerHandler *timerHandlerPtr, *prevPtr;  
     ThreadSpecificData *tsdPtr;  
   
     tsdPtr = InitTimer();  
     for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL;  
             timerHandlerPtr != NULL; prevPtr = timerHandlerPtr,  
             timerHandlerPtr = timerHandlerPtr->nextPtr) {  
         if (timerHandlerPtr->token != token) {  
             continue;  
         }  
         if (prevPtr == NULL) {  
             tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;  
         } else {  
             prevPtr->nextPtr = timerHandlerPtr->nextPtr;  
         }  
         ckfree((char *) timerHandlerPtr);  
         return;  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TimerSetupProc --  
  *  
  *      This function is called by Tcl_DoOneEvent to setup the timer  
  *      event source for before blocking.  This routine checks both the  
  *      idle and after timer lists.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      May update the maximum notifier block time.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 TimerSetupProc(data, flags)  
     ClientData data;            /* Not used. */  
     int flags;                  /* Event flags as passed to Tcl_DoOneEvent. */  
 {  
     Tcl_Time blockTime;  
     ThreadSpecificData *tsdPtr = InitTimer();  
   
     if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList)  
             || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) {  
         /*  
          * There is an idle handler or a pending timer event, so just poll.  
          */  
   
         blockTime.sec = 0;  
         blockTime.usec = 0;  
   
     } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {  
         /*  
          * Compute the timeout for the next timer on the list.  
          */  
   
         TclpGetTime(&blockTime);  
         blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;  
         blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -  
                 blockTime.usec;  
         if (blockTime.usec < 0) {  
             blockTime.sec -= 1;  
             blockTime.usec += 1000000;  
         }  
         if (blockTime.sec < 0) {  
             blockTime.sec = 0;  
             blockTime.usec = 0;  
         }  
     } else {  
         return;  
     }  
           
     Tcl_SetMaxBlockTime(&blockTime);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TimerCheckProc --  
  *  
  *      This function is called by Tcl_DoOneEvent to check the timer  
  *      event source for events.  This routine checks both the  
  *      idle and after timer lists.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      May queue an event and update the maximum notifier block time.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 TimerCheckProc(data, flags)  
     ClientData data;            /* Not used. */  
     int flags;                  /* Event flags as passed to Tcl_DoOneEvent. */  
 {  
     Tcl_Event *timerEvPtr;  
     Tcl_Time blockTime;  
     ThreadSpecificData *tsdPtr = InitTimer();  
   
     if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {  
         /*  
          * Compute the timeout for the next timer on the list.  
          */  
   
         TclpGetTime(&blockTime);  
         blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;  
         blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -  
                 blockTime.usec;  
         if (blockTime.usec < 0) {  
             blockTime.sec -= 1;  
             blockTime.usec += 1000000;  
         }  
         if (blockTime.sec < 0) {  
             blockTime.sec = 0;  
             blockTime.usec = 0;  
         }  
   
         /*  
          * If the first timer has expired, stick an event on the queue.  
          */  
   
         if (blockTime.sec == 0 && blockTime.usec == 0 &&  
                 !tsdPtr->timerPending) {  
             tsdPtr->timerPending = 1;  
             timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event));  
             timerEvPtr->proc = TimerHandlerEventProc;  
             Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);  
         }  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TimerHandlerEventProc --  
  *  
  *      This procedure is called by Tcl_ServiceEvent when a timer event  
  *      reaches the front of the event queue.  This procedure handles  
  *      the event by invoking the callbacks for all timers that are  
  *      ready.  
  *  
  * Results:  
  *      Returns 1 if the event was handled, meaning it should be removed  
  *      from the queue.  Returns 0 if the event was not handled, meaning  
  *      it should stay on the queue.  The only time the event isn't  
  *      handled is if the TCL_TIMER_EVENTS flag bit isn't set.  
  *  
  * Side effects:  
  *      Whatever the timer handler callback procedures do.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 TimerHandlerEventProc(evPtr, flags)  
     Tcl_Event *evPtr;           /* Event to service. */  
     int flags;                  /* Flags that indicate what events to  
                                  * handle, such as TCL_FILE_EVENTS. */  
 {  
     TimerHandler *timerHandlerPtr, **nextPtrPtr;  
     Tcl_Time time;  
     int currentTimerId;  
     ThreadSpecificData *tsdPtr = InitTimer();  
   
     /*  
      * Do nothing if timers aren't enabled.  This leaves the event on the  
      * queue, so we will get to it as soon as ServiceEvents() is called  
      * with timers enabled.  
      */  
   
     if (!(flags & TCL_TIMER_EVENTS)) {  
         return 0;  
     }  
   
     /*  
      * 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 to avoid  
      *    starving other event sources.  This is implemented using the  
      *    token number in the handler:  new handlers will have a  
      *    newer token than any of the ones currently on the list.  
      * 2. The handler can call Tcl_DoOneEvent, so we have to remove  
      *    the handler from the list before calling it. Otherwise an  
      *    infinite loop could result.  
      * 3. Tcl_DeleteTimerHandler can be called to remove an element from  
      *    the list while a handler is executing, so the list could  
      *    change structure during the call.  
      * 4. Because we only fetch the current time before entering the loop,  
      *    the only way a new timer will even be considered runnable is if  
      *    its expiration time is within the same millisecond as the  
      *    current time.  This is fairly likely on Windows, since it has  
      *    a course granularity clock.  Since timers are placed  
      *    on the queue in time order with the most recently created  
      *    handler appearing after earlier ones with the same expiration  
      *    time, we don't have to worry about newer generation timers  
      *    appearing before later ones.  
      */  
   
     tsdPtr->timerPending = 0;  
     currentTimerId = tsdPtr->lastTimerId;  
     TclpGetTime(&time);  
     while (1) {  
         nextPtrPtr = &tsdPtr->firstTimerHandlerPtr;  
         timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;  
         if (timerHandlerPtr == NULL) {  
             break;  
         }  
               
         if ((timerHandlerPtr->time.sec > time.sec)  
                 || ((timerHandlerPtr->time.sec == time.sec)  
                         && (timerHandlerPtr->time.usec > time.usec))) {  
             break;  
         }  
   
         /*  
          * Bail out if the next timer is of a newer generation.  
          */  
   
         if ((currentTimerId - (int)timerHandlerPtr->token) < 0) {  
             break;  
         }  
   
         /*  
          * Remove the handler from the queue before invoking it,  
          * to avoid potential reentrancy problems.  
          */  
   
         (*nextPtrPtr) = timerHandlerPtr->nextPtr;  
         (*timerHandlerPtr->proc)(timerHandlerPtr->clientData);  
         ckfree((char *) timerHandlerPtr);  
     }  
     TimerSetupProc(NULL, TCL_TIMER_EVENTS);  
     return 1;  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * Tcl_DoWhenIdle --  
  *  
  *      Arrange for proc to be invoked the next time the system is  
  *      idle (i.e., just before the next time that Tcl_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  
 Tcl_DoWhenIdle(proc, clientData)  
     Tcl_IdleProc *proc;         /* Procedure to invoke. */  
     ClientData clientData;      /* Arbitrary value to pass to proc. */  
 {  
     register IdleHandler *idlePtr;  
     Tcl_Time blockTime;  
     ThreadSpecificData *tsdPtr = InitTimer();  
   
     idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));  
     idlePtr->proc = proc;  
     idlePtr->clientData = clientData;  
     idlePtr->generation = tsdPtr->idleGeneration;  
     idlePtr->nextPtr = NULL;  
     if (tsdPtr->lastIdlePtr == NULL) {  
         tsdPtr->idleList = idlePtr;  
     } else {  
         tsdPtr->lastIdlePtr->nextPtr = idlePtr;  
     }  
     tsdPtr->lastIdlePtr = idlePtr;  
   
     blockTime.sec = 0;  
     blockTime.usec = 0;  
     Tcl_SetMaxBlockTime(&blockTime);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_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  
 Tcl_CancelIdleCall(proc, clientData)  
     Tcl_IdleProc *proc;         /* Procedure that was previously registered. */  
     ClientData clientData;      /* Arbitrary value to pass to proc. */  
 {  
     register IdleHandler *idlePtr, *prevPtr;  
     IdleHandler *nextPtr;  
     ThreadSpecificData *tsdPtr = InitTimer();  
   
     for (prevPtr = NULL, idlePtr = tsdPtr->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) {  
                 tsdPtr->idleList = idlePtr;  
             } else {  
                 prevPtr->nextPtr = idlePtr;  
             }  
             if (idlePtr == NULL) {  
                 tsdPtr->lastIdlePtr = prevPtr;  
                 return;  
             }  
         }  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclServiceIdle --  
  *  
  *      This procedure is invoked by the notifier when it becomes  
  *      idle.  It will invoke all idle handlers that are present at  
  *      the time the call is invoked, but not those added during idle  
  *      processing.  
  *  
  * Results:  
  *      The return value is 1 if TclServiceIdle found something to  
  *      do, otherwise return value is 0.  
  *  
  * Side effects:  
  *      Invokes all pending idle handlers.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclServiceIdle()  
 {  
     IdleHandler *idlePtr;  
     int oldGeneration;  
     Tcl_Time blockTime;  
     ThreadSpecificData *tsdPtr = InitTimer();  
   
     if (tsdPtr->idleList == NULL) {  
         return 0;  
     }  
   
     oldGeneration = tsdPtr->idleGeneration;  
     tsdPtr->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 Tcl_DoOneEvent, so we have to remove  
      *    the handler from the list before calling it. Otherwise an  
      *    infinite loop could result.  
      * 3. Tcl_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 = tsdPtr->idleList;  
             ((idlePtr != NULL)  
                     && ((oldGeneration - idlePtr->generation) >= 0));  
             idlePtr = tsdPtr->idleList) {  
         tsdPtr->idleList = idlePtr->nextPtr;  
         if (tsdPtr->idleList == NULL) {  
             tsdPtr->lastIdlePtr = NULL;  
         }  
         (*idlePtr->proc)(idlePtr->clientData);  
         ckfree((char *) idlePtr);  
     }  
     if (tsdPtr->idleList) {  
         blockTime.sec = 0;  
         blockTime.usec = 0;  
         Tcl_SetMaxBlockTime(&blockTime);  
     }  
     return 1;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_AfterObjCmd --  
  *  
  *      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  
 Tcl_AfterObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;      /* Points to the "tclAfter" assocData for  
                                  * this interpreter, or NULL if the assocData  
                                  * hasn't been created yet.*/  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
 {  
     int ms;  
     AfterInfo *afterPtr;  
     AfterAssocData *assocPtr = (AfterAssocData *) clientData;  
     Tcl_CmdInfo cmdInfo;  
     int length;  
     char *argString;  
     int index;  
     char buf[16 + TCL_INTEGER_SPACE];  
     static char *afterSubCmds[] = {"cancel", "idle", "info", (char *) NULL};  
     enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};  
     ThreadSpecificData *tsdPtr = InitTimer();  
   
     if (objc < 2) {  
         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");  
         return TCL_ERROR;  
     }  
   
     /*  
      * Create the "after" information associated for this interpreter,  
      * if it doesn't already exist.  Associate it with the command too,  
      * so that it will be passed in as the ClientData argument in the  
      * future.  
      */  
   
     if (assocPtr == NULL) {  
         assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData));  
         assocPtr->interp = interp;  
         assocPtr->firstAfterPtr = NULL;  
         Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc,  
                 (ClientData) assocPtr);  
         cmdInfo.proc = NULL;  
         cmdInfo.clientData = (ClientData) NULL;  
         cmdInfo.objProc = Tcl_AfterObjCmd;  
         cmdInfo.objClientData = (ClientData) assocPtr;  
         cmdInfo.deleteProc = NULL;  
         cmdInfo.deleteData = (ClientData) assocPtr;  
         Tcl_SetCommandInfo(interp, Tcl_GetStringFromObj(objv[0], &length),  
                 &cmdInfo);  
     }  
   
     /*  
      * First lets see if the command was passed a number as the first argument.  
      */  
   
     if (objv[1]->typePtr == &tclIntType) {  
         ms = (int) objv[1]->internalRep.longValue;  
         goto processInteger;  
     }  
     argString = Tcl_GetStringFromObj(objv[1], &length);  
     if (isdigit(UCHAR(argString[0]))) { /* INTL: digit */  
         if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) {  
             return TCL_ERROR;  
         }  
 processInteger:  
         if (ms < 0) {  
             ms = 0;  
         }  
         if (objc == 2) {  
             Tcl_Sleep(ms);  
             return TCL_OK;  
         }  
         afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));  
         afterPtr->assocPtr = assocPtr;  
         if (objc == 3) {  
             afterPtr->commandPtr = objv[2];  
         } else {  
             afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);  
         }  
         Tcl_IncrRefCount(afterPtr->commandPtr);  
         /*  
          * 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.  
          */  
         afterPtr->id = tsdPtr->afterId;  
         tsdPtr->afterId += 1;  
         afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc,  
                 (ClientData) afterPtr);  
         afterPtr->nextPtr = assocPtr->firstAfterPtr;  
         assocPtr->firstAfterPtr = afterPtr;  
         sprintf(buf, "after#%d", afterPtr->id);  
         Tcl_AppendResult(interp, buf, (char *) NULL);  
         return TCL_OK;  
     }  
   
     /*  
      * If it's not a number it must be a subcommand.  
      */  
   
     if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "argument",  
             0, &index) != TCL_OK) {  
         Tcl_AppendResult(interp, "bad argument \"", argString,  
                 "\": must be cancel, idle, info, or a number",  
                 (char *) NULL);  
         return TCL_ERROR;  
     }  
     switch ((enum afterSubCmds) index) {  
         case AFTER_CANCEL: {  
             Tcl_Obj *commandPtr;  
             char *command, *tempCommand;  
             int tempLength;  
   
             if (objc < 3) {  
                 Tcl_WrongNumArgs(interp, 2, objv, "id|command");  
                 return TCL_ERROR;  
             }  
             if (objc == 3) {  
                 commandPtr = objv[2];  
             } else {  
                 commandPtr = Tcl_ConcatObj(objc-2, objv+2);;  
             }  
             command = Tcl_GetStringFromObj(commandPtr, &length);  
             for (afterPtr = assocPtr->firstAfterPtr;  afterPtr != NULL;  
                     afterPtr = afterPtr->nextPtr) {  
                 tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,  
                         &tempLength);  
                 if ((length == tempLength)  
                         && (memcmp((void*) command, (void*) tempCommand,  
                                 (unsigned) length) == 0)) {  
                     break;  
                 }  
             }  
             if (afterPtr == NULL) {  
                 afterPtr = GetAfterEvent(assocPtr, commandPtr);  
             }  
             if (objc != 3) {  
                 Tcl_DecrRefCount(commandPtr);  
             }  
             if (afterPtr != NULL) {  
                 if (afterPtr->token != NULL) {  
                     Tcl_DeleteTimerHandler(afterPtr->token);  
                 } else {  
                     Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);  
                 }  
                 FreeAfterPtr(afterPtr);  
             }  
             break;  
         }  
         case AFTER_IDLE:  
             if (objc < 3) {  
                 Tcl_WrongNumArgs(interp, 2, objv, "script script ...");  
                 return TCL_ERROR;  
             }  
             afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));  
             afterPtr->assocPtr = assocPtr;  
             if (objc == 3) {  
                 afterPtr->commandPtr = objv[2];  
             } else {  
                 afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);  
             }  
             Tcl_IncrRefCount(afterPtr->commandPtr);  
             afterPtr->id = tsdPtr->afterId;  
             tsdPtr->afterId += 1;  
             afterPtr->token = NULL;  
             afterPtr->nextPtr = assocPtr->firstAfterPtr;  
             assocPtr->firstAfterPtr = afterPtr;  
             Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);  
             sprintf(buf, "after#%d", afterPtr->id);  
             Tcl_AppendResult(interp, buf, (char *) NULL);  
             break;  
         case AFTER_INFO: {  
             Tcl_Obj *resultListPtr;  
   
             if (objc == 2) {  
                 for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;  
                      afterPtr = afterPtr->nextPtr) {  
                     if (assocPtr->interp == interp) {  
                         sprintf(buf, "after#%d", afterPtr->id);  
                         Tcl_AppendElement(interp, buf);  
                     }  
                 }  
                 return TCL_OK;  
             }  
             if (objc != 3) {  
                 Tcl_WrongNumArgs(interp, 2, objv, "?id?");  
                 return TCL_ERROR;  
             }  
             afterPtr = GetAfterEvent(assocPtr, objv[2]);  
             if (afterPtr == NULL) {  
                 Tcl_AppendResult(interp, "event \"", Tcl_GetString(objv[2]),  
                         "\" doesn't exist", (char *) NULL);  
                 return TCL_ERROR;  
             }  
             resultListPtr = Tcl_GetObjResult(interp);  
             Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr);  
             Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(  
                 (afterPtr->token == NULL) ? "idle" : "timer", -1));  
             Tcl_SetObjResult(interp, resultListPtr);  
             break;  
         }  
         default: {  
             panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");  
         }  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * GetAfterEvent --  
  *  
  *      This procedure parses an "after" id such as "after#4" and  
  *      returns a pointer to the AfterInfo structure.  
  *  
  * Results:  
  *      The return value is either a pointer to an AfterInfo structure,  
  *      if one is found that corresponds to "cmdString" and is for interp,  
  *      or NULL if no corresponding after event can be found.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static AfterInfo *  
 GetAfterEvent(assocPtr, commandPtr)  
     AfterAssocData *assocPtr;   /* Points to "after"-related information for  
                                  * this interpreter. */  
     Tcl_Obj *commandPtr;  
 {  
     char *cmdString;            /* Textual identifier for after event, such  
                                  * as "after#6". */  
     AfterInfo *afterPtr;  
     int id;  
     char *end;  
   
     cmdString = Tcl_GetString(commandPtr);  
     if (strncmp(cmdString, "after#", 6) != 0) {  
         return NULL;  
     }  
     cmdString += 6;  
     id = strtoul(cmdString, &end, 10);  
     if ((end == cmdString) || (*end != 0)) {  
         return NULL;  
     }  
     for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;  
             afterPtr = afterPtr->nextPtr) {  
         if (afterPtr->id == id) {  
             return afterPtr;  
         }  
     }  
     return NULL;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * 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 "bgerror" is invoked  
  *      to process the error;  if bgerror fails then information  
  *      about the error is output on stderr.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 AfterProc(clientData)  
     ClientData clientData;      /* Describes command to execute. */  
 {  
     AfterInfo *afterPtr = (AfterInfo *) clientData;  
     AfterAssocData *assocPtr = afterPtr->assocPtr;  
     AfterInfo *prevPtr;  
     int result;  
     Tcl_Interp *interp;  
     char *script;  
     int numBytes;  
   
     /*  
      * 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 (assocPtr->firstAfterPtr == afterPtr) {  
         assocPtr->firstAfterPtr = afterPtr->nextPtr;  
     } else {  
         for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;  
                 prevPtr = prevPtr->nextPtr) {  
             /* Empty loop body. */  
         }  
         prevPtr->nextPtr = afterPtr->nextPtr;  
     }  
   
     /*  
      * Execute the callback.  
      */  
   
     interp = assocPtr->interp;  
     Tcl_Preserve((ClientData) interp);  
     script = Tcl_GetStringFromObj(afterPtr->commandPtr, &numBytes);  
     result = Tcl_EvalEx(interp, script, numBytes, TCL_EVAL_GLOBAL);  
     if (result != TCL_OK) {  
         Tcl_AddErrorInfo(interp, "\n    (\"after\" script)");  
         Tcl_BackgroundError(interp);  
     }  
     Tcl_Release((ClientData) interp);  
       
     /*  
      * Free the memory for the callback.  
      */  
   
     Tcl_DecrRefCount(afterPtr->commandPtr);  
     ckfree((char *) afterPtr);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * 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;  
     AfterAssocData *assocPtr = afterPtr->assocPtr;  
   
     if (assocPtr->firstAfterPtr == afterPtr) {  
         assocPtr->firstAfterPtr = afterPtr->nextPtr;  
     } else {  
         for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;  
                 prevPtr = prevPtr->nextPtr) {  
             /* Empty loop body. */  
         }  
         prevPtr->nextPtr = afterPtr->nextPtr;  
     }  
     Tcl_DecrRefCount(afterPtr->commandPtr);  
     ckfree((char *) afterPtr);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * AfterCleanupProc --  
  *  
  *      This procedure is invoked whenever an interpreter is deleted  
  *      to cleanup the AssocData for "tclAfter".  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      After commands are removed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
         /* ARGSUSED */  
 static void  
 AfterCleanupProc(clientData, interp)  
     ClientData clientData;      /* Points to AfterAssocData for the  
                                  * interpreter. */  
     Tcl_Interp *interp;         /* Interpreter that is being deleted. */  
 {  
     AfterAssocData *assocPtr = (AfterAssocData *) clientData;  
     AfterInfo *afterPtr;  
   
     while (assocPtr->firstAfterPtr != NULL) {  
         afterPtr = assocPtr->firstAfterPtr;  
         assocPtr->firstAfterPtr = afterPtr->nextPtr;  
         if (afterPtr->token != NULL) {  
             Tcl_DeleteTimerHandler(afterPtr->token);  
         } else {  
             Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);  
         }  
         Tcl_DecrRefCount(afterPtr->commandPtr);  
         ckfree((char *) afterPtr);  
     }  
     ckfree((char *) assocPtr);  
 }  
   
   
 /* $History: tcltimer.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 1:05a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLTIMER.C */  
1    /* $Header$ */
2    /*
3     * tclTimer.c --
4     *
5     *      This file provides timer event management facilities for Tcl,
6     *      including the "after" command.
7     *
8     * Copyright (c) 1997 by Sun Microsystems, Inc.
9     *
10     * See the file "license.terms" for information on usage and redistribution
11     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12     *
13     * RCS: @(#) $Id: tcltimer.c,v 1.1.1.1 2001/06/13 04:46:38 dtashley Exp $
14     */
15    
16    #include "tclInt.h"
17    #include "tclPort.h"
18    
19    /*
20     * For each timer callback that's pending there is one record of the following
21     * type.  The normal handlers (created by Tcl_CreateTimerHandler) are chained
22     * together in a list sorted by time (earliest event first).
23     */
24    
25    typedef struct TimerHandler {
26        Tcl_Time time;                      /* When timer is to fire. */
27        Tcl_TimerProc *proc;                /* Procedure to call. */
28        ClientData clientData;              /* Argument to pass to proc. */
29        Tcl_TimerToken token;               /* Identifies handler so it can be
30                                             * deleted. */
31        struct TimerHandler *nextPtr;       /* Next event in queue, or NULL for
32                                             * end of queue. */
33    } TimerHandler;
34    
35    /*
36     * The data structure below is used by the "after" command to remember
37     * the command to be executed later.  All of the pending "after" commands
38     * for an interpreter are linked together in a list.
39     */
40    
41    typedef struct AfterInfo {
42        struct AfterAssocData *assocPtr;
43                                    /* Pointer to the "tclAfter" assocData for
44                                     * the interp in which command will be
45                                     * executed. */
46        Tcl_Obj *commandPtr;        /* Command to execute. */
47        int id;                     /* Integer identifier for command;  used to
48                                     * cancel it. */
49        Tcl_TimerToken token;       /* Used to cancel the "after" command.  NULL
50                                     * means that the command is run as an
51                                     * idle handler rather than as a timer
52                                     * handler.  NULL means this is an "after
53                                     * idle" handler rather than a
54                                     * timer handler. */
55        struct AfterInfo *nextPtr;  /* Next in list of all "after" commands for
56                                     * this interpreter. */
57    } AfterInfo;
58    
59    /*
60     * One of the following structures is associated with each interpreter
61     * for which an "after" command has ever been invoked.  A pointer to
62     * this structure is stored in the AssocData for the "tclAfter" key.
63     */
64    
65    typedef struct AfterAssocData {
66        Tcl_Interp *interp;         /* The interpreter for which this data is
67                                     * registered. */
68        AfterInfo *firstAfterPtr;   /* First in list of all "after" commands
69                                     * still pending for this interpreter, or
70                                     * NULL if none. */
71    } AfterAssocData;
72    
73    /*
74     * There is one of the following structures for each of the
75     * handlers declared in a call to Tcl_DoWhenIdle.  All of the
76     * currently-active handlers are linked together into a list.
77     */
78    
79    typedef struct IdleHandler {
80        Tcl_IdleProc (*proc);       /* Procedure to call. */
81        ClientData clientData;      /* Value to pass to proc. */
82        int generation;             /* Used to distinguish older handlers from
83                                     * recently-created ones. */
84        struct IdleHandler *nextPtr;/* Next in list of active handlers. */
85    } IdleHandler;
86    
87    /*
88     * The timer and idle queues are per-thread because they are associated
89     * with the notifier, which is also per-thread.
90     *
91     * All static variables used in this file are collected into a single
92     * instance of the following structure.  For multi-threaded implementations,
93     * there is one instance of this structure for each thread.
94     *
95     * Notice that different structures with the same name appear in other
96     * files.  The structure defined below is used in this file only.
97     */
98    
99    typedef struct ThreadSpecificData {
100        TimerHandler *firstTimerHandlerPtr; /* First event in queue. */
101        int lastTimerId;            /* Timer identifier of most recently
102                                     * created timer. */
103        int timerPending;           /* 1 if a timer event is in the queue. */
104        IdleHandler *idleList;      /* First in list of all idle handlers. */
105        IdleHandler *lastIdlePtr;   /* Last in list (or NULL for empty list). */
106        int idleGeneration;         /* Used to fill in the "generation" fields
107                                     * of IdleHandler structures.  Increments
108                                     * each time Tcl_DoOneEvent starts calling
109                                     * idle handlers, so that all old handlers
110                                     * can be called without calling any of the
111                                     * new ones created by old ones. */
112        int afterId;                /* For unique identifiers of after events. */
113    } ThreadSpecificData;
114    
115    static Tcl_ThreadDataKey dataKey;
116    
117    /*
118     * Prototypes for procedures referenced only in this file:
119     */
120    
121    static void             AfterCleanupProc _ANSI_ARGS_((ClientData clientData,
122                                Tcl_Interp *interp));
123    static void             AfterProc _ANSI_ARGS_((ClientData clientData));
124    static void             FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr));
125    static AfterInfo *      GetAfterEvent _ANSI_ARGS_((AfterAssocData *assocPtr,
126                                Tcl_Obj *commandPtr));
127    static ThreadSpecificData *InitTimer _ANSI_ARGS_((void));
128    static void             TimerExitProc _ANSI_ARGS_((ClientData clientData));
129    static int              TimerHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
130                                int flags));
131    static void             TimerCheckProc _ANSI_ARGS_((ClientData clientData,
132                                int flags));
133    static void             TimerSetupProc _ANSI_ARGS_((ClientData clientData,
134                                int flags));
135    
136    /*
137     *----------------------------------------------------------------------
138     *
139     * InitTimer --
140     *
141     *      This function initializes the timer module.
142     *
143     * Results:
144     *      A pointer to the thread specific data.
145     *
146     * Side effects:
147     *      Registers the idle and timer event sources.
148     *
149     *----------------------------------------------------------------------
150     */
151    
152    static ThreadSpecificData *
153    InitTimer()
154    {
155        ThreadSpecificData *tsdPtr =
156            (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
157    
158        if (tsdPtr == NULL) {
159            tsdPtr = TCL_TSD_INIT(&dataKey);
160            Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL);
161            Tcl_CreateThreadExitHandler(TimerExitProc, NULL);
162        }
163        return tsdPtr;
164    }
165    
166    /*
167     *----------------------------------------------------------------------
168     *
169     * TimerExitProc --
170     *
171     *      This function is call at exit or unload time to remove the
172     *      timer and idle event sources.
173     *
174     * Results:
175     *      None.
176     *
177     * Side effects:
178     *      Removes the timer and idle event sources.
179     *
180     *----------------------------------------------------------------------
181     */
182    
183    static void
184    TimerExitProc(clientData)
185        ClientData clientData;      /* Not used. */
186    {
187        Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
188    }
189    
190    /*
191     *--------------------------------------------------------------
192     *
193     * Tcl_CreateTimerHandler --
194     *
195     *      Arrange for a given procedure to be invoked at a particular
196     *      time in the future.
197     *
198     * Results:
199     *      The return value is a token for the timer event, which
200     *      may be used to delete the event before it fires.
201     *
202     * Side effects:
203     *      When milliseconds have elapsed, proc will be invoked
204     *      exactly once.
205     *
206     *--------------------------------------------------------------
207     */
208    
209    Tcl_TimerToken
210    Tcl_CreateTimerHandler(milliseconds, proc, clientData)
211        int milliseconds;           /* How many milliseconds to wait
212                                     * before invoking proc. */
213        Tcl_TimerProc *proc;        /* Procedure to invoke. */
214        ClientData clientData;      /* Arbitrary data to pass to proc. */
215    {
216        register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
217        Tcl_Time time;
218        ThreadSpecificData *tsdPtr;
219    
220        tsdPtr = InitTimer();
221    
222        timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler));
223    
224        /*
225         * Compute when the event should fire.
226         */
227    
228        TclpGetTime(&time);
229        timerHandlerPtr->time.sec = time.sec + milliseconds/1000;
230        timerHandlerPtr->time.usec = time.usec + (milliseconds%1000)*1000;
231        if (timerHandlerPtr->time.usec >= 1000000) {
232            timerHandlerPtr->time.usec -= 1000000;
233            timerHandlerPtr->time.sec += 1;
234        }
235    
236        /*
237         * Fill in other fields for the event.
238         */
239    
240        timerHandlerPtr->proc = proc;
241        timerHandlerPtr->clientData = clientData;
242        tsdPtr->lastTimerId++;
243        timerHandlerPtr->token = (Tcl_TimerToken) tsdPtr->lastTimerId;
244    
245        /*
246         * Add the event to the queue in the correct position
247         * (ordered by event firing time).
248         */
249    
250        for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;
251                prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) {
252            if ((tPtr2->time.sec > timerHandlerPtr->time.sec)
253                    || ((tPtr2->time.sec == timerHandlerPtr->time.sec)
254                    && (tPtr2->time.usec > timerHandlerPtr->time.usec))) {
255                break;
256            }
257        }
258        timerHandlerPtr->nextPtr = tPtr2;
259        if (prevPtr == NULL) {
260            tsdPtr->firstTimerHandlerPtr = timerHandlerPtr;
261        } else {
262            prevPtr->nextPtr = timerHandlerPtr;
263        }
264    
265        TimerSetupProc(NULL, TCL_ALL_EVENTS);
266    
267        return timerHandlerPtr->token;
268    }
269    
270    /*
271     *--------------------------------------------------------------
272     *
273     * Tcl_DeleteTimerHandler --
274     *
275     *      Delete a previously-registered timer handler.
276     *
277     * Results:
278     *      None.
279     *
280     * Side effects:
281     *      Destroy the timer callback identified by TimerToken,
282     *      so that its associated procedure will not be called.
283     *      If the callback has already fired, or if the given
284     *      token doesn't exist, then nothing happens.
285     *
286     *--------------------------------------------------------------
287     */
288    
289    void
290    Tcl_DeleteTimerHandler(token)
291        Tcl_TimerToken token;       /* Result previously returned by
292                                     * Tcl_DeleteTimerHandler. */
293    {
294        register TimerHandler *timerHandlerPtr, *prevPtr;
295        ThreadSpecificData *tsdPtr;
296    
297        tsdPtr = InitTimer();
298        for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL;
299                timerHandlerPtr != NULL; prevPtr = timerHandlerPtr,
300                timerHandlerPtr = timerHandlerPtr->nextPtr) {
301            if (timerHandlerPtr->token != token) {
302                continue;
303            }
304            if (prevPtr == NULL) {
305                tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
306            } else {
307                prevPtr->nextPtr = timerHandlerPtr->nextPtr;
308            }
309            ckfree((char *) timerHandlerPtr);
310            return;
311        }
312    }
313    
314    /*
315     *----------------------------------------------------------------------
316     *
317     * TimerSetupProc --
318     *
319     *      This function is called by Tcl_DoOneEvent to setup the timer
320     *      event source for before blocking.  This routine checks both the
321     *      idle and after timer lists.
322     *
323     * Results:
324     *      None.
325     *
326     * Side effects:
327     *      May update the maximum notifier block time.
328     *
329     *----------------------------------------------------------------------
330     */
331    
332    static void
333    TimerSetupProc(data, flags)
334        ClientData data;            /* Not used. */
335        int flags;                  /* Event flags as passed to Tcl_DoOneEvent. */
336    {
337        Tcl_Time blockTime;
338        ThreadSpecificData *tsdPtr = InitTimer();
339    
340        if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList)
341                || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) {
342            /*
343             * There is an idle handler or a pending timer event, so just poll.
344             */
345    
346            blockTime.sec = 0;
347            blockTime.usec = 0;
348    
349        } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
350            /*
351             * Compute the timeout for the next timer on the list.
352             */
353    
354            TclpGetTime(&blockTime);
355            blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
356            blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
357                    blockTime.usec;
358            if (blockTime.usec < 0) {
359                blockTime.sec -= 1;
360                blockTime.usec += 1000000;
361            }
362            if (blockTime.sec < 0) {
363                blockTime.sec = 0;
364                blockTime.usec = 0;
365            }
366        } else {
367            return;
368        }
369            
370        Tcl_SetMaxBlockTime(&blockTime);
371    }
372    
373    /*
374     *----------------------------------------------------------------------
375     *
376     * TimerCheckProc --
377     *
378     *      This function is called by Tcl_DoOneEvent to check the timer
379     *      event source for events.  This routine checks both the
380     *      idle and after timer lists.
381     *
382     * Results:
383     *      None.
384     *
385     * Side effects:
386     *      May queue an event and update the maximum notifier block time.
387     *
388     *----------------------------------------------------------------------
389     */
390    
391    static void
392    TimerCheckProc(data, flags)
393        ClientData data;            /* Not used. */
394        int flags;                  /* Event flags as passed to Tcl_DoOneEvent. */
395    {
396        Tcl_Event *timerEvPtr;
397        Tcl_Time blockTime;
398        ThreadSpecificData *tsdPtr = InitTimer();
399    
400        if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
401            /*
402             * Compute the timeout for the next timer on the list.
403             */
404    
405            TclpGetTime(&blockTime);
406            blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
407            blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
408                    blockTime.usec;
409            if (blockTime.usec < 0) {
410                blockTime.sec -= 1;
411                blockTime.usec += 1000000;
412            }
413            if (blockTime.sec < 0) {
414                blockTime.sec = 0;
415                blockTime.usec = 0;
416            }
417    
418            /*
419             * If the first timer has expired, stick an event on the queue.
420             */
421    
422            if (blockTime.sec == 0 && blockTime.usec == 0 &&
423                    !tsdPtr->timerPending) {
424                tsdPtr->timerPending = 1;
425                timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event));
426                timerEvPtr->proc = TimerHandlerEventProc;
427                Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
428            }
429        }
430    }
431    
432    /*
433     *----------------------------------------------------------------------
434     *
435     * TimerHandlerEventProc --
436     *
437     *      This procedure is called by Tcl_ServiceEvent when a timer event
438     *      reaches the front of the event queue.  This procedure handles
439     *      the event by invoking the callbacks for all timers that are
440     *      ready.
441     *
442     * Results:
443     *      Returns 1 if the event was handled, meaning it should be removed
444     *      from the queue.  Returns 0 if the event was not handled, meaning
445     *      it should stay on the queue.  The only time the event isn't
446     *      handled is if the TCL_TIMER_EVENTS flag bit isn't set.
447     *
448     * Side effects:
449     *      Whatever the timer handler callback procedures do.
450     *
451     *----------------------------------------------------------------------
452     */
453    
454    static int
455    TimerHandlerEventProc(evPtr, flags)
456        Tcl_Event *evPtr;           /* Event to service. */
457        int flags;                  /* Flags that indicate what events to
458                                     * handle, such as TCL_FILE_EVENTS. */
459    {
460        TimerHandler *timerHandlerPtr, **nextPtrPtr;
461        Tcl_Time time;
462        int currentTimerId;
463        ThreadSpecificData *tsdPtr = InitTimer();
464    
465        /*
466         * Do nothing if timers aren't enabled.  This leaves the event on the
467         * queue, so we will get to it as soon as ServiceEvents() is called
468         * with timers enabled.
469         */
470    
471        if (!(flags & TCL_TIMER_EVENTS)) {
472            return 0;
473        }
474    
475        /*
476         * The code below is trickier than it may look, for the following
477         * reasons:
478         *
479         * 1. New handlers can get added to the list while the current
480         *    one is being processed.  If new ones get added, we don't
481         *    want to process them during this pass through the list to avoid
482         *    starving other event sources.  This is implemented using the
483         *    token number in the handler:  new handlers will have a
484         *    newer token than any of the ones currently on the list.
485         * 2. The handler can call Tcl_DoOneEvent, so we have to remove
486         *    the handler from the list before calling it. Otherwise an
487         *    infinite loop could result.
488         * 3. Tcl_DeleteTimerHandler can be called to remove an element from
489         *    the list while a handler is executing, so the list could
490         *    change structure during the call.
491         * 4. Because we only fetch the current time before entering the loop,
492         *    the only way a new timer will even be considered runnable is if
493         *    its expiration time is within the same millisecond as the
494         *    current time.  This is fairly likely on Windows, since it has
495         *    a course granularity clock.  Since timers are placed
496         *    on the queue in time order with the most recently created
497         *    handler appearing after earlier ones with the same expiration
498         *    time, we don't have to worry about newer generation timers
499         *    appearing before later ones.
500         */
501    
502        tsdPtr->timerPending = 0;
503        currentTimerId = tsdPtr->lastTimerId;
504        TclpGetTime(&time);
505        while (1) {
506            nextPtrPtr = &tsdPtr->firstTimerHandlerPtr;
507            timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
508            if (timerHandlerPtr == NULL) {
509                break;
510            }
511                
512            if ((timerHandlerPtr->time.sec > time.sec)
513                    || ((timerHandlerPtr->time.sec == time.sec)
514                            && (timerHandlerPtr->time.usec > time.usec))) {
515                break;
516            }
517    
518            /*
519             * Bail out if the next timer is of a newer generation.
520             */
521    
522            if ((currentTimerId - (int)timerHandlerPtr->token) < 0) {
523                break;
524            }
525    
526            /*
527             * Remove the handler from the queue before invoking it,
528             * to avoid potential reentrancy problems.
529             */
530    
531            (*nextPtrPtr) = timerHandlerPtr->nextPtr;
532            (*timerHandlerPtr->proc)(timerHandlerPtr->clientData);
533            ckfree((char *) timerHandlerPtr);
534        }
535        TimerSetupProc(NULL, TCL_TIMER_EVENTS);
536        return 1;
537    }
538    
539    /*
540     *--------------------------------------------------------------
541     *
542     * Tcl_DoWhenIdle --
543     *
544     *      Arrange for proc to be invoked the next time the system is
545     *      idle (i.e., just before the next time that Tcl_DoOneEvent
546     *      would have to wait for something to happen).
547     *
548     * Results:
549     *      None.
550     *
551     * Side effects:
552     *      Proc will eventually be called, with clientData as argument.
553     *      See the manual entry for details.
554     *
555     *--------------------------------------------------------------
556     */
557    
558    void
559    Tcl_DoWhenIdle(proc, clientData)
560        Tcl_IdleProc *proc;         /* Procedure to invoke. */
561        ClientData clientData;      /* Arbitrary value to pass to proc. */
562    {
563        register IdleHandler *idlePtr;
564        Tcl_Time blockTime;
565        ThreadSpecificData *tsdPtr = InitTimer();
566    
567        idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));
568        idlePtr->proc = proc;
569        idlePtr->clientData = clientData;
570        idlePtr->generation = tsdPtr->idleGeneration;
571        idlePtr->nextPtr = NULL;
572        if (tsdPtr->lastIdlePtr == NULL) {
573            tsdPtr->idleList = idlePtr;
574        } else {
575            tsdPtr->lastIdlePtr->nextPtr = idlePtr;
576        }
577        tsdPtr->lastIdlePtr = idlePtr;
578    
579        blockTime.sec = 0;
580        blockTime.usec = 0;
581        Tcl_SetMaxBlockTime(&blockTime);
582    }
583    
584    /*
585     *----------------------------------------------------------------------
586     *
587     * Tcl_CancelIdleCall --
588     *
589     *      If there are any when-idle calls requested to a given procedure
590     *      with given clientData, cancel all of them.
591     *
592     * Results:
593     *      None.
594     *
595     * Side effects:
596     *      If the proc/clientData combination were on the when-idle list,
597     *      they are removed so that they will never be called.
598     *
599     *----------------------------------------------------------------------
600     */
601    
602    void
603    Tcl_CancelIdleCall(proc, clientData)
604        Tcl_IdleProc *proc;         /* Procedure that was previously registered. */
605        ClientData clientData;      /* Arbitrary value to pass to proc. */
606    {
607        register IdleHandler *idlePtr, *prevPtr;
608        IdleHandler *nextPtr;
609        ThreadSpecificData *tsdPtr = InitTimer();
610    
611        for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL;
612                prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {
613            while ((idlePtr->proc == proc)
614                    && (idlePtr->clientData == clientData)) {
615                nextPtr = idlePtr->nextPtr;
616                ckfree((char *) idlePtr);
617                idlePtr = nextPtr;
618                if (prevPtr == NULL) {
619                    tsdPtr->idleList = idlePtr;
620                } else {
621                    prevPtr->nextPtr = idlePtr;
622                }
623                if (idlePtr == NULL) {
624                    tsdPtr->lastIdlePtr = prevPtr;
625                    return;
626                }
627            }
628        }
629    }
630    
631    /*
632     *----------------------------------------------------------------------
633     *
634     * TclServiceIdle --
635     *
636     *      This procedure is invoked by the notifier when it becomes
637     *      idle.  It will invoke all idle handlers that are present at
638     *      the time the call is invoked, but not those added during idle
639     *      processing.
640     *
641     * Results:
642     *      The return value is 1 if TclServiceIdle found something to
643     *      do, otherwise return value is 0.
644     *
645     * Side effects:
646     *      Invokes all pending idle handlers.
647     *
648     *----------------------------------------------------------------------
649     */
650    
651    int
652    TclServiceIdle()
653    {
654        IdleHandler *idlePtr;
655        int oldGeneration;
656        Tcl_Time blockTime;
657        ThreadSpecificData *tsdPtr = InitTimer();
658    
659        if (tsdPtr->idleList == NULL) {
660            return 0;
661        }
662    
663        oldGeneration = tsdPtr->idleGeneration;
664        tsdPtr->idleGeneration++;
665    
666        /*
667         * The code below is trickier than it may look, for the following
668         * reasons:
669         *
670         * 1. New handlers can get added to the list while the current
671         *    one is being processed.  If new ones get added, we don't
672         *    want to process them during this pass through the list (want
673         *    to check for other work to do first).  This is implemented
674         *    using the generation number in the handler:  new handlers
675         *    will have a different generation than any of the ones currently
676         *    on the list.
677         * 2. The handler can call Tcl_DoOneEvent, so we have to remove
678         *    the handler from the list before calling it. Otherwise an
679         *    infinite loop could result.
680         * 3. Tcl_CancelIdleCall can be called to remove an element from
681         *    the list while a handler is executing, so the list could
682         *    change structure during the call.
683         */
684    
685        for (idlePtr = tsdPtr->idleList;
686                ((idlePtr != NULL)
687                        && ((oldGeneration - idlePtr->generation) >= 0));
688                idlePtr = tsdPtr->idleList) {
689            tsdPtr->idleList = idlePtr->nextPtr;
690            if (tsdPtr->idleList == NULL) {
691                tsdPtr->lastIdlePtr = NULL;
692            }
693            (*idlePtr->proc)(idlePtr->clientData);
694            ckfree((char *) idlePtr);
695        }
696        if (tsdPtr->idleList) {
697            blockTime.sec = 0;
698            blockTime.usec = 0;
699            Tcl_SetMaxBlockTime(&blockTime);
700        }
701        return 1;
702    }
703    
704    /*
705     *----------------------------------------------------------------------
706     *
707     * Tcl_AfterObjCmd --
708     *
709     *      This procedure is invoked to process the "after" Tcl command.
710     *      See the user documentation for details on what it does.
711     *
712     * Results:
713     *      A standard Tcl result.
714     *
715     * Side effects:
716     *      See the user documentation.
717     *
718     *----------------------------------------------------------------------
719     */
720    
721            /* ARGSUSED */
722    int
723    Tcl_AfterObjCmd(clientData, interp, objc, objv)
724        ClientData clientData;      /* Points to the "tclAfter" assocData for
725                                     * this interpreter, or NULL if the assocData
726                                     * hasn't been created yet.*/
727        Tcl_Interp *interp;         /* Current interpreter. */
728        int objc;                   /* Number of arguments. */
729        Tcl_Obj *CONST objv[];      /* Argument objects. */
730    {
731        int ms;
732        AfterInfo *afterPtr;
733        AfterAssocData *assocPtr = (AfterAssocData *) clientData;
734        Tcl_CmdInfo cmdInfo;
735        int length;
736        char *argString;
737        int index;
738        char buf[16 + TCL_INTEGER_SPACE];
739        static char *afterSubCmds[] = {"cancel", "idle", "info", (char *) NULL};
740        enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
741        ThreadSpecificData *tsdPtr = InitTimer();
742    
743        if (objc < 2) {
744            Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
745            return TCL_ERROR;
746        }
747    
748        /*
749         * Create the "after" information associated for this interpreter,
750         * if it doesn't already exist.  Associate it with the command too,
751         * so that it will be passed in as the ClientData argument in the
752         * future.
753         */
754    
755        if (assocPtr == NULL) {
756            assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData));
757            assocPtr->interp = interp;
758            assocPtr->firstAfterPtr = NULL;
759            Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc,
760                    (ClientData) assocPtr);
761            cmdInfo.proc = NULL;
762            cmdInfo.clientData = (ClientData) NULL;
763            cmdInfo.objProc = Tcl_AfterObjCmd;
764            cmdInfo.objClientData = (ClientData) assocPtr;
765            cmdInfo.deleteProc = NULL;
766            cmdInfo.deleteData = (ClientData) assocPtr;
767            Tcl_SetCommandInfo(interp, Tcl_GetStringFromObj(objv[0], &length),
768                    &cmdInfo);
769        }
770    
771        /*
772         * First lets see if the command was passed a number as the first argument.
773         */
774    
775        if (objv[1]->typePtr == &tclIntType) {
776            ms = (int) objv[1]->internalRep.longValue;
777            goto processInteger;
778        }
779        argString = Tcl_GetStringFromObj(objv[1], &length);
780        if (isdigit(UCHAR(argString[0]))) { /* INTL: digit */
781            if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) {
782                return TCL_ERROR;
783            }
784    processInteger:
785            if (ms < 0) {
786                ms = 0;
787            }
788            if (objc == 2) {
789                Tcl_Sleep(ms);
790                return TCL_OK;
791            }
792            afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
793            afterPtr->assocPtr = assocPtr;
794            if (objc == 3) {
795                afterPtr->commandPtr = objv[2];
796            } else {
797                afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
798            }
799            Tcl_IncrRefCount(afterPtr->commandPtr);
800            /*
801             * The variable below is used to generate unique identifiers for
802             * after commands.  This id can wrap around, which can potentially
803             * cause problems.  However, there are not likely to be problems
804             * in practice, because after commands can only be requested to
805             * about a month in the future, and wrap-around is unlikely to
806             * occur in less than about 1-10 years.  Thus it's unlikely that
807             * any old ids will still be around when wrap-around occurs.
808             */
809            afterPtr->id = tsdPtr->afterId;
810            tsdPtr->afterId += 1;
811            afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc,
812                    (ClientData) afterPtr);
813            afterPtr->nextPtr = assocPtr->firstAfterPtr;
814            assocPtr->firstAfterPtr = afterPtr;
815            sprintf(buf, "after#%d", afterPtr->id);
816            Tcl_AppendResult(interp, buf, (char *) NULL);
817            return TCL_OK;
818        }
819    
820        /*
821         * If it's not a number it must be a subcommand.
822         */
823    
824        if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "argument",
825                0, &index) != TCL_OK) {
826            Tcl_AppendResult(interp, "bad argument \"", argString,
827                    "\": must be cancel, idle, info, or a number",
828                    (char *) NULL);
829            return TCL_ERROR;
830        }
831        switch ((enum afterSubCmds) index) {
832            case AFTER_CANCEL: {
833                Tcl_Obj *commandPtr;
834                char *command, *tempCommand;
835                int tempLength;
836    
837                if (objc < 3) {
838                    Tcl_WrongNumArgs(interp, 2, objv, "id|command");
839                    return TCL_ERROR;
840                }
841                if (objc == 3) {
842                    commandPtr = objv[2];
843                } else {
844                    commandPtr = Tcl_ConcatObj(objc-2, objv+2);;
845                }
846                command = Tcl_GetStringFromObj(commandPtr, &length);
847                for (afterPtr = assocPtr->firstAfterPtr;  afterPtr != NULL;
848                        afterPtr = afterPtr->nextPtr) {
849                    tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
850                            &tempLength);
851                    if ((length == tempLength)
852                            && (memcmp((void*) command, (void*) tempCommand,
853                                    (unsigned) length) == 0)) {
854                        break;
855                    }
856                }
857                if (afterPtr == NULL) {
858                    afterPtr = GetAfterEvent(assocPtr, commandPtr);
859                }
860                if (objc != 3) {
861                    Tcl_DecrRefCount(commandPtr);
862                }
863                if (afterPtr != NULL) {
864                    if (afterPtr->token != NULL) {
865                        Tcl_DeleteTimerHandler(afterPtr->token);
866                    } else {
867                        Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
868                    }
869                    FreeAfterPtr(afterPtr);
870                }
871                break;
872            }
873            case AFTER_IDLE:
874                if (objc < 3) {
875                    Tcl_WrongNumArgs(interp, 2, objv, "script script ...");
876                    return TCL_ERROR;
877                }
878                afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
879                afterPtr->assocPtr = assocPtr;
880                if (objc == 3) {
881                    afterPtr->commandPtr = objv[2];
882                } else {
883                    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
884                }
885                Tcl_IncrRefCount(afterPtr->commandPtr);
886                afterPtr->id = tsdPtr->afterId;
887                tsdPtr->afterId += 1;
888                afterPtr->token = NULL;
889                afterPtr->nextPtr = assocPtr->firstAfterPtr;
890                assocPtr->firstAfterPtr = afterPtr;
891                Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
892                sprintf(buf, "after#%d", afterPtr->id);
893                Tcl_AppendResult(interp, buf, (char *) NULL);
894                break;
895            case AFTER_INFO: {
896                Tcl_Obj *resultListPtr;
897    
898                if (objc == 2) {
899                    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
900                         afterPtr = afterPtr->nextPtr) {
901                        if (assocPtr->interp == interp) {
902                            sprintf(buf, "after#%d", afterPtr->id);
903                            Tcl_AppendElement(interp, buf);
904                        }
905                    }
906                    return TCL_OK;
907                }
908                if (objc != 3) {
909                    Tcl_WrongNumArgs(interp, 2, objv, "?id?");
910                    return TCL_ERROR;
911                }
912                afterPtr = GetAfterEvent(assocPtr, objv[2]);
913                if (afterPtr == NULL) {
914                    Tcl_AppendResult(interp, "event \"", Tcl_GetString(objv[2]),
915                            "\" doesn't exist", (char *) NULL);
916                    return TCL_ERROR;
917                }
918                resultListPtr = Tcl_GetObjResult(interp);
919                Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr);
920                Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
921                    (afterPtr->token == NULL) ? "idle" : "timer", -1));
922                Tcl_SetObjResult(interp, resultListPtr);
923                break;
924            }
925            default: {
926                panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
927            }
928        }
929        return TCL_OK;
930    }
931    
932    /*
933     *----------------------------------------------------------------------
934     *
935     * GetAfterEvent --
936     *
937     *      This procedure parses an "after" id such as "after#4" and
938     *      returns a pointer to the AfterInfo structure.
939     *
940     * Results:
941     *      The return value is either a pointer to an AfterInfo structure,
942     *      if one is found that corresponds to "cmdString" and is for interp,
943     *      or NULL if no corresponding after event can be found.
944     *
945     * Side effects:
946     *      None.
947     *
948     *----------------------------------------------------------------------
949     */
950    
951    static AfterInfo *
952    GetAfterEvent(assocPtr, commandPtr)
953        AfterAssocData *assocPtr;   /* Points to "after"-related information for
954                                     * this interpreter. */
955        Tcl_Obj *commandPtr;
956    {
957        char *cmdString;            /* Textual identifier for after event, such
958                                     * as "after#6". */
959        AfterInfo *afterPtr;
960        int id;
961        char *end;
962    
963        cmdString = Tcl_GetString(commandPtr);
964        if (strncmp(cmdString, "after#", 6) != 0) {
965            return NULL;
966        }
967        cmdString += 6;
968        id = strtoul(cmdString, &end, 10);
969        if ((end == cmdString) || (*end != 0)) {
970            return NULL;
971        }
972        for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
973                afterPtr = afterPtr->nextPtr) {
974            if (afterPtr->id == id) {
975                return afterPtr;
976            }
977        }
978        return NULL;
979    }
980    
981    /*
982     *----------------------------------------------------------------------
983     *
984     * AfterProc --
985     *
986     *      Timer callback to execute commands registered with the
987     *      "after" command.
988     *
989     * Results:
990     *      None.
991     *
992     * Side effects:
993     *      Executes whatever command was specified.  If the command
994     *      returns an error, then the command "bgerror" is invoked
995     *      to process the error;  if bgerror fails then information
996     *      about the error is output on stderr.
997     *
998     *----------------------------------------------------------------------
999     */
1000    
1001    static void
1002    AfterProc(clientData)
1003        ClientData clientData;      /* Describes command to execute. */
1004    {
1005        AfterInfo *afterPtr = (AfterInfo *) clientData;
1006        AfterAssocData *assocPtr = afterPtr->assocPtr;
1007        AfterInfo *prevPtr;
1008        int result;
1009        Tcl_Interp *interp;
1010        char *script;
1011        int numBytes;
1012    
1013        /*
1014         * First remove the callback from our list of callbacks;  otherwise
1015         * someone could delete the callback while it's being executed, which
1016         * could cause a core dump.
1017         */
1018    
1019        if (assocPtr->firstAfterPtr == afterPtr) {
1020            assocPtr->firstAfterPtr = afterPtr->nextPtr;
1021        } else {
1022            for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
1023                    prevPtr = prevPtr->nextPtr) {
1024                /* Empty loop body. */
1025            }
1026            prevPtr->nextPtr = afterPtr->nextPtr;
1027        }
1028    
1029        /*
1030         * Execute the callback.
1031         */
1032    
1033        interp = assocPtr->interp;
1034        Tcl_Preserve((ClientData) interp);
1035        script = Tcl_GetStringFromObj(afterPtr->commandPtr, &numBytes);
1036        result = Tcl_EvalEx(interp, script, numBytes, TCL_EVAL_GLOBAL);
1037        if (result != TCL_OK) {
1038            Tcl_AddErrorInfo(interp, "\n    (\"after\" script)");
1039            Tcl_BackgroundError(interp);
1040        }
1041        Tcl_Release((ClientData) interp);
1042        
1043        /*
1044         * Free the memory for the callback.
1045         */
1046    
1047        Tcl_DecrRefCount(afterPtr->commandPtr);
1048        ckfree((char *) afterPtr);
1049    }
1050    
1051    /*
1052     *----------------------------------------------------------------------
1053     *
1054     * FreeAfterPtr --
1055     *
1056     *      This procedure removes an "after" command from the list of
1057     *      those that are pending and frees its resources.  This procedure
1058     *      does *not* cancel the timer handler;  if that's needed, the
1059     *      caller must do it.
1060     *
1061     * Results:
1062     *      None.
1063     *
1064     * Side effects:
1065     *      The memory associated with afterPtr is released.
1066     *
1067     *----------------------------------------------------------------------
1068     */
1069    
1070    static void
1071    FreeAfterPtr(afterPtr)
1072        AfterInfo *afterPtr;                /* Command to be deleted. */
1073    {
1074        AfterInfo *prevPtr;
1075        AfterAssocData *assocPtr = afterPtr->assocPtr;
1076    
1077        if (assocPtr->firstAfterPtr == afterPtr) {
1078            assocPtr->firstAfterPtr = afterPtr->nextPtr;
1079        } else {
1080            for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
1081                    prevPtr = prevPtr->nextPtr) {
1082                /* Empty loop body. */
1083            }
1084            prevPtr->nextPtr = afterPtr->nextPtr;
1085        }
1086        Tcl_DecrRefCount(afterPtr->commandPtr);
1087        ckfree((char *) afterPtr);
1088    }
1089    
1090    /*
1091     *----------------------------------------------------------------------
1092     *
1093     * AfterCleanupProc --
1094     *
1095     *      This procedure is invoked whenever an interpreter is deleted
1096     *      to cleanup the AssocData for "tclAfter".
1097     *
1098     * Results:
1099     *      None.
1100     *
1101     * Side effects:
1102     *      After commands are removed.
1103     *
1104     *----------------------------------------------------------------------
1105     */
1106    
1107            /* ARGSUSED */
1108    static void
1109    AfterCleanupProc(clientData, interp)
1110        ClientData clientData;      /* Points to AfterAssocData for the
1111                                     * interpreter. */
1112        Tcl_Interp *interp;         /* Interpreter that is being deleted. */
1113    {
1114        AfterAssocData *assocPtr = (AfterAssocData *) clientData;
1115        AfterInfo *afterPtr;
1116    
1117        while (assocPtr->firstAfterPtr != NULL) {
1118            afterPtr = assocPtr->firstAfterPtr;
1119            assocPtr->firstAfterPtr = afterPtr->nextPtr;
1120            if (afterPtr->token != NULL) {
1121                Tcl_DeleteTimerHandler(afterPtr->token);
1122            } else {
1123                Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
1124            }
1125            Tcl_DecrRefCount(afterPtr->commandPtr);
1126            ckfree((char *) afterPtr);
1127        }
1128        ckfree((char *) assocPtr);
1129    }
1130    
1131    /* End of tcltimer.c */
Legend:
Removed from v.29  
changed lines
  Added in v.71
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25