
#include "scm.h"

#ifdef HAVE_GTCLTK

#ifndef alloca
#ifdef __GNUC__
#define alloca __builtin_alloca
#else /* __GNUC__ not defined.  */
#if HAVE_ALLOCA_H
#include <alloca.h>
#else /* not HAVE_ALLOCA_H */
#if defined (MSDOS) && !defined (__TURBOC__)
#include <malloc.h>
#else /* not MSDOS, or __TURBOC__ */
#if defined(_AIX)
#include <malloc.h>
 #pragma alloca
#endif /* not _AIX */
#endif /* not MSDOS, or __TURBOC__ */
#endif /* not HAVE_ALLOCA_H */
#endif /* __GNUC__ not defined.  */
#endif /* alloca not defined.  */

#include "tcl.h"
#include "tk.h"

#include "gtcl.h"



static char s_init_main_window[] = "tk-init-main-window";

static SCM
init_main_window (tobj, display, name, class)
     SCM tobj;
     SCM display;
     SCM name;
     SCM class;
{
  int status;
  Tk_Window win;
  ASSERT (NIMP (tobj) && TERPP (tobj), tobj, ARG1, s_init_main_window);
  ASSERT (NIMP (display) && STRINGP (display),
	  display, ARG2, s_init_main_window);
  ASSERT (NIMP (name) && STRINGP (name), name, ARG3, s_init_main_window);
  ASSERT (NIMP (class) && STRINGP (class), class, ARG4, s_init_main_window);

  DEFER_INTS;
  win = Tk_CreateMainWindow (TERP (tobj),
			     CHARS (display), CHARS (name), CHARS (class));
  ALLOW_INTS;

  if (win == NULL)
    return makfrom0str (TERP (tobj)->result);

  DEFER_INTS;
  status = Tcl_Init(TERP (tobj));
  ALLOW_INTS;

  if (status == TCL_ERROR)
    return makfrom0str (TERP (tobj)->result);

  DEFER_INTS;
  status = Tk_Init(TERP (tobj));
  ALLOW_INTS;
  if (status == TCL_ERROR)
    return makfrom0str (TERP (tobj)->result);

  DEFER_INTS;
  Tcl_SetVar (TERP (tobj), "tcl_interactive", "0", TCL_GLOBAL_ONLY);
  ALLOW_INTS;

  return BOOL_T;
}


static char s_do_one_event[] = "tk-do-one-event";
static SCM
do_one_event (flags)
     SCM flags;
{
  int answer;
  ASSERT (INUMP (flags), flags, ARG1, s_do_one_event);
  DEFER_INTS;
  answer = (Tk_DoOneEvent (INUM (flags)));
  ALLOW_INTS;
  return MAKINUM (answer);
}

static char s_main_loop[] = "tk-main-loop";
static SCM
main_loop ()
{
  DEFER_INTS;
  Tk_MainLoop ();
  ALLOW_INTS;
  return UNSPECIFIED;
}


static char s_num_main_windows[] = "tk-num-main-windows";
static SCM
num_main_windows ()
{
  return MAKINUM (tk_NumMainWindows);
}

static scm_iproc subr0s[] =
{
  {s_main_loop, main_loop},
  {s_num_main_windows, num_main_windows},
  {0, 0}
};

static scm_iproc subr1s[] =
{
  {s_do_one_event, do_one_event},
  {0, 0}
};

void
scm_init_tk ()
{
  scm_init_iprocs (subr0s, tc7_subr_0);
  scm_init_iprocs (subr1s, tc7_subr_1);
  scm_make_gsubr (s_init_main_window, 4, 0, 0, init_main_window);
}
#endif /* HAVE_LIBTK */
