summaryrefslogtreecommitdiffstats
path: root/otherlibs/labltk/support/cltkMain.c
diff options
context:
space:
mode:
Diffstat (limited to 'otherlibs/labltk/support/cltkMain.c')
-rw-r--r--otherlibs/labltk/support/cltkMain.c117
1 files changed, 0 insertions, 117 deletions
diff --git a/otherlibs/labltk/support/cltkMain.c b/otherlibs/labltk/support/cltkMain.c
deleted file mode 100644
index 372372a1d..000000000
--- a/otherlibs/labltk/support/cltkMain.c
+++ /dev/null
@@ -1,117 +0,0 @@
-#include <string.h>
-#include <tcl.h>
-#include <tk.h>
-#include <caml/mlvalues.h>
-#include <caml/memory.h>
-#include <caml/callback.h>
-#ifdef HAS_UNISTD
-#include <unistd.h> /* for R_OK */
-#endif
-#include "camltk.h"
-
-#ifndef R_OK
-#define R_OK 4
-#endif
-
-/*
- * Dealing with signals: when a signal handler is defined in Caml,
- * the actual execution of the signal handler upon reception of the
- * signal is delayed until we are sure we are out of the GC.
- * If a signal occurs during the MainLoop, we would have to wait
- * the next event for the handler to be invoked.
- * The following function will invoke a pending signal handler if any,
- * and we put in on a regular timer.
- */
-
-#define SIGNAL_INTERVAL 300
-
-int signal_events = 0; /* do we have a pending timer */
-
-void invoke_pending_caml_signals (clientdata)
- ClientData clientdata;
-{
- signal_events = 0;
- enter_blocking_section(); /* triggers signal handling */
- /* Rearm timer */
- Tk_CreateTimerHandler(SIGNAL_INTERVAL, invoke_pending_caml_signals, NULL);
- signal_events = 1;
- leave_blocking_section();
-}
-
-/* Now the real Tk stuff */
-
-Tk_Window cltk_mainWindow;
-
-
-/* In slave mode, the interpreter *already* exists */
-int cltk_slave_mode = 0;
-
-/* Initialisation, based on tkMain.c */
-value camltk_opentk(display, name) /* ML */
- value display,name;
-{
- if (!cltk_slave_mode) {
- /* Create an interpreter, dies if error */
-#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1
- Tcl_FindExecutable(String_val(name));
-#endif
- cltclinterp = Tcl_CreateInterp();
-
- if (Tcl_Init(cltclinterp) != TCL_OK)
- tk_error(cltclinterp->result);
- Tcl_SetVar(cltclinterp, "argv0", String_val (name), TCL_GLOBAL_ONLY);
- { /* Sets display if needed */
- char *args;
- char *tkargv[2];
- if (string_length(display) > 0) {
- Tcl_SetVar(cltclinterp, "argc", "2", TCL_GLOBAL_ONLY);
- tkargv[0] = "-display";
- tkargv[1] = String_val(display);
- args = Tcl_Merge(2, tkargv);
- Tcl_SetVar(cltclinterp, "argv", args, TCL_GLOBAL_ONLY);
- free(args);
- }
- }
- if (Tk_Init(cltclinterp) != TCL_OK)
- tk_error(cltclinterp->result);
-
- /* Retrieve the main window */
- cltk_mainWindow = Tk_MainWindow(cltclinterp);
-
- if (NULL == cltk_mainWindow)
- tk_error(cltclinterp->result);
-
- Tk_GeometryRequest(cltk_mainWindow,200,200);
- }
-
- /* Create the camlcallback command */
- Tcl_CreateCommand(cltclinterp,
- CAMLCB, CamlCBCmd,
- (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
-
- /* This is required by "unknown" and thus autoload */
- Tcl_SetVar(cltclinterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
- /* Our hack for implementing break in callbacks */
- Tcl_SetVar(cltclinterp, "BreakBindingsSequence", "0", TCL_GLOBAL_ONLY);
-
- /* Load the traditional rc file */
- {
- char *home = getenv("HOME");
- if (home != NULL) {
- char *f = stat_alloc(strlen(home)+strlen(RCNAME)+2);
- f[0]='\0';
- strcat(f, home);
- strcat(f, "/");
- strcat(f, RCNAME);
- if (0 == access(f,R_OK))
- if (TCL_OK != Tcl_EvalFile(cltclinterp,f)) {
- stat_free(f);
- tk_error(cltclinterp->result);
- };
- stat_free(f);
- }
- }
-
- return Val_unit;
-}
-