l4/pkg/ocaml/ocaml/contrib/otherlibs/labltk/support/slave.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                 MLTk, Tcl/Tk interface of Objective Caml            *)
   4 (*                                                                     *)
   5 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
   6 (*               projet Cristal, INRIA Rocquencourt                    *)
   7 (*            Jacques Garrigue, Kyoto University RIMS                  *)
   8 (*                                                                     *)
   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. *)
  14 (*                                                                     *)
  15 (***********************************************************************)
  16
  17 (* $Id: slave.ml 4745 2002-04-26 12:16:26Z furuse $ *)
  18
  19 (* The code run on initialisation, in addition to normal Tk code
  20  * NOTE: camltk has not fully been initialised yet
  21  *)
  22 external tcl_eval : string -> string
  23         =  "camltk_tcl_eval"
  24 let tcl_command s = ignore (tcl_eval s);;
  25 open Printf
  26
  27 let dynload args =
  28   List.iter Dynlink.loadfile args
  29
  30 (* Default modules include everything from
  31 let default_modules = []
  32 *)
  33
  34 (* [caml::run foo.cmo .. bar.cmo] is now available from Tcl *)
  35 let init () =
  36   Dynlink.init();
  37   (* Make it unsafe by default, with everything available *)
  38   Dynlink.allow_unsafe_modules true;
  39   Dynlink.add_interfaces [] [];
  40   let s = register_callback Widget.dummy dynload in
  41   tcl_command (sprintf "proc caml::run {l} {camlcb %s l}" s)
  42
  43 let _ =
  44   Printexc.print init ()
  45
  46 (* A typical master program would then
  47  *   caml::run foo.cmo
  48  *     # during initialisation, "foo" was registered as a tcl procedure
  49  *   foo x y z
  50  *     # proceed with some Tcl code calling foo
  51  *)