From: olav@eddy.gmd.de (Olav Schettler)
Subject: Re: interp module source
Organization: GMD, Sankt Augustin, Germany
X-Newsreader: Tin 1.1 PL5
Date: Wed, 27 Jan 1993 09:00:42 GMT

I have done a more simplistic version of an `interp'-command which
just modifies main.c:

Have fun,
--
          Olav Schettler

             GMD-SET
          P.O. Box 1316                  phone: +49 (2241) 14-2291
      Schloss Birlinghoven               fax:   +49 (2241) 14-2242
D-5205 Sankt Augustin 1, Germany         email: Olav@GMD.de


/* 
 * main.c --
 *
 *	A simple program to test the toolkit facilities.
 *
 * Copyright 1990-1992 Regents of the University of California.
 * Permission to use, copy, modify, and distribute this
 * software and its documentation for any purpose and without
 * fee is hereby granted, provided that the above copyright
 * notice appear in all copies.  The University of California
 * makes no representations about the suitability of this
 * software for any purpose.  It is provided "as is" without
 * express or implied warranty.
 *
 * (C) by Olav Schettler (olav@gmd.de), Jan 25, 1993:
 *  Derived from tk2.3: I have split off the stuff to create an interpreter
 *  and use it to provide an additional command `interp' to create new
 *  interpreters. These interpreters are just plain tcl-interpreter except
 *  that they have their `exit'-command replaced by a more harmless version
 *  Interpreters thus created can be manipulated in the usual way using
 *  `send'-commands
 *
 * # From a desktop program where I use the interp-command:
 * set types(group) {
 *	group.bm
 *	{
 * 	set group %s
 * 	set name %s
 * 	interp $name 
 * 	send $name "set group $group"
 * 	send $name "source tcl/desk.tcl"
 *	}
 * }
 */

#ifndef lint
static char rcsid[] = "$Header: /user6/ouster/wish/RCS/main.c,v 1.68 92/05/07 08:52:02 ouster Exp $ SPRITE (Berkeley)";
#endif

#include "tkConfig.h"
#include "tkInt.h"

/*
 * Declarations for library procedures:
 */

extern int isatty();

/*
 * Command used to initialize wish:
 */

char initCmd[] = "source $tk_library/wish.tcl";

Tk_TimerToken timeToken = 0;
int idleHandler = 0;
Tcl_CmdBuf buffer;
int tty;
extern void Tk_AddDragDropCmd _ANSI_ARGS_((Tcl_Interp *interp, Tk_Window tkwin));
extern void init_interp _ANSI_ARGS_((Tcl_Interp *interp));
extern int Tk_SquareCmd _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, int argc, char **argv));

/*
 * Information for testing out command-line options:
 */

char *fileName = NULL;
char *name = NULL;
char *display = NULL;

Tk_ArgvInfo argTable[] = {
    {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
	"File from which to read commands"},
    {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
	"Display to use"},
    {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
	"Name to use for application"},
    {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
	(char *) NULL}
};

    /* ARGSUSED */
void
StdinProc(clientData, mask)
    ClientData clientData;
    int mask;
{
    char line[200];
    static int gotPartial = 0;
    char *cmd;
    int result;

    if (mask & TK_READABLE) {
	if (fgets(line, 200, stdin) == NULL) {
	    if (!gotPartial) {
		if (tty) {
		    Tcl_Eval((Tcl_Interp *) clientData, "destroy .", 0, (char **) NULL);
		    exit(0);
		} else {
		    Tk_DeleteFileHandler(0);
		}
		return;
	    } else {
		line[0] = 0;
	    }
	}
	cmd = Tcl_AssembleCmd(buffer, line);
	if (cmd == NULL) {
	    gotPartial = 1;
	    return;
	}
	gotPartial = 0;
	result = Tcl_RecordAndEval((Tcl_Interp *) clientData, cmd, 0);
	if (((Tcl_Interp *) clientData)->result != 0) {
	    if ((result != TCL_OK) || (tty)) {
		printf("%s\n", ((Tcl_Interp *) clientData)->result);
	    }
	}
	if (tty) {
	    printf("dish: ");
	    fflush(stdout);
	}
    }
}

	/* ARGSUSED */
void
StructureProc(clientData, eventPtr)
    ClientData clientData;	/* Information about window. */
    XEvent *eventPtr;		/* Information about event. */
{
    if (eventPtr->type == DestroyNotify) {
	(Tk_Window) clientData = NULL;
    }
}

