cvs.zerfleddert.de Git - micropolis/blame_incremental - src/tk/main.c

/*
 * 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.
 */

#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_Window w;			/* NULL means window has been deleted. */
Tk_TimerToken timeToken = 0;
int idleHandler = 0;
Tcl_Interp *interp;
int x, y;
Tcl_CmdBuf buffer;
int tty;
extern int Tk_SquareCmd _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, int argc, char **argv));

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

int synchronize = 0;
char *fileName = NULL;
char *name = NULL;
char *display = NULL;
char *geometry = NULL;

Tk_ArgvInfo argTable[] = {
    {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
	"File from which to read commands"},
    {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
	"Initial geometry for window"},
    {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
	"Display to use"},
    {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
	"Name to use for application"},
    {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
	"Use synchronous mode for display server"},
    {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
	(char *) NULL}
};

    /* ARGSUSED */
void
StdinProc(clientData, mask)
    ClientData clientData;		/* Not used. */
    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(interp, "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(interp, cmd, 0);
	if (*interp->result != 0) {
	    if ((result != TCL_OK) || (tty)) {
		printf("%s\n", interp->result);
	    }
	}
	if (tty) {
	    printf("wish: ");
	    fflush(stdout);
	}
    }
}

	/* ARGSUSED */
static void
StructureProc(clientData, eventPtr)
    ClientData clientData;	/* Information about window. */
    XEvent *eventPtr;		/* Information about event. */
{
    if (eventPtr->type == DestroyNotify) {
	w = 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 */
static void
DelayedMap(clientData)
    ClientData clientData;	/* Not used. */
{

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

	/* ARGSUSED */
int
DotCmd(dummy, interp, argc, argv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    int x, y;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" x y\"", (char *) NULL);
	return TCL_ERROR;
    }
    x = strtol(argv[1], (char **) NULL, 0);
    y = strtol(argv[2], (char **) NULL, 0);
    Tk_MakeWindowExist(w);
    XDrawPoint(Tk_Display(w), Tk_WindowId(w),
	    DefaultGCOfScreen(Tk_Screen(w)), x, y);
    return TCL_OK;
}

	/* ARGSUSED */
int
MovetoCmd(dummy, interp, argc, argv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" x y\"", (char *) NULL);
	return TCL_ERROR;
    }
    x = strtol(argv[1], (char **) NULL, 0);
    y = strtol(argv[2], (char **) NULL, 0);
    return TCL_OK;
}
	/* ARGSUSED */
int
LinetoCmd(dummy, interp, argc, argv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    int newX, newY;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" x y\"", (char *) NULL);
	return TCL_ERROR;
    }
    newX = strtol(argv[1], (char **) NULL, 0);
    newY = strtol(argv[2], (char **) NULL, 0);
    Tk_MakeWindowExist(w);
    XDrawLine(Tk_Display(w), Tk_WindowId(w),
	    DefaultGCOfScreen(Tk_Screen(w)), x, y, newX, newY);
    x = newX;
    y = newY;
    return TCL_OK;
}

int
main(argc, argv)
    int argc;
    char **argv;
{
    char *args, *p, *msg;
    char buf[20];
    int result;
    Tk_3DBorder border;

    { extern char *TCL_Library, *TK_Library;
      extern int TK_CreateColormap;
      char *tcllib = getenv("TCL_LIBRARY");
      char *tklib = getenv("TK_LIBRARY");
      char *create = getenv("CREATE_COLORMAP");
      if (tklib != NULL)
	TK_Library = tklib;
      if (tcllib != NULL)
	TCL_Library = tcllib;
      if (create != NULL)
	TK_CreateColormap = 1;
    }

    interp = Tcl_CreateInterp();
#ifdef TCL_MEM_DEBUG
    Tcl_InitMemory(interp);
#endif
    if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
	    != TCL_OK) {
	fprintf(stderr, "%s\n", interp->result);
	exit(1);
    }
    if (name == NULL) {
	if (fileName != NULL) {
	    p = fileName;
	} else {
	    p = argv[0];
	}
	name = strrchr(p, '/');
	if (name != NULL) {
	    name++;
	} else {
	    name = p;
	}
    }
    w = Tk_CreateMainWindow(interp, display, name);
    if (w == NULL) {
	fprintf(stderr, "%s\n", interp->result);
	exit(1);
    }
    Tk_SetClass(w, "Tk");
    Tk_CreateEventHandler(w, StructureNotifyMask, StructureProc,
	    (ClientData) NULL);
    Tk_DoWhenIdle(DelayedMap, (ClientData) NULL);
    tty = isatty(0);

    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);

    if (synchronize) {
	XSynchronize(Tk_Display(w), True);
    }
    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)));
    Tcl_CreateCommand(interp, "dot", DotCmd, (ClientData) w,
	    (void (*)()) NULL);
    Tcl_CreateCommand(interp, "lineto", LinetoCmd, (ClientData) w,
	    (void (*)()) NULL);
    Tcl_CreateCommand(interp, "moveto", MovetoCmd, (ClientData) w,
	    (void (*)()) NULL);
