ftp.nice.ch/pub/next/developer/languages/lisp/gcl.2.2-LISP.I.bs.tar.gz#/gcl-2.2/gcl-tk/tktst.c

This is tktst.c in view mode; [Download] [Up]

/*-*-c++-*-*/

#include <stdio.h>
#include <setjmp.h>
#include <tclExtend.h>
#include <tk.h>

Tcl_Interp *tcliMain;		/* Main and only tcl interpreter instance */

static Tk_Window mainWindow;	/* The main window for the application.  If
				 * NULL then the application no longer
				 * exists. */

static int tty;			/* Non-zero means standard input is a
				 * terminal-like device.  Zero means it's
				 * a file. */

static int synchronize = 1;
static char *szname = "TCL/TK-Scheme";
static char *szdisplay = NULL;	/* "unix:0.0"; */

static Tcl_DString command;	/* Used to assemble lines of terminal input
				 * into Tcl commands. */
static int gotPartial = 0;	/* Partial command in buffer. */

static char exitCmd[] = "exit";
static char errorExitCmd[] = "destroy .";

extern int isatty _ANSI_ARGS_((int fd));
/*
int __TclX_AppInit(Tcl_Interp *interp) { return TCL_OK; }
*/
/*
 *----------------------------------------------------------------------
 *
 * StdinProc --
 *
 *	This procedure is invoked by the event dispatcher whenever
 *	standard input becomes readable.  It grabs the next line of
 *	input characters, adds them to a command being assembled, and
 *	executes the command if it's complete.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Could be almost arbitrary, depending on the command that's
 *	typed.
 *
 *----------------------------------------------------------------------
 */

static void
StdinProc(ClientData clientData, int mask)
{
#define BUFFER_SIZE 4000
  char input[BUFFER_SIZE+1];
  char *cmd;
  int code, count;

  count = read(fileno(stdin), input, BUFFER_SIZE);
  if (count <= 0) {
    if (!gotPartial) {
      if (tty) {
	Tcl_VarEval(tcliMain, "exit", (char *) NULL);
	exit(1);
      }
      else {
	Tk_DeleteFileHandler(0);
      }
      return;
    }
    else {
      count = 0;
    }
  }
  cmd = Tcl_DStringAppend(&command, input, count);
  if (count != 0) {
    if ((input[count-1] != '\n') && (input[count-1] != ';')) {
      gotPartial = 1;
      goto exitPoint;
    }
    if (!Tcl_CommandComplete(cmd)) {
      gotPartial = 1;
      goto exitPoint;
    }
  }
  gotPartial = 0;

  /*
   * Disable the stdin file handler;  otherwise if the command
   * re-enters the event loop we might process commands from
   * stdin before the current command is finished.  Among other
   * things, this will trash the text of the command being evaluated.
   */

  Tk_CreateFileHandler(0, 0, StdinProc, (ClientData) 0);
  code = Tcl_RecordAndEval(tcliMain, cmd, 0);
  Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
  if (tty)
    TclX_PrintResult (tcliMain, code, cmd);
  Tcl_DStringFree(&command);

 exitPoint:
  if (tty) {
    TclX_OutputPrompt (tcliMain, !gotPartial);
  }
}

/*
 *----------------------------------------------------------------------
 *
 * SignalProc --
 *
 *	Function called on a signal generating an error to clear the stdin
 *   	buffer.
 *----------------------------------------------------------------------
 */
static void
SignalProc (int signalNum)
{
  tclGotErrorSignal = 0;
  Tcl_DStringFree (&command);
  gotPartial = 0;
  if (tty) {
    fputc ('\n', stdout);
    TclX_OutputPrompt (tcliMain, !gotPartial);
  }
}

char *TclTkInit()
{
  tcliMain = Tcl_CreateInterp();

  mainWindow = Tk_CreateMainWindow(tcliMain, szdisplay, szname, "Tk");
  if (mainWindow == NULL)
    fprintf(stderr, "Unable to create mainWindow : %s\n", tcliMain->result);

  Tk_SetClass(mainWindow, "Tk");
  if (synchronize)
    XSynchronize(Tk_Display(mainWindow), True);

  Tk_GeometryRequest(mainWindow, 200, 200);
  /*
     if (__TclX_AppInit(tcliMain) != TCL_OK)
     TclX_ErrorExit (tcliMain, 255);
     */
  Tcl_AppInit(tcliMain);

  return ".";
}

void TclTkMainLoop()
{
  /*
   * Set the "tcl_interactive" variable.
   */
  tty = isatty(0);
  Tcl_SetVar(tcliMain, "tcl_interactive",
	     tty ? "1" : "0", TCL_GLOBAL_ONLY);
/*
  TclX_EvalRCFile (tcliMain);
*/
  /*
   * Commands will come from standard input.  Set up a handler
   * to receive those characters and print a prompt if the input
   * device is a terminal.
   */
  tclErrorSignalProc = SignalProc;
  Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
  if (tty)
    TclX_OutputPrompt (tcliMain, 1);

  Tk_MainLoop();
  Tcl_GlobalEval(tcliMain, exitCmd);

}

main()
{
  TclTkInit();
  TclTkMainLoop();
}

int
Tcl_AppInit(interp)
    Tcl_Interp *interp;		/* Interpreter for application. */
{
    Tk_Window main;

    main = Tk_MainWindow(interp);

    /*
     * Call the init procedures for included packages.  Each call should
     * look like this:
     *
     * if (Mod_Init(interp) == TCL_ERROR) {
     *     return TCL_ERROR;
     * }
     *
     * where "Mod" is the name of the module.
     */

    if (Tcl_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (Tk_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }

    if (TclX_Init(interp) == TCL_ERROR)
      return TCL_ERROR;

    if (TkX_Init(interp) == TCL_ERROR)
      return TCL_ERROR;

    /*
     * Call Tcl_CreateCommand for application-specific commands, if
     * they weren't already created by the init procedures called above.
     */

    /*
     * Specify a user-specific startup file to invoke if the application
     * is run interactively.  Typically the startup file is "~/.apprc"
     * where "app" is the name of the application.  If this line is deleted
     * then no user-specific startup file will be run under any conditions.
     */

    tcl_RcFileName = "~/.wishrc";
    return TCL_OK;
}

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.