/*
 * Procedure to map initial window.  This is invoked as a do-when-idle
 * handler.  Wait for all other when-idle handlers to be processed
 * before mapping the window, so that the window's correct geometry
 * has been determined.
 */

	/* ARGSUSED */
void
DelayedMap(clientData)
    ClientData clientData;
{

    while (Tk_DoOneEvent(TK_IDLE_EVENTS) != 0) {
	/* Empty loop body. */
    }
    if (clientData == NULL) {
	return;
    }
    Tk_MapWindow((Tk_Window) clientData);
}

Tcl_Interp *
Tk_NewInterp (name, argc, argv)
char *name;
int argc;
char **argv;
{
  Tk_Window w;			/* NULL means window has been deleted. */
  Tcl_Interp *interp;
  char *args;
  char buf[20];
  int result;
  Tk_3DBorder border;
  int InterpCmd();

  interp = Tcl_CreateInterp();
#ifdef TCL_MEM_DEBUG
  Tcl_InitMemory(interp);
#endif
  w = Tk_CreateMainWindow(interp, display, name);
  if (w == NULL) {
	return interp;
  }
  Tk_SetClass(w, "Tk");
  Tk_CreateEventHandler(w, StructureNotifyMask, StructureProc,
	    (ClientData) w);
  Tk_DoWhenIdle(DelayedMap, (ClientData) w);

  args = Tcl_Merge(argc-1, argv+1);
  Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
  ckfree(args);
  sprintf(buf, "%d", argc-1);
  Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);

  Tk_GeometryRequest(w, 200, 200);
  border = Tk_Get3DBorder(interp, w, None, "#4eee94");
  if (border == NULL) {
	Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
	Tk_SetWindowBackground(w, WhitePixelOfScreen(Tk_Screen(w)));
  } else {
	Tk_SetBackgroundFromBorder(w, border);
  }
  XSetForeground(Tk_Display(w), DefaultGCOfScreen(Tk_Screen(w)),
	    BlackPixelOfScreen(Tk_Screen(w)));

  /*
   * Add multiple interpreter support
   */
  Tcl_CreateCommand(interp, "interp", InterpCmd, (ClientData) NULL,
	(Tcl_CmdDeleteProc *) NULL);

  result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);

  return interp;
}

    /* ARGSUSED */
int
ExitInterpCmd(dummy, interp, argc, argv)
    ClientData *dummy;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    Tcl_Eval(interp, "destroy .", 0, (char **) NULL);
    Tcl_DeleteInterp(interp);

    return TCL_OK;
}

    /* ARGSUSED */
int
InterpCmd(dummy, interp, argc, argv)
    ClientData dummy;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    Tcl_Interp *newInterp;
    if (argc < 1) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" name ?args ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    newInterp = Tk_NewInterp(argv[1], argc-2, argv+2);
    Tcl_CreateCommand(newInterp, "exit", ExitInterpCmd,
  	 (ClientData) NULL,
         (Tcl_CmdDeleteProc *) NULL);

    return TCL_OK;
}

int
main (argc, argv)
int argc;
char **argv;
{
  Tcl_Interp *interp;
  char *p, *msg;
  int result;
  
  if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
	    != TCL_OK) {
	goto error;
  }
  if (name == NULL) {
	if (fileName != NULL) {
	    p = fileName;
	} else {
	    p = argv[0];
	}
	name = strrchr(p, '/');
	if (name != NULL) {
	    name++;
	} else {
	    name = p;
	}
  }
  interp = Tk_NewInterp (name, argc, argv);
  if (fileName != NULL) {
	result = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
	if (result != TCL_OK) {
	    goto error;
	}
	tty = 0;
  } else {
	tty = isatty(0);
	Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) interp);
	if (tty) {
	    printf("dish: ");
	}
  }
  fflush(stdout);
  buffer = Tcl_CreateCmdBuf();
  (void) Tcl_Eval(interp, "update", 0, (char **) NULL);

  Tk_MainLoop();
  Tcl_DeleteInterp(interp);
  Tcl_DeleteCmdBuf(buffer);
  exit (0);

error:
  msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  if (msg == NULL) {
	msg = interp->result;
  }
  fprintf(stderr, "%s\n", msg);
  Tcl_Eval(interp, "destroy .", 0, (char **) NULL);
  exit (-1);
}