l4/pkg/ocaml/contrib/otherlibs/labltk/support/cltkEvent.c

   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: cltkEvent.c 4745 2002-04-26 12:16:26Z furuse $ */
  18
  19 #include <tcl.h>
  20 #include <tk.h>
  21 #include <mlvalues.h>
  22 #include <alloc.h>
  23 #include "camltk.h"
  24
  25 CAMLprim value camltk_tk_mainloop(void)
  26 {
  27   CheckInit();
  28
  29   if (cltk_slave_mode) return Val_unit;
  30
  31   if (!signal_events) {
  32     /* Initialise signal handling */
  33     signal_events = 1;
  34     Tk_CreateTimerHandler(100, invoke_pending_caml_signals, NULL);
  35   }
  36   Tk_MainLoop();
  37   return Val_unit;
  38 }
  39
  40 /* Note: this HAS to be reported "as-is" in ML source */
  41 static int event_flag_table[] = {
  42   TK_DONT_WAIT, TK_X_EVENTS, TK_FILE_EVENTS, TK_TIMER_EVENTS, TK_IDLE_EVENTS,
  43   TK_ALL_EVENTS
  44 };
  45
  46 CAMLprim value camltk_dooneevent(value flags)
  47 {
  48   int ret;
  49
  50   CheckInit();
  51
  52   ret = Tk_DoOneEvent(convert_flag_list(flags, event_flag_table));
  53   return Val_int(ret);
  54 }
  55