summaryrefslogtreecommitdiffstats
path: root/otherlibs/labltk/support/cltkVar.c
diff options
context:
space:
mode:
authorXavier Clerc <xavier.clerc@inria.fr>2013-09-09 09:32:00 +0000
committerXavier Clerc <xavier.clerc@inria.fr>2013-09-09 09:32:00 +0000
commite82104a755463d481667650ba4f00de535048f39 (patch)
tree054c7de9b2992be063de2dd22b56ee5993d5a374 /otherlibs/labltk/support/cltkVar.c
parent83ca86dd2309914aa458bc25fd265f0bcadaa337 (diff)
Remove labltk from the distribution (will be available as a third-party library).
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14077 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'otherlibs/labltk/support/cltkVar.c')
-rw-r--r--otherlibs/labltk/support/cltkVar.c128
1 files changed, 0 insertions, 128 deletions
diff --git a/otherlibs/labltk/support/cltkVar.c b/otherlibs/labltk/support/cltkVar.c
deleted file mode 100644
index e647d9d67..000000000
--- a/otherlibs/labltk/support/cltkVar.c
+++ /dev/null
@@ -1,128 +0,0 @@
-/***********************************************************************/
-/* */
-/* MLTk, Tcl/Tk interface of OCaml */
-/* */
-/* Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis */
-/* projet Cristal, INRIA Rocquencourt */
-/* Jacques Garrigue, Kyoto University RIMS */
-/* */
-/* Copyright 2002 Institut National de Recherche en Informatique et */
-/* en Automatique and Kyoto University. All rights reserved. */
-/* This file is distributed under the terms of the GNU Library */
-/* General Public License, with the special exception on linking */
-/* described in file LICENSE found in the OCaml source tree. */
-/* */
-/***********************************************************************/
-
-/* $Id$ */
-
-/* Alternative to tkwait variable */
-#include <string.h>
-#include <tcl.h>
-#include <tk.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <alloc.h>
-#include <callback.h>
-#include "camltk.h"
-
-CAMLprim value camltk_getvar(value var)
-{
- char *s;
- char *stable_var = NULL;
- CheckInit();
-
- stable_var = string_to_c(var);
- s = (char *)Tcl_GetVar(cltclinterp,stable_var,
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
- stat_free(stable_var);
-
- if (s == NULL)
- tk_error(Tcl_GetStringResult(cltclinterp));
- else
- return(tcl_string_to_caml(s));
-}
-
-CAMLprim value camltk_setvar(value var, value contents)
-{
- char *s;
- char *stable_var = NULL;
- char *utf_contents;
- CheckInit();
-
- /* SetVar makes a copy of the contents. */
- /* In case we have write traces in OCaml, it's better to make sure that
- var doesn't move... */
- stable_var = string_to_c(var);
- utf_contents = caml_string_to_tcl(contents);
- s = (char *)Tcl_SetVar(cltclinterp,stable_var, utf_contents,
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
- stat_free(stable_var);
- if( s == utf_contents ){
- tk_error("camltk_setvar: Tcl_SetVar returned strange result. Call the author of mlTk!");
- }
- stat_free(utf_contents);
-
- if (s == NULL)
- tk_error(Tcl_GetStringResult(cltclinterp));
- else
- return(Val_unit);
-}
-
-
-/* The appropriate type is
-typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, char *part1, char *part2, int flags));
- */
-static char * tracevar(clientdata, interp, name1, name2, flags)
- ClientData clientdata;
- Tcl_Interp *interp; /* Interpreter containing variable. */
- char *name1; /* Name of variable. */
- char *name2; /* Second part of variable name. */
- int flags; /* Information about what happened. */
-{
- Tcl_UntraceVar2(interp, name1, name2,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- tracevar, clientdata);
- callback2(*handler_code,Val_int(clientdata),Val_unit);
- return (char *)NULL;
-}
-
-/* Sets up a callback upon modification of a variable */
-CAMLprim value camltk_trace_var(value var, value cbid)
-{
- char *cvar = NULL;
-
- CheckInit();
- /* Make a copy of var, since Tcl will modify it in place, and we
- * don't trust that much what it will do here
- */
- cvar = string_to_c(var);
- if (Tcl_TraceVar(cltclinterp, cvar,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- tracevar,
- (ClientData) (Long_val(cbid)))
- != TCL_OK) {
- stat_free(cvar);
- tk_error(Tcl_GetStringResult(cltclinterp));
- };
- stat_free(cvar);
- return Val_unit;
-}
-
-CAMLprim value camltk_untrace_var(value var, value cbid)
-{
- char *cvar = NULL;
-
- CheckInit();
- /* Make a copy of var, since Tcl will modify it in place, and we
- * don't trust that much what it will do here
- */
- cvar = string_to_c(var);
- Tcl_UntraceVar(cltclinterp, cvar,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- tracevar,
- (ClientData) (Long_val(cbid)));
- stat_free(cvar);
- return Val_unit;
-}