diff options
Diffstat (limited to 'generic/ttk/ttkTrace.c')
| -rw-r--r-- | generic/ttk/ttkTrace.c | 190 |
1 files changed, 190 insertions, 0 deletions
diff --git a/generic/ttk/ttkTrace.c b/generic/ttk/ttkTrace.c new file mode 100644 index 0000000..8bc8519 --- /dev/null +++ b/generic/ttk/ttkTrace.c @@ -0,0 +1,190 @@ +/* + * 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 <tk.h> +#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) { + /* + * If a prior call to Ttk_UntraceVariable() left behind an + * indicator that we wanted this handler to be deleted (see below), + * cleanup the ClientData bits and exit. + */ + if (tracePtr->interp == NULL) { + Tcl_DecrRefCount(tracePtr->varnameObj); + ckfree((ClientData)tracePtr); + return NULL; + } + 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) { + ClientData cd = NULL; + + /* + * Workaround for Tcl Bug 3062331. The trace design problem is + * that when variable unset traces fire, Tcl documents that the + * traced variable has already been unset. It's already gone. + * So from within an unset trace, if you try to call + * Tcl_UntraceVar() on that variable, it will do nothing, because + * the variable by that name can no longer be found. It's gone. + * This means callers of Tcl_UntraceVar() that might be running + * in response to an unset trace have to handle the possibility + * that their Tcl_UntraceVar() call will do nothing. In this case, + * we have to support the possibility that Tcl_UntraceVar() will + * leave the trace in place, so we need to leave the ClientData + * untouched so when that trace does fire it will not crash. + */ + + /* + * Search the traces on the variable to see if the one we are tasked + * with removing is present. + */ + while ((cd = Tcl_VarTraceInfo(h->interp, Tcl_GetString(h->varnameObj), + TCL_GLOBAL_ONLY, VarTraceProc, cd)) != NULL) { + if (cd == (ClientData) h) { + break; + } + } + /* + * If the trace we wish to delete is not visible, Tcl_UntraceVar + * will do nothing, so don't try to call it. Instead set an + * indicator in the Ttk_TraceHandle that we need to cleanup later. + */ + if (cd == NULL) { + h->interp = NULL; + return; + } + 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*/ |