1/* $Id$
2 *
3 * Copyright 2003, Joe English
4 *
5 * Simplified interface to Tcl_TraceVariable.
6 *
7 * PROBLEM: Can't distinguish "variable does not exist" (which is OK)
8 * from other errors (which are not).
9 */
10
11#include <tk.h>
12#include "ttkTheme.h"
13#include "ttkWidget.h"
14
15struct TtkTraceHandle_
16{
17    Tcl_Interp		*interp;	/* Containing interpreter */
18    Tcl_Obj 		*varnameObj;	/* Name of variable being traced */
19    Ttk_TraceProc	callback;	/* Callback procedure */
20    void		*clientData;	/* Data to pass to callback */
21};
22
23/*
24 * Tcl_VarTraceProc for trace handles.
25 */
26static char *
27VarTraceProc(
28    ClientData clientData,	/* Widget record pointer */
29    Tcl_Interp *interp, 	/* Interpreter containing variable. */
30    const char *name1,		/* (unused) */
31    const char *name2,		/* (unused) */
32    int flags)			/* Information about what happened. */
33{
34    Ttk_TraceHandle *tracePtr = clientData;
35    const char *name, *value;
36    Tcl_Obj *valuePtr;
37
38    if (flags & TCL_INTERP_DESTROYED) {
39	return NULL;
40    }
41
42    name = Tcl_GetString(tracePtr->varnameObj);
43
44    /*
45     * If the variable is being unset, then re-establish the trace:
46     */
47    if (flags & TCL_TRACE_DESTROYED) {
48	Tcl_TraceVar(interp, name,
49		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
50		VarTraceProc, clientData);
51	tracePtr->callback(tracePtr->clientData, NULL);
52	return NULL;
53    }
54
55    /*
56     * Call the callback:
57     */
58    valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
59    value = valuePtr ?  Tcl_GetString(valuePtr) : NULL;
60    tracePtr->callback(tracePtr->clientData, value);
61
62    return NULL;
63}
64
65/* Ttk_TraceVariable(interp, varNameObj, callback, clientdata) --
66 * 	Attach a write trace to the specified variable,
67 * 	which will pass the variable's value to 'callback'
68 * 	whenever the variable is set.
69 *
70 * 	When the variable is unset, passes NULL to the callback
71 * 	and reattaches the trace.
72 */
73Ttk_TraceHandle *Ttk_TraceVariable(
74    Tcl_Interp *interp,
75    Tcl_Obj *varnameObj,
76    Ttk_TraceProc callback,
77    void *clientData)
78{
79    Ttk_TraceHandle *h = (Ttk_TraceHandle*)ckalloc(sizeof(*h));
80    int status;
81
82    h->interp = interp;
83    h->varnameObj = Tcl_DuplicateObj(varnameObj);
84    Tcl_IncrRefCount(h->varnameObj);
85    h->clientData = clientData;
86    h->callback = callback;
87
88    status = Tcl_TraceVar(interp, Tcl_GetString(varnameObj),
89	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
90	    VarTraceProc, (ClientData)h);
91
92    if (status != TCL_OK) {
93	Tcl_DecrRefCount(h->varnameObj);
94	ckfree((ClientData)h);
95	return NULL;
96    }
97
98    return h;
99}
100
101/*
102 * Ttk_UntraceVariable --
103 * 	Remove previously-registered trace and free the handle.
104 */
105void Ttk_UntraceVariable(Ttk_TraceHandle *h)
106{
107    if (h) {
108	Tcl_UntraceVar(h->interp, Tcl_GetString(h->varnameObj),
109		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
110		VarTraceProc, (ClientData)h);
111	Tcl_DecrRefCount(h->varnameObj);
112	ckfree((ClientData)h);
113    }
114}
115
116/*
117 * Ttk_FireTrace --
118 * 	Executes a trace handle as if the variable has been written.
119 *
120 * 	Note: may reenter the interpreter.
121 */
122int Ttk_FireTrace(Ttk_TraceHandle *tracePtr)
123{
124    Tcl_Interp *interp = tracePtr->interp;
125    void *clientData = tracePtr->clientData;
126    const char *name = Tcl_GetString(tracePtr->varnameObj);
127    Ttk_TraceProc callback = tracePtr->callback;
128    Tcl_Obj *valuePtr;
129    const char *value;
130
131    /* Read the variable.
132     * Note that this can reenter the interpreter, and anything can happen --
133     * including the current trace handle being freed!
134     */
135    valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
136    value = valuePtr ? Tcl_GetString(valuePtr) : NULL;
137
138    /* Call callback.
139     */
140    callback(clientData, value);
141
142    return TCL_OK;
143}
144
145/*EOF*/
146