diff options
author | Xavier Clerc <xavier.clerc@inria.fr> | 2013-09-09 09:32:00 +0000 |
---|---|---|
committer | Xavier Clerc <xavier.clerc@inria.fr> | 2013-09-09 09:32:00 +0000 |
commit | e82104a755463d481667650ba4f00de535048f39 (patch) | |
tree | 054c7de9b2992be063de2dd22b56ee5993d5a374 /otherlibs/labltk/support/cltkVar.c | |
parent | 83ca86dd2309914aa458bc25fd265f0bcadaa337 (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.c | 128 |
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; -} |