import labltklabltk

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/labltk@2531 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 38 insertions, 0 deletions

diff --git a/otherlibs/labltk/support/cltkEvent.c b/otherlibs/labltk/support/cltkEvent.c
new file mode 100644
index 0000000000..92221b9632
--- /dev/null
+++ b/otherlibs/labltk/support/cltkEvent.c
@@ -0,0 +1,38 @@
+#include <tcl.h>
+#include <tk.h>
+#include <caml/mlvalues.h>
+#include "camltk.h"
+
+value camltk_tk_mainloop() /* ML */
+{
+  CheckInit();
+
+  if (cltk_slave_mode)
+    return Val_unit;
+
+  if (!signal_events) {
+    /* Initialise signal handling */
+    signal_events = 1;
+    Tk_CreateTimerHandler(100, invoke_pending_caml_signals, NULL);
+  };
+  Tk_MainLoop();
+  return Val_unit;
+}
+
+/* Note: this HAS to be reported "as-is" in ML source */
+static int event_flag_table[] = {
+  TK_DONT_WAIT, TK_X_EVENTS, TK_FILE_EVENTS, TK_TIMER_EVENTS, TK_IDLE_EVENTS,
+  TK_ALL_EVENTS
+};
+
+value camltk_dooneevent(flags) /* ML */
+     value flags;
+{
+  int ret;
+
+  CheckInit();
+
+  ret = Tk_DoOneEvent(convert_flag_list(flags, event_flag_table));
+  return Val_int(ret);
+}
+