/*
 * tclTrace.c --
 *
 *	This file contains code to handle most trace management.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Scriptics Corporation.
 * Copyright (c) 2002 ActiveState Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTrace.c,v 1.30 2005/11/08 14:24:55 dkf Exp $
 */

#include "tclInt.h"

/*
 * Structures used to hold information about variable traces:
 */

typedef struct {
    int flags;			/* Operations for which Tcl command is to be
				 * invoked. */
    size_t length;		/* Number of non-NUL chars. in command. */
    char command[4];		/* Space for Tcl command to invoke. Actual
				 * size will be as large as necessary to hold
				 * command. This field must be the last in the
				 * structure, so that it can be larger than 4
				 * bytes. */
} TraceVarInfo;

typedef struct {
    VarTrace traceInfo;
    TraceVarInfo traceCmdInfo;
} CombinedTraceVarInfo;

/*
 * Structure used to hold information about command traces:
 */

typedef struct {
    int flags;			/* Operations for which Tcl command is to be
				 * invoked. */

static Tcl_CmdObjTraceProc TraceExecutionProc;
static int		StringTraceProc(ClientData clientData,
			    Tcl_Interp* interp, int level,
			    CONST char* command, Tcl_Command commandInfo,
			    int objc, Tcl_Obj *CONST objv[]);
static void		StringTraceDeleteProc(ClientData clientData);
static void		DisposeTraceResult(int flags, char *result);
static int		TraceVarEx(Tcl_Interp *interp, CONST char *part1,
			    CONST char *part2, register VarTrace *tracePtr);

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

typedef struct StringTraceData {

		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = Tcl_GetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr;

	    ctvarPtr = (CombinedTraceVarInfo *) ckalloc((unsigned)

		    (sizeof(CombinedTraceVarInfo) + length + 1
		    - sizeof(ctvarPtr->traceCmdInfo.command)));
	    ctvarPtr->traceCmdInfo.flags = flags;
	    if (objv[0] == NULL) {
		ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
	    }
	    ctvarPtr->traceCmdInfo.length = length;
	    flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
	    strcpy(ctvarPtr->traceCmdInfo.command, command);
	    ctvarPtr->traceInfo.traceProc = TraceVarProc;
	    ctvarPtr->traceInfo.clientData = (ClientData)
		    &ctvarPtr->traceCmdInfo;
	    ctvarPtr->traceInfo.flags = flags;
	    name = Tcl_GetString(objv[3]);

	    if (TraceVarEx(interp,name,NULL,(VarTrace*)ctvarPtr) != TCL_OK) {
		ckfree((char *) ctvarPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
	     * Search through all of our traces on this variable to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.

		if ((tvarPtr->length == length)
			&& ((tvarPtr->flags & ~TCL_TRACE_OLD_STYLE)==flags)
			&& (strncmp(command, tvarPtr->command,
				(size_t) length) == 0)) {
		    Tcl_UntraceVar2(interp, name, NULL,
			    flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
			    TraceVarProc, clientData);

		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {

    /*
     * We might call Tcl_Eval() below, and that might evaluate [trace vdelete]
     * which might try to free tvarPtr. We want to use tvarPtr until the end
     * of this function, so we use Tcl_Preserve() and Tcl_Release() to be sure
     * it is not freed while we still need it.
     */



    result = NULL;
    if ((tvarPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)
	    && !Tcl_LimitExceeded(interp)) {
	if (tvarPtr->length != (size_t) 0) {
	    /*
	     * Generate a command to execute by appending list elements for
	     * the two variable names and the operation.

		Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp);
		Tcl_IncrRefCount(errMsgObj);
		result = (char *) errMsgObj;
	    }
	    Tcl_DStringFree(&cmd);
	}
    }
    if (destroy && result != NULL) {

	register Tcl_Obj *errMsgObj = (Tcl_Obj *) result;

	Tcl_DecrRefCount(errMsgObj);
	result = NULL;
    }



    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateObjTrace --

				 * 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. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    register VarTrace *tracePtr;
    int result;

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

    result = TraceVarEx(interp, part1, part2, tracePtr);

    if (result != TCL_OK) {
	ckfree((char *) tracePtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TraceVarEx --
 *
 *	Arrange for reads and/or writes to a variable to cause a function to
 *	be invoked, which can monitor the operations and/or change their
 *	actions.
 *
 * Results:
 *	A standard Tcl return value.
 *
 * Side effects:
 *	A trace is set up on the variable given by part1 and part2, such that
 *	future references to the variable will be intermediated by the
 *	traceProc listed in tracePtr. See the manual entry for complete
 *	details on the calling sequence for proc.
 *
 *----------------------------------------------------------------------
 */

static int
TraceVarEx(
    Tcl_Interp *interp,		/* Interpreter in which variable is to be
				 * traced. */
    CONST char *part1,		/* Name of scalar variable or array. */
    CONST char *part2,		/* Name of element within array; NULL means
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    register VarTrace *tracePtr)/* Structure containing flags, traceProc and
				 * clientData fields. Others should be left
				 * blank. Will be ckfree()d (eventually) if
				 * this function returns TCL_OK, and up to
				 * caller to free if this function returns
				 * TCL_ERROR. */
{
    Var *varPtr, *arrayPtr;
    int flagMask;

    /*
     * We strip 'flags' down to just the parts which are relevant to
     * TclLookupVar, to avoid conflicts between trace flags and internal
     * namespace flags such as 'TCL_FIND_ONLY_NS'. This can now occur since we
     * have trace flags with values 0x1000 and higher.
     */

    flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
    varPtr = TclLookupVar(interp, part1, part2,
	    (tracePtr->flags & flagMask) | TCL_LEAVE_ERR_MSG,
	    "trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Check for a nonsense flag combination. Note that this is a Tcl_Panic()
     * because there should be no code path that ever sets both flags.
     */

    if ((tracePtr->flags&TCL_TRACE_RESULT_DYNAMIC)
	    && (tracePtr->flags&TCL_TRACE_RESULT_OBJECT)) {
	Tcl_Panic("bad result flag combination");
    }

    /*
     * Set up trace information.
     */

    flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
	  TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
    flagMask |= TCL_TRACE_OLD_STYLE;
#endif



    tracePtr->flags = tracePtr->flags & flagMask;
    tracePtr->nextPtr = varPtr->tracePtr;

    varPtr->tracePtr = tracePtr;
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */