/*
 * Declarations for local functions to this file:
 */

static int		CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr,
			    Command *cmdPtr, const char *command, size_t numChars,
			    int objc, Tcl_Obj *const objv[]);
static char *		TraceVarProc(void *clientData, Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static void		TraceCommandProc(void *clientData,
			    Tcl_Interp *interp, const char *oldName,
			    const char *newName, int flags);
static Tcl_CmdObjTraceProc TraceExecutionProc;
static int		StringTraceProc(void *clientData,
			    Tcl_Interp *interp, int level,
			    const char *command, Tcl_Command commandInfo,
			    int objc, Tcl_Obj *const objv[]);
static void		StringTraceDeleteProc(void *clientData);
static void		DisposeTraceResult(int flags, char *result);
static int		TraceVarEx(Tcl_Interp *interp, const char *part1,
			    const char *part2, VarTrace *tracePtr);

/*
 * The following structure holds the client data for string-based
 * trace procs
 */

typedef struct {
    void *clientData;	/* Client data from Tcl_CreateTrace */
    Tcl_CmdTraceProc *proc;	/* Trace function from Tcl_CreateTrace */
} StringTraceData;

/*
 * Convenience macros for iterating over the list of traces. Note that each of
 * these *must* be treated as a command, and *must* have a block following it.
 */

	} else {
	    code = traceSubCmds[2](interp, TRACE_REMOVE, objc+1, copyObjv);
	}
	Tcl_DecrRefCount(opsList);
	return code;
    }
    case TRACE_OLD_VINFO: {
	void *clientData;
	char ops[5];
	Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name");
	    return TCL_ERROR;
	}

	} else {
	    /*
	     * Search through all of our traces on this command to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
	     */

	    void *clientData;

	    /*
	     * First ensure the name given is valid.
	     */

	    name = TclGetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {

		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	void *clientData;
	Tcl_Obj *resultListPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

	} else {
	    /*
	     * Search through all of our traces on this command to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
	     */

	    void *clientData;

	    /*
	     * First ensure the name given is valid.
	     */

	    name = TclGetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {

		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	void *clientData;
	Tcl_Obj *resultListPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

    Tcl_Interp *interp,		/* Current interpreter. */
	enum traceOptions optionIndex,		/* Add, info or remove */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *command;
    size_t commandLength, length;
    void *clientData;
    static const char *const opStrings[] = {
	"array", "read", "unset", "write", NULL
    };
    enum operations {
	TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE
    } index;

ClientData
Tcl_CommandTraceInfo(
    Tcl_Interp *interp,		/* Interpreter containing command. */
    const char *cmdName,	/* Name of command. */
    TCL_UNUSED(int) /*flags*/,
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    void *prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    Command *cmdPtr;
    CommandTrace *tracePtr;

				 * traced. */
    const char *cmdName,	/* Name of command. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
				 * of the TRACE_*_EXEC flags */
    Tcl_CommandTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon cmdName. */
    void *clientData)	/* Arbitrary argument to pass to proc. */
{
    Command *cmdPtr;
    CommandTrace *tracePtr;

    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
	    TCL_LEAVE_ERR_MSG);
    if (cmdPtr == NULL) {

Tcl_UntraceCommand(
    Tcl_Interp *interp,		/* Interpreter containing command. */
    const char *cmdName,	/* Name of command. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
				 * of the TRACE_*_EXEC flags */
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    void *clientData)	/* Arbitrary argument to pass to proc. */
{
    CommandTrace *tracePtr;
    CommandTrace *prevPtr;
    Command *cmdPtr;
    Interp *iPtr = (Interp *)interp;
    ActiveCommandTrace *activePtr;
    int hasExecTraces = 0;

 *	Depends on the command associated with the trace.
 *
 *----------------------------------------------------------------------
 */

static void
TraceCommandProc(
    void *clientData,	/* Information about the command trace. */
    Tcl_Interp *interp,		/* Interpreter containing command. */
    const char *oldName,	/* Name of command being changed. */
    const char *newName,	/* New name of command. Empty string or NULL
				 * means command is being deleted (renamed to
				 * ""). */
    int flags)			/* OR-ed bits giving operation and other
				 * information. */

 *	May release memory.
 *
 *----------------------------------------------------------------------
 */

static void
CommandObjTraceDeleted(
    void *clientData)
{
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

    if (tcmdPtr->refCount-- <= 1) {
	Tcl_Free(tcmdPtr);
    }
}

 *	interpreter-wide trace.
 *
 *----------------------------------------------------------------------
 */

static int
TraceExecutionProc(
    void *clientData,
    Tcl_Interp *interp,
    int level,
    const char *command,
    TCL_UNUSED(Tcl_Command),
    int objc,
    Tcl_Obj *const objv[])
{
    int call = 0;
    Interp *iPtr = (Interp *) interp;
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;
    int flags = tcmdPtr->curFlags;
    int code = tcmdPtr->curCode;
    int traceCode = TCL_OK;

 *	Depends on the command associated with the trace.
 *
 *----------------------------------------------------------------------
 */

static char *
TraceVarProc(
    void *clientData,	/* Information about the variable trace. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable or array. */
    const char *name2,		/* Name of element within array; NULL means
				 * scalar variable is being referenced. */
    int flags)			/* OR-ed bits giving operation and other
				 * information. */
{

 *	applications such as profiling of run time.
 *
 *	When the trace is deleted, the 'delProc' function will be invoked,
 *	passing it the original client data.
 *
 *----------------------------------------------------------------------
 */

typedef struct {
    Tcl_CmdObjTraceProc2 *proc;
    Tcl_CmdObjTraceDeleteProc *delProc;
    void *clientData;
} TraceWrapperInfo;

static int traceWrapperProc(
    void *clientData,
    Tcl_Interp *interp,
	int level,
    const char *command,
    Tcl_Command commandInfo,
    int objc,
    Tcl_Obj *const objv[])
{
    TraceWrapperInfo *info = (TraceWrapperInfo *)clientData;
    return info->proc(info->clientData, interp, level, command, commandInfo, objc, objv);
}

static void traceWrapperDelProc(void *clientData)
{
    TraceWrapperInfo *info = (TraceWrapperInfo *)clientData;
    clientData = info->clientData;
    if (info->delProc) {
	info->delProc(clientData);
    }
    ckfree(info);
}

Tcl_Trace
Tcl_CreateObjTrace2(
    Tcl_Interp *interp,		/* Tcl interpreter */
    int level,			/* Maximum nesting level */
    int flags,			/* Flags, see above */
    Tcl_CmdObjTraceProc2 *proc,	/* Trace callback */
    void *clientData,	/* Client data for the callback */
    Tcl_CmdObjTraceDeleteProc *delProc)
				/* Function to call when trace is deleted */
{
    TraceWrapperInfo *info = (TraceWrapperInfo *)ckalloc(sizeof(TraceWrapperInfo));
    info->proc = proc;
    info->delProc = delProc;
    info->clientData = clientData;
    return Tcl_CreateObjTrace(interp, level, flags,
	    (proc ? traceWrapperProc : NULL),
	    info, traceWrapperDelProc);
}

Tcl_Trace
Tcl_CreateObjTrace(
    Tcl_Interp *interp,		/* Tcl interpreter */
    int level,			/* Maximum nesting level */
    int flags,			/* Flags, see above */
    Tcl_CmdObjTraceProc *proc,	/* Trace callback */
    void *clientData,	/* Client data for the callback */
    Tcl_CmdObjTraceDeleteProc *delProc)
				/* Function to call when trace is deleted */
{
    Trace *tracePtr;
    Interp *iPtr = (Interp *) interp;

    /*

 *	From now on, proc will be called just before a command procedure is
 *	called to execute a Tcl command. Calls to proc will have the following
 *	form:
 *
 *	void
 *	proc(clientData, interp, level, command, cmdProc, cmdClientData,
 *		argc, argv)
 *	    void *clientData;
 *	    Tcl_Interp *interp;
 *	    int level;
 *	    char *command;
 *	    int (*cmdProc)();
 *	    void *cmdClientData;
 *	    int argc;
 *	    char **argv;
 *	{
 *	}
 *
 *	The clientData and interp arguments to proc will be the same as the
 *	corresponding arguments to this function. Level gives the nesting

Tcl_Trace
Tcl_CreateTrace(
    Tcl_Interp *interp,		/* Interpreter in which to create trace. */
    int level,			/* Only call proc for commands at nesting
				 * level<=argument level (1=>top level). */
    Tcl_CmdTraceProc *proc,	/* Function to call before executing each
				 * command. */
    void *clientData)	/* Arbitrary value word to pass to proc. */
{
    StringTraceData *data = (StringTraceData *)Tcl_Alloc(sizeof(StringTraceData));

    data->clientData = clientData;
    data->proc = proc;
    return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
	    data, StringTraceDeleteProc);

 *	Whatever the string-based trace function does.
 *
 *----------------------------------------------------------------------
 */

static int
StringTraceProc(
    void *clientData,
    Tcl_Interp *interp,
    int level,
    const char *command,
    Tcl_Command commandInfo,
    int objc,
    Tcl_Obj *const *objv)
{

 *	Allocated memory is returned to the system.
 *
 *----------------------------------------------------------------------
 */

static void
StringTraceDeleteProc(
    void *clientData)
{
    Tcl_Free(clientData);
}

/*
 *----------------------------------------------------------------------
 *

				 * trace applies to scalar variable or array
				 * as-a-whole. */
    int flags,			/* OR-ed collection of bits describing current
				 * trace, including any of TCL_TRACE_READS,
				 * TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
				 * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    void *clientData)	/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    VarTrace *prevPtr, *nextPtr;
    Var *varPtr, *arrayPtr;
    Interp *iPtr = (Interp *) interp;
    ActiveVarTrace *activePtr;
    int flagMask, allFlags = 0;

    const char *part1,		/* Name of variable or array. */
    const char *part2,		/* Name of element within array; NULL means
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    int flags,			/* OR-ed combination of TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    void *prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr;
    Tcl_HashEntry *hPtr;

				 * as-a-whole. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
				 * TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon varName. */
    void *clientData)	/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    int result;

    tracePtr = (VarTrace *)Tcl_Alloc(sizeof(VarTrace));
    tracePtr->traceProc = proc;
    tracePtr->clientData = clientData;