/* 

  * tclTimer.c --

  *

  *	This file provides timer event management facilities for Tcl,

  *	including the "after" command.

  *

  * Copyright (c) 1997 by Sun Microsystems, Inc.

  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

  *

  * 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.6.2.4 2005/11/09 21:46:20 kennykb Exp $

  */

 #include "tclInt.h"

 #include "tclPort.h"

 #if defined(__SYMBIAN32__) && defined(__WINSCW__)

 #include "tclSymbianGlobals.h"

 #define dataKey getdataKey(7)

 #endif 

 /*

  * 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;

 #if !defined(__SYMBIAN32__) || !defined(__WINSCW__)

 static Tcl_ThreadDataKey dataKey;

 #endif

 /*

  * 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 and remaining events.

  *

  *----------------------------------------------------------------------

  */

 static void

 TimerExitProc(clientData)

     ClientData clientData;	/* Not used. */

 {

     ThreadSpecificData *tsdPtr =

 	(ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);

     Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);

     if (tsdPtr != NULL) {

 	register TimerHandler *timerHandlerPtr;

 	timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;

 	while (timerHandlerPtr != NULL) {

 	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;

 	    ckfree((char *) timerHandlerPtr);

 	    timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;

 	}

     }

 }

 /*

  *--------------------------------------------------------------

  *

  * 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.

  *

  *--------------------------------------------------------------

  */

 EXPORT_C 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.

      */

     Tcl_GetTime(&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.

  *

  *--------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_DeleteTimerHandler(token)

     Tcl_TimerToken token;	/* Result previously returned by

 				 * Tcl_DeleteTimerHandler. */

 {

     register TimerHandler *timerHandlerPtr, *prevPtr;

     ThreadSpecificData *tsdPtr = InitTimer();

     if (token == NULL) {

 	return;

     }

     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.

 	 */

 	Tcl_GetTime(&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.

 	 */

 	Tcl_GetTime(&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;

     Tcl_GetTime(&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.

  *

  *--------------------------------------------------------------

  */

 EXPORT_C 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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C 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;	/* Unused */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

     Tcl_Obj *CONST objv[];	/* Argument objects. */

 {

     int ms;

     AfterInfo *afterPtr;

     AfterAssocData *assocPtr;

     int length;

     char *argString;

     int index;

     char buf[16 + TCL_INTEGER_SPACE];

     static CONST 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.  

      */

     assocPtr = Tcl_GetAssocData( interp, "tclAfter", NULL );

     if (assocPtr == NULL) {

 	assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData));

 	assocPtr->interp = interp;

 	assocPtr->firstAfterPtr = NULL;

 	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc,

 		(ClientData) assocPtr);

     }

     /*

      * 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 (argString[0] == '+' || argString[0] == '-'

 	|| 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);

 }