/* 

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

}

/*

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