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/cltkCaml.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/cltkCaml.c')
-rw-r--r-- | otherlibs/labltk/support/cltkCaml.c | 85 |
1 files changed, 0 insertions, 85 deletions
diff --git a/otherlibs/labltk/support/cltkCaml.c b/otherlibs/labltk/support/cltkCaml.c deleted file mode 100644 index 9a3d38a55..000000000 --- a/otherlibs/labltk/support/cltkCaml.c +++ /dev/null @@ -1,85 +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$ */ - -#include <tcl.h> -#include <tk.h> -#include <mlvalues.h> -#include <alloc.h> -#include <callback.h> -#include <fail.h> -#include "camltk.h" - -value * tkerror_exn = NULL; -value * handler_code = NULL; - -/* The Tcl command for evaluating callback in OCaml */ -int CamlCBCmd(ClientData clientdata, Tcl_Interp *interp, - int argc, CONST84 char **argv) -{ - CheckInit(); - - /* Assumes no result */ - Tcl_SetResult(interp, NULL, NULL); - if (argc >= 2) { - int id; - if (Tcl_GetInt(interp, argv[1], &id) != TCL_OK) - return TCL_ERROR; - callback2(*handler_code,Val_int(id), - copy_string_list(argc - 2,(char **)&argv[2])); - /* Never fails (OCaml would have raised an exception) */ - /* but result may have been set by callback */ - return TCL_OK; - } - else - return TCL_ERROR; -} - -/* Callbacks are always of type _ -> unit, to simplify storage - * But a callback can nevertheless return something (to Tcl) by - * using the following. TCL_VOLATILE ensures that Tcl will make - * a copy of the string - */ -CAMLprim value camltk_return (value v) -{ - CheckInit(); - - Tcl_SetResult(cltclinterp, String_val(v), TCL_VOLATILE); - return Val_unit; -} - -/* Note: raise_with_string WILL copy the error message */ -CAMLprim void tk_error(char *errmsg) -{ - raise_with_string(*tkerror_exn, errmsg); -} - - -/* The initialisation of the C global variables pointing to OCaml values - must be made accessible from OCaml, so that we are sure that it *always* - takes place during loading of the protocol module - */ - -CAMLprim value camltk_init(value v) -{ - /* Initialize the OCaml pointers */ - if (tkerror_exn == NULL) - tkerror_exn = caml_named_value("tkerror"); - if (handler_code == NULL) - handler_code = caml_named_value("camlcb"); - return Val_unit; -} |