1 /***********************************************************************/
3 /* MLTk, Tcl/Tk interface of Objective Caml */
5 /* Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis */
6 /* projet Cristal, INRIA Rocquencourt */
7 /* Jacques Garrigue, Kyoto University RIMS */
9 /* Copyright 2002 Institut National de Recherche en Informatique et */
10 /* en Automatique and Kyoto University. All rights reserved. */
11 /* This file is distributed under the terms of the GNU Library */
12 /* General Public License, with the special exception on linking */
13 /* described in file LICENSE found in the Objective Caml source tree. */
15 /***********************************************************************/
17 /* $Id: cltkVar.c 5029 2002-07-23 14:12:03Z doligez $ */
19 /* Alternative to tkwait variable */
29 CAMLprim value camltk_getvar(value var)
32 char *stable_var = NULL;
35 stable_var = string_to_c(var);
36 s = Tcl_GetVar(cltclinterp,stable_var,
37 TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
38 stat_free(stable_var);
41 tk_error(cltclinterp->result);
43 return(tcl_string_to_caml(s));
46 CAMLprim value camltk_setvar(value var, value contents)
49 char *stable_var = NULL;
53 /* SetVar makes a copy of the contents. */
54 /* In case we have write traces in Caml, it's better to make sure that
55 var doesn't move... */
56 stable_var = string_to_c(var);
57 utf_contents = caml_string_to_tcl(contents);
58 s = Tcl_SetVar(cltclinterp,stable_var, utf_contents,
59 TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
60 stat_free(stable_var);
61 if( s == utf_contents ){
62 tk_error("camltk_setvar: Tcl_SetVar returned strange result. Call the author of mlTk!");
64 stat_free(utf_contents);
67 tk_error(cltclinterp->result);
73 /* The appropriate type is
74 typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData,
75 Tcl_Interp *interp, char *part1, char *part2, int flags));
77 static char * tracevar(clientdata, interp, name1, name2, flags)
78 ClientData clientdata;
79 Tcl_Interp *interp; /* Interpreter containing variable. */
80 char *name1; /* Name of variable. */
81 char *name2; /* Second part of variable name. */
82 int flags; /* Information about what happened. */
84 Tcl_UntraceVar2(interp, name1, name2,
85 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
86 tracevar, clientdata);
87 callback2(*handler_code,Val_int(clientdata),Val_unit);
91 /* Sets up a callback upon modification of a variable */
92 CAMLprim value camltk_trace_var(value var, value cbid)
97 /* Make a copy of var, since Tcl will modify it in place, and we
98 * don't trust that much what it will do here
100 cvar = string_to_c(var);
101 if (Tcl_TraceVar(cltclinterp, cvar,
102 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
104 (ClientData) (Long_val(cbid)))
107 tk_error(cltclinterp->result);
113 CAMLprim value camltk_untrace_var(value var, value cbid)
118 /* Make a copy of var, since Tcl will modify it in place, and we
119 * don't trust that much what it will do here
121 cvar = string_to_c(var);
122 Tcl_UntraceVar(cltclinterp, cvar,
123 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
125 (ClientData) (Long_val(cbid)));