#ifdef SQUARE_DEMO
    Tcl_CreateCommand(interp, "square", Tk_SquareCmd, (ClientData) w,
	    (void (*)()) NULL);
#endif
    if (geometry != NULL) {
	Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
    }
    result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);
    if (result != TCL_OK) {
	goto error;
    }
    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) 0);
	if (tty) {
	    printf("wish: ");
	}
    }
    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);
}
Commit	Line	Data
	1	/*
	2	* main.c --
	3	*
	4	* A simple program to test the toolkit facilities.
	5	*
	6	* Copyright 1990-1992 Regents of the University of California.
	7	* Permission to use, copy, modify, and distribute this
	8	* software and its documentation for any purpose and without
	9	* fee is hereby granted, provided that the above copyright
	10	* notice appear in all copies. The University of California
	11	* makes no representations about the suitability of this
	12	* software for any purpose. It is provided "as is" without
	13	* express or implied warranty.
	14	*/
	15
	16	#ifndef lint
	17	static char rcsid[] = "$Header: /user6/ouster/wish/RCS/main.c,v 1.68 92/05/07 08:52:02 ouster Exp $ SPRITE (Berkeley)";
	18	#endif
	19
	20	#include "tkconfig.h"
	21	#include "tkint.h"
	22
	23	/*
	24	* Declarations for library procedures:
	25	*/
	26
	27	extern int isatty();
	28
	29	/*
	30	* Command used to initialize wish:
	31	*/
	32
	33	char initCmd[] = "source $tk_library/wish.tcl";
	34
	35	Tk_Window w; /* NULL means window has been deleted. */
	36	Tk_TimerToken timeToken = 0;
	37	int idleHandler = 0;
	38	Tcl_Interp *interp;
	39	int x, y;
	40	Tcl_CmdBuf buffer;
	41	int tty;
	42	extern int Tk_SquareCmd _ANSI_ARGS_((ClientData clientData,
	43	Tcl_Interp interp, int argc, char *argv));
	44
	45	/*
	46	* Information for testing out command-line options:
	47	*/
	48
	49	int synchronize = 0;
	50	char *fileName = NULL;
	51	char *name = NULL;
	52	char *display = NULL;
	53	char *geometry = NULL;
	54
	55	Tk_ArgvInfo argTable[] = {
	56	{"-file", TK_ARGV_STRING, (char ) NULL, (char ) &fileName,
	57	"File from which to read commands"},
	58	{"-geometry", TK_ARGV_STRING, (char ) NULL, (char ) &geometry,
	59	"Initial geometry for window"},
	60	{"-display", TK_ARGV_STRING, (char ) NULL, (char ) &display,
	61	"Display to use"},
	62	{"-name", TK_ARGV_STRING, (char ) NULL, (char ) &name,
	63	"Name to use for application"},
	64	{"-sync", TK_ARGV_CONSTANT, (char ) 1, (char ) &synchronize,
	65	"Use synchronous mode for display server"},
	66	{(char ) NULL, TK_ARGV_END, (char ) NULL, (char *) NULL,
	67	(char *) NULL}
	68	};
	69
	70	/* ARGSUSED */
	71	void
	72	StdinProc(clientData, mask)
	73	ClientData clientData; /* Not used. */
	74	int mask;
	75	{
	76	char line[200];
	77	static int gotPartial = 0;
	78	char *cmd;
	79	int result;
	80
	81	if (mask & TK_READABLE) {
	82	if (fgets(line, 200, stdin) == NULL) {
	83	if (!gotPartial) {
	84	if (tty) {
	85	Tcl_Eval(interp, "destroy .", 0, (char **) NULL);
	86	exit(0);
	87	} else {
	88	Tk_DeleteFileHandler(0);
	89	}
	90	return;
	91	} else {
	92	line[0] = 0;
	93	}
	94	}
	95	cmd = Tcl_AssembleCmd(buffer, line);
	96	if (cmd == NULL) {
	97	gotPartial = 1;
	98	return;
	99	}
	100	gotPartial = 0;
	101	result = Tcl_RecordAndEval(interp, cmd, 0);
	102	if (*interp->result != 0) {
	103	if ((result != TCL_OK) \|\| (tty)) {
	104	printf("%s\n", interp->result);
	105	}
	106	}
	107	if (tty) {
	108	printf("wish: ");
	109	fflush(stdout);
	110	}
	111	}
	112	}
	113
	114	/* ARGSUSED */
	115	static void
	116	StructureProc(clientData, eventPtr)
	117	ClientData clientData; /* Information about window. */
	118	XEvent eventPtr; / Information about event. */
	119	{
	120	if (eventPtr->type == DestroyNotify) {
	121	w = NULL;
	122	}
	123	}
	124
	125	/*
	126	* Procedure to map initial window. This is invoked as a do-when-idle
	127	* handler. Wait for all other when-idle handlers to be processed
	128	* before mapping the window, so that the window's correct geometry
	129	* has been determined.
	130	*/
	131
	132	/* ARGSUSED */
	133	static void
	134	DelayedMap(clientData)
	135	ClientData clientData; /* Not used. */
	136	{
	137
	138	while (Tk_DoOneEvent(TK_IDLE_EVENTS) != 0) {
	139	/* Empty loop body. */
	140	}
	141	if (w == NULL) {
	142	return;
	143	}
	144	Tk_MapWindow(w);
	145	}
	146
	147	/* ARGSUSED */
	148	int
	149	DotCmd(dummy, interp, argc, argv)
	150	ClientData dummy; /* Not used. */
	151	Tcl_Interp interp; / Current interpreter. */
	152	int argc; /* Number of arguments. */
	153	char *argv; / Argument strings. */
	154	{
	155	int x, y;
	156
	157	if (argc != 3) {
	158	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
	159	" x y\"", (char *) NULL);
	160	return TCL_ERROR;
	161	}
	162	x = strtol(argv[1], (char **) NULL, 0);
	163	y = strtol(argv[2], (char **) NULL, 0);
	164	Tk_MakeWindowExist(w);
	165	XDrawPoint(Tk_Display(w), Tk_WindowId(w),
	166	DefaultGCOfScreen(Tk_Screen(w)), x, y);
	167	return TCL_OK;
	168	}
	169
	170	/* ARGSUSED */
	171	int
	172	MovetoCmd(dummy, interp, argc, argv)
	173	ClientData dummy; /* Not used. */
	174	Tcl_Interp interp; / Current interpreter. */
	175	int argc; /* Number of arguments. */
	176	char *argv; / Argument strings. */
	177	{
	178	if (argc != 3) {
	179	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
	180	" x y\"", (char *) NULL);
	181	return TCL_ERROR;
	182	}
	183	x = strtol(argv[1], (char **) NULL, 0);
	184	y = strtol(argv[2], (char **) NULL, 0);
	185	return TCL_OK;
	186	}
	187	/* ARGSUSED */
	188	int
	189	LinetoCmd(dummy, interp, argc, argv)
	190	ClientData dummy; /* Not used. */
	191	Tcl_Interp interp; / Current interpreter. */
	192	int argc; /* Number of arguments. */
	193	char *argv; / Argument strings. */
	194	{
	195	int newX, newY;
	196
	197	if (argc != 3) {
	198	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
	199	" x y\"", (char *) NULL);
	200	return TCL_ERROR;
	201	}
	202	newX = strtol(argv[1], (char **) NULL, 0);
	203	newY = strtol(argv[2], (char **) NULL, 0);
	204	Tk_MakeWindowExist(w);
	205	XDrawLine(Tk_Display(w), Tk_WindowId(w),
	206	DefaultGCOfScreen(Tk_Screen(w)), x, y, newX, newY);
	207	x = newX;
	208	y = newY;
	209	return TCL_OK;
	210	}
	211
	212	int
	213	main(argc, argv)
	214	int argc;
	215	char **argv;
	216	{
	217	char args, p, *msg;
	218	char buf[20];
	219	int result;
	220	Tk_3DBorder border;
	221
	222	{ extern char TCL_Library, TK_Library;
	223	extern int TK_CreateColormap;
	224	char *tcllib = getenv("TCL_LIBRARY");
	225	char *tklib = getenv("TK_LIBRARY");
	226	char *create = getenv("CREATE_COLORMAP");
	227	if (tklib != NULL)
	228	TK_Library = tklib;
	229	if (tcllib != NULL)
	230	TCL_Library = tcllib;
	231	if (create != NULL)
	232	TK_CreateColormap = 1;
	233	}
	234
	235	interp = Tcl_CreateInterp();
	236	#ifdef TCL_MEM_DEBUG
	237	Tcl_InitMemory(interp);
	238	#endif
	239	if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
	240	!= TCL_OK) {
	241	fprintf(stderr, "%s\n", interp->result);
	242	exit(1);
	243	}
	244	if (name == NULL) {
	245	if (fileName != NULL) {
	246	p = fileName;
	247	} else {
	248	p = argv[0];
	249	}
	250	name = strrchr(p, '/');
	251	if (name != NULL) {
	252	name++;
	253	} else {
	254	name = p;
	255	}
	256	}
	257	w = Tk_CreateMainWindow(interp, display, name);
	258	if (w == NULL) {
	259	fprintf(stderr, "%s\n", interp->result);
	260	exit(1);
	261	}
	262	Tk_SetClass(w, "Tk");
	263	Tk_CreateEventHandler(w, StructureNotifyMask, StructureProc,
	264	(ClientData) NULL);
	265	Tk_DoWhenIdle(DelayedMap, (ClientData) NULL);
	266	tty = isatty(0);
	267
	268	args = Tcl_Merge(argc-1, argv+1);
	269	Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
	270	ckfree(args);
	271	sprintf(buf, "%d", argc-1);
	272	Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
	273
	274	if (synchronize) {
	275	XSynchronize(Tk_Display(w), True);
	276	}
	277	Tk_GeometryRequest(w, 200, 200);
	278	border = Tk_Get3DBorder(interp, w, None, "#4eee94");
	279	if (border == NULL) {
	280	Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
	281	Tk_SetWindowBackground(w, WhitePixelOfScreen(Tk_Screen(w)));
	282	} else {
	283	Tk_SetBackgroundFromBorder(w, border);
	284	}
	285	XSetForeground(Tk_Display(w), DefaultGCOfScreen(Tk_Screen(w)),
	286	BlackPixelOfScreen(Tk_Screen(w)));
	287	Tcl_CreateCommand(interp, "dot", DotCmd, (ClientData) w,
	288	(void (*)()) NULL);
	289	Tcl_CreateCommand(interp, "lineto", LinetoCmd, (ClientData) w,
	290	(void (*)()) NULL);
	291	Tcl_CreateCommand(interp, "moveto", MovetoCmd, (ClientData) w,
	292	(void (*)()) NULL);
	293	#ifdef SQUARE_DEMO
	294	Tcl_CreateCommand(interp, "square", Tk_SquareCmd, (ClientData) w,
	295	(void (*)()) NULL);
	296	#endif
	297	if (geometry != NULL) {
	298	Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
	299	}
	300	result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);
	301	if (result != TCL_OK) {
	302	goto error;
	303	}
	304	if (fileName != NULL) {
	305	result = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
	306	if (result != TCL_OK) {
	307	goto error;
	308	}
	309	tty = 0;
	310	} else {
	311	tty = isatty(0);
	312	Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
	313	if (tty) {
	314	printf("wish: ");
	315	}
	316	}
	317	fflush(stdout);
	318	buffer = Tcl_CreateCmdBuf();
	319	(void) Tcl_Eval(interp, "update", 0, (char **) NULL);
	320
	321	Tk_MainLoop();
	322	Tcl_DeleteInterp(interp);
	323	Tcl_DeleteCmdBuf(buffer);
	324	exit(0);
	325
	326	error:
	327	msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
	328	if (msg == NULL) {
	329	msg = interp->result;
	330	}
	331	fprintf(stderr, "%s\n", msg);
	332	Tcl_Eval(interp, "destroy .", 0, (char **) NULL);
	333	exit(1);
	334	}