/* $Id: ttkTrace.c,v 1.1.4.1 2010/08/26 02:06:10 hobbs Exp $ * * Copyright 2003, Joe English * * Simplified interface to Tcl_TraceVariable. * * PROBLEM: Can't distinguish "variable does not exist" (which is OK) * from other errors (which are not). */ #include #include "ttkTheme.h" #include "ttkWidget.h" struct TtkTraceHandle_ { Tcl_Interp *interp; /* Containing interpreter */ Tcl_Obj *varnameObj; /* Name of variable being traced */ Ttk_TraceProc callback; /* Callback procedure */ void *clientData; /* Data to pass to callback */ }; /* * Tcl_VarTraceProc for trace handles. */ static char * VarTraceProc( ClientData clientData, /* Widget record pointer */ Tcl_Interp *interp, /* Interpreter containing variable. */ const char *name1, /* (unused) */ const char *name2, /* (unused) */ int flags) /* Information about what happened. */ { Ttk_TraceHandle *tracePtr = clientData; const char *name, *value; Tcl_Obj *valuePtr; if (flags & TCL_INTERP_DESTROYED) { return NULL; } name = Tcl_GetString(tracePtr->varnameObj); /* * If the variable is being unset, then re-establish the trace: */ if (flags & TCL_TRACE_DESTROYED) { Tcl_TraceVar(interp, name, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VarTraceProc, clientData); tracePtr->callback(tracePtr->clientData, NULL); return NULL; } /* * Call the callback: */ valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY); value = valuePtr ? Tcl_GetString(valuePtr) : NULL; tracePtr->callback(tracePtr->clientData, value); return NULL; } /* Ttk_TraceVariable(interp, varNameObj, callback, clientdata) -- * Attach a write trace to the specified variable, * which will pass the variable's value to 'callback' * whenever the variable is set. * * When the variable is unset, passes NULL to the callback * and reattaches the trace. */ Ttk_TraceHandle *Ttk_TraceVariable( Tcl_Interp *interp, Tcl_Obj *varnameObj, Ttk_TraceProc callback, void *clientData) { Ttk_TraceHandle *h = (Ttk_TraceHandle*)ckalloc(sizeof(*h)); int status; h->interp = interp; h->varnameObj = Tcl_DuplicateObj(varnameObj); Tcl_IncrRefCount(h->varnameObj); h->clientData = clientData; h->callback = callback; status = Tcl_TraceVar(interp, Tcl_GetString(varnameObj), TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VarTraceProc, (ClientData)h); if (status != TCL_OK) { Tcl_DecrRefCount(h->varnameObj); ckfree((ClientData)h); return NULL; } return h; } /* * Ttk_UntraceVariable -- * Remove previously-registered trace and free the handle. */ void Ttk_UntraceVariable(Ttk_TraceHandle *h) { if (h) { Tcl_UntraceVar(h->interp, Tcl_GetString(h->varnameObj), TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VarTraceProc, (ClientData)h); Tcl_DecrRefCount(h->varnameObj); ckfree((ClientData)h); } } /* * Ttk_FireTrace -- * Executes a trace handle as if the variable has been written. * * Note: may reenter the interpreter. */ int Ttk_FireTrace(Ttk_TraceHandle *tracePtr) { Tcl_Interp *interp = tracePtr->interp; void *clientData = tracePtr->clientData; const char *name = Tcl_GetString(tracePtr->varnameObj); Ttk_TraceProc callback = tracePtr->callback; Tcl_Obj *valuePtr; const char *value; /* Read the variable. * Note that this can reenter the interpreter, and anything can happen -- * including the current trace handle being freed! */ valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY); value = valuePtr ? Tcl_GetString(valuePtr) : NULL; /* Call callback. */ callback(clientData, value); return TCL_OK; } /*EOF*/