WebSVN – Vertical – Blame – /branches/metal/mktclapp/mktclapp.c

Rev	Author	Line No.	Line
2	mjames	1	static char const rcsid[] = "@(#) $Id: mktclapp.c,v 1.1.1.1 2003/11/04 23:35:00 mjames Exp $";
		2	/*
		3	** Copyright (c) 1998, 1999 D. Richard Hipp
		4	**
		5	** This program is free software; you can redistribute it and/or
		6	** modify it under the terms of the GNU General Public
		7	** License as published by the Free Software Foundation; either
		8	** version 2 of the License, or (at your option) any later version.
		9	**
		10	** This program is distributed in the hope that it will be useful,
		11	** but WITHOUT ANY WARRANTY; without even the implied warranty of
		12	** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
		13	** General Public License for more details.
		14	**
		15	** You should have received a copy of the GNU General Public
		16	** License along with this library; if not, write to the
		17	** Free Software Foundation, Inc., 59 Temple Place - Suite 330,
		18	** Boston, MA 02111-1307, USA.
		19	**
		20	** Author contact information:
		21	** drh@acm.org
		22	** http://www.hwaci.com/drh/
		23	*/
		24	#include <ctype.h>
		25	#include <stdio.h>
		26	#include <stdlib.h>
		27	#include <string.h>
		28	#include <sys/stat.h>
		29	#if defined(_WIN32) \|\| defined(WIN32)
		30	#include <windows.h>
		31	#if !defined(R_OK)
		32	#define R_OK 4
		33	#endif
		34	#else
		35	#include <unistd.h>
		36	#endif
		37	#include <assert.h>
		38	#include <time.h>
		39
		40	/*
		41	** Version information for this program
		42	*/
		43	static char zVersion[] = "mktclapp version 3.9. January 30, 2000";
		44
		45	/*
		46	** Each new TCL commands discovered while scanning C/C++ source code is
		47	** stored in an instance of the following structure.
		48	*/
		49	typedef struct EtCmd EtCmd;
		50	struct EtCmd
		51	{
		52	char zIf; / Surrounding #if statement */
		53	char zName; / Name of the command */
		54	int isObj; /* True if this is a Tcl_Obj command */
		55	EtCmd pNext; / Next command on a list of them all */
		56	};
		57
		58	/*
		59	** This is a list of all TCL commands in the scanned source
		60	*/
		61	static EtCmd *cmdList = 0;
		62
		63	/*
		64	** Number of commands and object commands.
		65	*/
		66	static int nCmd = 0;
		67	static int nObjCmd = 0;
		68
		69	/*
		70	** Each nested "#if" statement is stored as an instance of the
		71	** following structure.
		72	*/
		73	typedef struct IfStmt IfStmt;
		74	struct IfStmt
		75	{
		76	char zArg; / Argument to the #if. Ex: "defined(DEBUG)" */
		77	int invert; /* True to put a "!" in front */
		78	int line; /* Line number of the original #if */
		79	IfStmt pNext; / Next #if statement down on the stack */
		80	};
		81
		82	/*
		83	** The nested #if statements
		84	*/
		85	static IfStmt *ifStack = 0;
		86
		87	/*
		88	** Name of this program.
		89	*/
		90	static char *Argv0 = "mktclapp";
		91
		92	/*
		93	** Number of errors
		94	*/
		95	static int nError = 0;
		96
		97	/*
		98	** Surround the call to Et_AppInit() with this #if
		99	*/
		100	static char *seenEtAppInit = "0";
		101
		102	/*
		103	** Surround the call to Et_PreInit() with this #if
		104	*/
		105	static char *seenEtPreInit = "0";
		106
		107	/*
		108	** Surround the implmentation of main() with the inverse of this #if
		109	*/
		110	static char *seenMain = "0";
		111
		112	/*
		113	** Surround the call to Et_CustomMainLoop() with the inverse of this #if
		114	*/
		115	static char *seenEtCustomMainLoop = "0";
		116
		117	/*
		118	** Allocate memory. Never fail. If not enough memory is available,
		119	** print an error message and abort.
		120	*/
		121	void *SafeMalloc (int nByte)
		122	{
		123	void *p = malloc (nByte);
		124	if (p == 0)
		125	{
		126	fprintf (stderr, "Out of memory. Can't allocate %d bytes\n", nByte);
		127	exit (1);
		128	}
		129	memset (p, 0, nByte);
		130	return p;
		131	}
		132	void SafeRealloc (void old, int nByte)
		133	{
		134	void *p;
		135	if (old == 0)
		136	return SafeMalloc (nByte);
		137	p = realloc (old, nByte);
		138	if (p == 0)
		139	{
		140	fprintf (stderr, "Out of memory. Can't allocate %d bytes\n", nByte);
		141	exit (1);
		142	}
		143	return p;
		144	}
		145
		146	/*
		147	** The opposite of SafeMalloc(). Free memory previously obtained.
		148	*/
		149	void SafeFree (void *pMem)
		150	{
		151	if (pMem)
		152	free (pMem);
		153	}
		154
		155	/*
		156	** Return TRUE if the given character can be part of a C identifier.
		157	*/
		158	static int IsIdent (int c)
		159	{
		160	return isalnum (c) \|\| c == '_';
		161	}
		162
		163	/*
		164	** Create an "#if" argument that captures the state of all nested
		165	** "#if" statements, ORed with "zExtra". Space to hold
		166	** the returned string is obtained from SafeMalloc and must be
		167	** freed by the calling function.
		168	**
		169	** If the conditional is always TRUE, then NULL is returned.
		170	*/
		171	static char IfString (char zExtra)
		172	{
		173	int len = 0;
		174	IfStmt *p;
		175	char *z;
		176	int i;
		177	int isStackTrue = 1;
		178	int isStackFalse = 0;
		179	int isExtraFalse = 0;
		180	char *zSep;
		181	IfStmt *altStack;
		182
		183	if (zExtra && *zExtra)
		184	{
		185	if (zExtra[1] == 0 && zExtra[0] == '0')
		186	{
		187	isExtraFalse = 1;
		188	}
		189	else if (zExtra[1] == 0 && zExtra[0] == '1')
		190	{
		191	return 0;
		192	}
		193	len = strlen (zExtra) + 10;
		194	}
		195	else
		196	{
		197	len = 1;
		198	isExtraFalse = 1;
		199	}
		200	for (p = ifStack; p; p = p->pNext)
		201	{
		202	len += strlen (p->zArg) + 6;
		203	if (p->zArg[0] == '0' && p->zArg[1] == 0)
		204	{
		205	if (!p->invert)
		206	{
		207	isStackFalse = 1;
		208	isStackTrue = 0;
		209	break;
		210	}
		211	}
		212	else if (p->zArg[0] == '1' && p->zArg[1] == 0)
		213	{
		214	if (p->invert)
		215	{
		216	isStackFalse = 1;
		217	isStackTrue = 0;
		218	break;
		219	}
		220	}
		221	else
		222	{
		223	isStackTrue = 0;
		224	}
		225	}
		226	if (isStackTrue)
		227	{
		228	return 0;
		229	}
		230	else if (isStackFalse && isExtraFalse)
		231	{
		232	z = SafeMalloc (2);
		233	strcpy (z, "0");
		234	return z;
		235	}
		236	z = SafeMalloc (len);
		237	if (!isExtraFalse)
		238	{
		239	sprintf (z, "(%s) \|\| (", zExtra);
		240	i = strlen (z);
		241	}
		242	else
		243	{
		244	i = 0;
		245	}
		246	zSep = "";
		247	altStack = 0;
		248	while (ifStack)
		249	{
		250	p = ifStack;
		251	ifStack = p->pNext;
		252	p->pNext = altStack;
		253	altStack = p;
		254	}
		255	for (p = altStack; p; p = p->pNext)
		256	{
		257	if (p->zArg[0] == '0' && p->zArg[1] == 0 && p->invert)
		258	continue;
		259	if (p->zArg[0] == '1' && p->zArg[1] == 0 && !p->invert)
		260	continue;
		261	if (p->invert)
		262	{
		263	sprintf (&z[i], "%s!%s", zSep, p->zArg);
		264	}
		265	else
		266	{
		267	sprintf (&z[i], "%s%s", zSep, p->zArg);
		268	}
		269	i += strlen (&z[i]);
		270	zSep = " && ";
		271	}
		272	while (altStack)
		273	{
		274	p = altStack;
		275	altStack = p->pNext;
		276	p->pNext = ifStack;
		277	ifStack = p;
		278	}
		279	if (!isExtraFalse)
		280	{
		281	sprintf (&z[i], ")");
		282	}
		283	return z;
		284	}
		285
		286	/*
		287	** Push a new "#if" onto the if stack.
		288	*/
		289	static void PushIf (char *zArg, int line, int isNegated, int isDefined)
		290	{
		291	char *z;
		292	IfStmt *p;
		293	if (!isDefined)
		294	{
		295	int i;
		296	z = SafeMalloc (strlen (zArg) + 3);
		297	for (i = 0; zArg[i] && IsIdent (zArg[i]); i++)
		298	{
		299	}
		300	if (zArg[i] == 0)
		301	{
		302	sprintf (z, "%s", zArg);
		303	}
		304	else
		305	{
		306	sprintf (z, "(%s)", zArg);
		307	}
		308	}
		309	else
		310	{
		311	z = SafeMalloc (strlen (zArg) + 10);
		312	sprintf (z, "defined(%s)", zArg);
		313	}
		314	p = SafeMalloc (sizeof (IfStmt));
		315	p->zArg = z;
		316	p->line = line;
		317	p->invert = isNegated;
		318	p->pNext = ifStack;
		319	ifStack = p;
		320	}
		321
		322	/*
		323	** Extract the argument to an #if. Remove all leading and trailing
		324	** space.
		325	*/
		326	static char GetArg (const char fileName, char z, int pI, int *pLine)
		327	{
		328	int i = *pI;
		329	int line = *pLine;
		330	int start;
		331	char *zResult;
		332	int j, k;
		333
		334	while (isspace (z[i]) && z[i] != '\n')
		335	{
		336	i++;
		337	}
		338	start = i;
		339	if (z[i] == '\n' \|\| z[i] == 0)
		340	{
		341	fprintf (
		342	stderr, "%s: Missing argument to \"#if\" on line %d\n", fileName, *pLine);
		343	nError++;
		344	line++;
		345	}
		346	else
		347	{
		348	while (z[i] && z[i] != '\n')
		349	{
		350	if (z[i] == '\\' && z[i + 1] != 0)
		351	{
		352	i++;
		353	}
		354	if (z[i] == '\n')
		355	{
		356	line++;
		357	}
		358	i++;
		359	}
		360	}
		361	zResult = SafeMalloc (i + 1 - start);
		362	for (j = 0, k = start; k < i; k++)
		363	{
		364	if (isspace (z[k]) && j > 0 && isspace (zResult[j - 1]))
		365	{
		366	/* Do nothing */
		367	}
		368	else if (z[k] == '\\' && z[k + 1] == '\n')
		369	{
		370	if (j > 0 && !isspace (zResult[j - 1]))
		371	{
		372	zResult[j++] = ' ';
		373	}
		374	k++;
		375	}
		376	else if (z[k] == '\\')
		377	{
		378	zResult[j++] = z[k++];
		379	}
		380	zResult[j++] = z[k];
		381	}
		382	zResult[j] = 0;
		383	while (j > 0 && isspace (zResult[j - 1]))
		384	{
		385	j--;
		386	zResult[j] = 0;
		387	}
		388	*pI = i;
		389	*pLine = line;
		390	return zResult;
		391	}
		392
		393	/*
		394	** Read the complete text of a file into memory. Return 0 if there
		395	** is any kind of error.
		396	*/
		397	char ReadFileIntoMemory (const char fileName, int *pLength)
		398	{
		399	FILE in; / Input file stream */
		400	char textBuf; / A buffer in which to put entire text of input */
		401	int toRead; /* Amount of input file read to read */
		402	int got; /* Amount read so far */
		403	struct stat statBuf; /* Status buffer for the file */
		404
		405	if (stat (fileName, &statBuf) != 0)
		406	{
		407	fprintf (stderr, "%s: no such file: %s\n", Argv0, fileName);
		408	return 0;
		409	}
		410	textBuf = SafeMalloc (statBuf.st_size + 1);
		411	in = fopen (fileName, "rb");
		412	if (in == 0)
		413	{
		414	fprintf (stderr, "%s: can't open for reading: %s\n", Argv0, fileName);
		415	SafeFree (textBuf);
		416	return 0;
		417	}
		418	textBuf[statBuf.st_size] = 0;
		419	toRead = statBuf.st_size;
		420	got = 0;
		421	while (toRead)
		422	{
		423	int n = fread (&textBuf[got], 1, toRead, in);
		424	if (n <= 0)
		425	break;
		426	toRead -= n;
		427	got += n;
		428	}
		429	fclose (in);
		430	textBuf[got] = 0;
		431	if (pLength)
		432	*pLength = got;
		433	return textBuf;
		434	}
		435
		436	/*
		437	** Given the "aaaa" part of the name of an ET_COMMAND_aaaa function,
		438	** compute the name of the corresponding Tcl command.
		439	**
		440	** The name is usually the same, except if there are two underscores
		441	** in the middle of the command, they are changed to colons. This
		442	** feature allows namespaces to be used. Example: The function
		443	** named
		444	**
		445	** ET_COMMAND_space1__proc1(ET_TCLARGS){...}
		446	**
		447	** will generate a TCL command called
		448	**
		449	** space1::proc1
		450	**
		451	** Space to hold the TCL command name is obtained from malloc().
		452	*/
		453	static char FuncToProc (char zFunc)
		454	{
		455	char *zProc;
		456	int i;
		457
		458	zProc = SafeMalloc (strlen (zFunc) + 1);
		459	strcpy (zProc, zFunc);
		460	for (i = 0; zProc[i]; i++)
		461	{
		462	if (i > 0 && zProc[i] == '_' && zProc[i + 1] == '_' &&
		463	isalnum (zProc[i - 1]) && isalnum (zProc[i + 2]))
		464	{
		465	zProc[i] = ':';
		466	zProc[i + 1] = ':';
		467	}
		468	}
		469	return zProc;
		470	}
		471
		472	/*
		473	** Scan a source file looking for new TCL commands and/or the Et_AppInit()
		474	** or Et_PreInit() functions.
		475	**
		476	** Skip all comments, and any text contained within "#if 0".."#endif"
		477	*/
		478	void ScanFile (const char *fileName)
		479	{
		480	char z; / Complete text of the file, NULL terminated. */
		481	int i, j;
		482	int inBrace = 0;
		483	int line = 1;
		484
		485	z = ReadFileIntoMemory (fileName, 0);
		486	if (z == 0)
		487	{
		488	nError++;
		489	return;
		490	}
		491	for (i = 0; z[i]; i++)
		492	{
		493	switch (z[i])
		494	{
		495	case '\n':
		496	line++;
		497	break;
		498	case '/':
		499	/* This might be a comment. If it is, skip it. */
		500	if (z[i + 1] == '*')
		501	{
		502	int start = line;
		503	i += 2;
		504	while (z[i] && (z[i] != '*' \|\| z[i + 1] != '/'))
		505	{
		506	if (z[i] == '\n')
		507	line++;
		508	i++;
		509	}
		510	if (z[i] == 0)
		511	{
		512	fprintf (
		513	stderr,
		514	"%s: Unterminated comment beginning on line %d\n",
		515	fileName,
		516	start);
		517	nError++;
		518	}
		519	else
		520	{
		521	i++;
		522	}
		523	}
		524	else if (z[i + 1] == '/')
		525	{
		526	while (z[i] && z[i] != '\n')
		527	{
		528	i++;
		529	}
		530	if (z[i])
		531	{
		532	line++;
		533	};
		534	}
		535	break;
		536	case '\'':
		537	{
		538	/* Skip character literals */
		539	int start = line;
		540	for (i++; z[i] && z[i] != '\''; i++)
		541	{
		542	if (z[i] == '\n')
		543	{
		544	fprintf (
		545	stderr,
		546	"%s: Newline in character literal on line %d\n",
		547	fileName,
		548	start);
		549	line++;
		550	}
		551	if (z[i] == '\\')
		552	i++;
		553	}
		554	if (z[i] == 0)
		555	{
		556	fprintf (
		557	stderr,
		558	"%s: unterminate character literal on line %d\n",
		559	fileName,
		560	start);
		561	nError++;
		562	}
		563	break;
		564	}
		565	case '"':
		566	{
		567	/* Skip over a string */
		568	int start = line;
		569	for (i++; z[i] && z[i] != '"'; i++)
		570	{
		571	if (z[i] == '\n')
		572	{
		573	fprintf (
		574	stderr,
		575	"%s: Newline in string literal on line %d\n",
		576	fileName,
		577	start);
		578	line++;
		579	}
		580	if (z[i] == '\\')
		581	i++;
		582	}
		583	if (z[i] == 0)
		584	{
		585	fprintf (
		586	stderr,
		587	"%s: unterminate string literal on line %d\n",
		588	fileName,
		589	start);
		590	nError++;
		591	}
		592	break;
		593	}
		594	case '#':
		595	/* This might be a preprocessor macro such as #if 0 or #endif */
		596	if (i > 0 && z[i - 1] != '\n')
		597	break;
		598	for (j = i + 1; isspace (z[j]); j++)
		599	{
		600	}
		601	if (strncmp (&z[j], "endif", 5) == 0)
		602	{
		603	if (ifStack == 0)
		604	{
		605	fprintf (
		606	stderr,
		607	"%s: Unmatched \"#endif\" on line %d\n",
		608	fileName,
		609	line);
		610	nError++;
		611	}
		612	else
		613	{
		614	IfStmt *p = ifStack;
		615	ifStack = p->pNext;
		616	SafeFree (p->zArg);
		617	SafeFree (p);
		618	}
		619	break;
		620	}
		621	if (strncmp (&z[j], "else", 4) == 0)
		622	{
		623	if (ifStack == 0)
		624	{
		625	fprintf (
		626	stderr,
		627	"%s: No \"#if\" to pair with \"#else\" on line "
		628	"%d\n",
		629	fileName,
		630	line);
		631	nError++;
		632	}
		633	else
		634	{
		635	ifStack->invert = !ifStack->invert;
		636	}
		637	break;
		638	}
		639	if (z[j] != 'i' \|\| z[j + 1] != 'f')
		640	break;
		641	if (strncmp (&z[j + 2], "ndef", 4) == 0)
		642	{
		643	char *zArg;
		644	int start = line;
		645	i = j + 6;
		646	zArg = GetArg (fileName, z, &i, &line);
		647	PushIf (zArg, start, 1, 1);
		648	SafeFree (zArg);
		649	}
		650	else if (strncmp (&z[j + 2], "def", 3) == 0)
		651	{
		652	char *zArg;
		653	int start = line;
		654	i = j + 5;
		655	zArg = GetArg (fileName, z, &i, &line);
		656	PushIf (zArg, start, 0, 1);
		657	SafeFree (zArg);
		658	}
		659	else
		660	{
		661	char *zArg;
		662	int start = line;
		663	i = j + 2;
		664	zArg = GetArg (fileName, z, &i, &line);
		665	PushIf (zArg, start, 0, 0);
		666	SafeFree (zArg);
		667	}
		668	break;
		669	case '{':
		670	inBrace++;
		671	break;
		672	case '}':
		673	inBrace--;
		674	break;
		675	case 'm':
		676	/* Check main() */
		677	if (inBrace > 0)
		678	break;
		679	if (i > 0 && IsIdent (z[i - 1]))
		680	break;
		681	if (strncmp (&z[i], "main", 4) == 0 && !IsIdent (z[i + 4]))
		682	{
		683	seenMain = IfString (seenMain);
		684	}
		685	case 'E':
		686	/* Check ET_COMMAND_... or Et_AppInit or Et_PreInit */
		687	if (inBrace > 0)
		688	break;
		689	if (i > 0 && IsIdent (z[i - 1]))
		690	break;
		691	if (z[i + 1] == 'T' && strncmp (&z[i], "ET_COMMAND_", 11) == 0)
		692	{
		693	EtCmd *p;
		694	for (j = i + 11; IsIdent (z[j]); j++)
		695	{
		696	}
		697	p = SafeMalloc (sizeof (EtCmd));
		698	p->zIf = IfString (0);
		699	p->zName = SafeMalloc (j - (i + 9));
		700	sprintf (p->zName, "%.*s", j - (i + 11), &z[i + 11]);
		701	p->pNext = cmdList;
		702	cmdList = p;
		703	nCmd++;
		704	}
		705	else if (z[i + 1] == 'T' && strncmp (&z[i], "ET_OBJCOMMAND_", 14) == 0)
		706	{
		707	EtCmd *p;
		708	for (j = i + 14; IsIdent (z[j]); j++)
		709	{
		710	}
		711	p = SafeMalloc (sizeof (EtCmd));
		712	p->zIf = IfString (0);
		713	p->zName = SafeMalloc (j - (i + 9));
		714	p->isObj = 1;
		715	sprintf (p->zName, "%.*s", j - (i + 14), &z[i + 14]);
		716	p->pNext = cmdList;
		717	cmdList = p;
		718	nObjCmd++;
		719	}
		720	else if (z[i + 1] == 't')
		721	{
		722	if (strncmp (&z[i], "Et_AppInit", 10) == 0 &&
		723	!IsIdent (z[i + 10]))
		724	{
		725	seenEtAppInit = IfString (seenEtAppInit);
		726	}
		727	if (strncmp (&z[i], "Et_PreInit", 10) == 0 &&
		728	!IsIdent (z[i + 10]))
		729	{
		730	seenEtPreInit = IfString (seenEtPreInit);
		731	}
		732	if (strncmp (&z[i], "Et_CustomMainLoop", 17) == 0 &&
		733	!IsIdent (z[i + 17]))
		734	{
		735	seenEtCustomMainLoop = IfString (seenEtCustomMainLoop);
		736	}
		737	}
		738	break;
		739	default:
		740	/* Do nothing. Continue to the next character */
		741	break;
		742	}
		743	}
		744	SafeFree (z);
		745	while (ifStack)
		746	{
		747	IfStmt *p = ifStack;
		748	fprintf (stderr, "%s: unterminated \"#if\" on line %d\n", fileName, p->line);
		749	nError++;
		750	ifStack = p->pNext;
		751	SafeFree (p->zArg);
		752	SafeFree (p);
		753	}
		754	}
		755
		756	/*
		757	** Set a macro according to the value of an #if argument.
		758	*/
		759	static void SetMacro (char zMacroName, char zIf)
		760	{
		761	if (zIf == 0 \|\| *zIf == 0)
		762	{
		763	printf ("#define %s 1\n", zMacroName);
		764	}
		765	else if (zIf[0] == '0' && zIf[1] == 0)
		766	{
		767	printf ("#define %s 0\n", zMacroName);
		768	}
		769	else
		770	{
		771	printf (
		772	"#if %s\n"
		773	"# define %s 1\n"
		774	"#else\n"
		775	"# define %s 0\n"
		776	"#endif\n",
		777	zIf,
		778	zMacroName,
		779	zMacroName);
		780	}
		781	}
		782
		783	/* Forward declaration...*/
		784	static void WriteAsString (char *, int);
		785
		786	/*
		787	** Set a string macro to the value given, if that value is not NULL.
		788	*/
		789	static void SetStringMacro (char zMacroName, char z)
		790	{
		791	if (z == 0 \|\| *z == 0)
		792	return;
		793	printf ("#define %s ", zMacroName);
		794	WriteAsString (z, 0);
		795	}
		796
		797	/*
		798	** Look at the name of the file given and see if it is a Tcl file
		799	** or a C or C++ source file. Return TRUE for TCL and FALSE for
		800	** C or C++.
		801	*/
		802	static int IsTclFile (char *zFile)
		803	{
		804	static char *azCSuffix[] = {".c", ".cc", ".C", ".cpp", ".CPP", ".cxx", ".CXX"};
		805	int len = strlen (zFile);
		806	int i;
		807	for (i = 0; i < sizeof (azCSuffix) / sizeof (azCSuffix[0]); i++)
		808	{
		809	int len2 = strlen (azCSuffix[i]);
		810	if (len > len2 && strcmp (&zFile[len - len2], azCSuffix[i]) == 0)
		811	{
		812	return 0;
		813	}
		814	}
		815	return 1;
		816	}
		817
		818	/*
		819	** Compress a TCL script by removing comments and excess white-space
		820	*/
		821	static void CompressTcl (char *z)
		822	{
		823	int i, j, c;
		824	int atLineStart = 1;
		825	for (i = j = 0; (c = z[i]) != 0; i++)
		826	{
		827	switch (c)
		828	{
		829	case ' ':
		830	case '\t':
		831	case '\r':
		832	if (atLineStart)
		833	{
		834	c = 0;
		835	}
		836	break;
		837	case '#':
		838	if (atLineStart && !isalpha (z[i + 1]) &&
		839	strncmp (z, "# @(#)", 6) != 0)
		840	{
		841	while (z[i] && z[i] != '\n')
		842	{
		843	if (z[i] == '\\')
		844	{
		845	i++;
		846	if (z[i] == '\r' && z[i + 1] == '\n')
		847	{
		848	i++;
		849	}
		850	}
		851	i++;
		852	}
		853	c = 0;
		854	if (z[i] == 0)
		855	{
		856	i--;
		857	}
		858	}
		859	else
		860	{
		861	atLineStart = 0;
		862	}
		863	break;
		864	case '\n':
		865	if (atLineStart)
		866	{
		867	c = 0;
		868	}
		869	else if (
		870	(i > 0 && z[i - 1] == '\\') \|\|
		871	(i > 1 && z[i - 1] == '\r' && z[i - 2] == '\\'))
		872	{
		873	/* The line continues. Do not compress.
		874	** Compressing here breaks BWidgets... */
		875	}
		876	else
		877	{
		878	atLineStart = 1;
		879	}
		880	break;
		881	default:
		882	atLineStart = 0;
		883	break;
		884	}
		885	if (c != 0)
		886	{
		887	z[j++] = c;
		888	}
		889	}
		890	z[j] = 0;
		891	}
		892
		893	/*
		894	** Write the text of the given file as a string. Tcl-style comments
		895	** are removed if the doCompress flag is true.
		896	*/
		897	static void WriteAsString (char *z, int shroud)
		898	{
		899	int c;
		900	int priorc = 0;
		901	int xor ;
		902	int atLineStart = 1;
		903	if (shroud > 0)
		904	{
		905	xor = shroud;
		906	}
		907	putchar ('"');
		908	atLineStart = 0;
		909	while ((c = *z) != 0)
		910	{
		911	z++;
		912	if (c == '\r' && *z == '\n')
		913	continue;
		914	if (shroud > 0 && c >= 0x20)
		915	{
		916	c ^= xor;
		917	xor = (xor+1) & 0x1f;
		918	}
		919	if (atLineStart)
		920	{
		921	putchar ('"');
		922	atLineStart = 0;
		923	}
		924	switch (c)
		925	{
		926	case '?':
		927	/* Prevent two "?" characters in a row, as this causes problems
		928	** for compilers that interpret trigraphs */
		929	if (c == priorc)
		930	{
		931	putchar ('\\');
		932	putchar (((c >> 6) & 3) + '0');
		933	putchar (((c >> 3) & 7) + '0');
		934	putchar ((c & 7) + '0');
		935	c = 0;
		936	}
		937	else
		938	{
		939	putchar (c);
		940	}
		941	break;
		942	case '"':
		943	case '\\':
		944	putchar ('\\');
		945	putchar (c);
		946	break;
		947	case '\n':
		948	putchar ('\\');
		949	putchar ('n');
		950	putchar ('"');
		951	putchar ('\n');
		952	atLineStart = 1;
		953	break;
		954	default:
		955	if (c < ' ' \|\| c > '~')
		956	{
		957	putchar ('\\');
		958	putchar (((c >> 6) & 3) + '0');
		959	putchar (((c >> 3) & 7) + '0');
		960	putchar ((c & 7) + '0');
		961	}
		962	else
		963	{
		964	putchar (c);
		965	}
		966	break;
		967	}
		968	priorc = c;
		969	}
		970	if (!atLineStart)
		971	{
		972	putchar ('"');
		973	putchar ('\n');
		974	}
		975	}
		976
		977	/*
		978	** The header string.
		979	*/
		980	static char zHeader[] = "/* Automatically generated code */\n"
		981	"/* DO NOT EDIT */\n"
		982	"#ifndef ET_TCLARGS\n"
		983	"#include <tcl.h>\n"
		984	"#ifdef __cplusplus\n"
		985	"# define ET_EXTERN extern \"C\"\n"
		986	"#else\n"
		987	"# define ET_EXTERN extern\n"
		988	"#endif\n"
		989	"ET_EXTERN char mprintf(const char,...);\n"
		990	"ET_EXTERN char vmprintf(const char,...);\n"
		991	"ET_EXTERN int Et_EvalF(Tcl_Interp,const char ,...);\n"
		992	"ET_EXTERN int Et_GlobalEvalF(Tcl_Interp,const char ,...);\n"
		993	"ET_EXTERN int Et_DStringAppendF(Tcl_DString,const char,...);\n"
		994	"ET_EXTERN int Et_ResultF(Tcl_Interp,const char,...);\n"
		995	"ET_EXTERN int Et_Init(int,char**);\n"
		996	"ET_EXTERN Tcl_Interp *Et_Interp;\n"
		997	"#if TCL_RELEASE_VERSION>=8\n"
		998	"ET_EXTERN int Et_AppendObjF(Tcl_Obj,const char,...);\n"
		999	"#endif\n"
		1000	"#define ET_TCLARGS "
		1001	"ClientData clientData,Tcl_Interpinterp,int argc,char*argv\n"
		1002	"#define ET_OBJARGS "
		1003	"ClientData clientData,Tcl_Interpinterp,int objc,Tcl_Obj CONST "
		1004	"objv[]\n"
		1005	"#endif\n";
		1006
		1007	/*
		1008	** Print a usage comment and die
		1009	*/
		1010	static void Usage (char *argv0)
		1011	{
		1012	fprintf (stderr, "Usage: %s arguments...\n", argv0);
		1013	fprintf (
		1014	stderr,
		1015	" -version print the version number of mktclapp and exit\n"
		1016	" -header print a header file and exit\n"
		1017	" -srcdir DIR Prepend DIR to all relative pathnames\n"
		1018	" -notk built a Tcl-only program. No GUI\n"
		1019	" -extension NAME build a Tcl/Tk extension with the given name\n"
		1020	" -autofork automatically fork the program into the background\n"
		1021	" -strip-tcl remove comments and extra white-space from\n"
		1022	" subsequent TCL files\n"
		1023	" -dont-strip-tcl stop stripping TCL files\n"
		1024	" -tcl-library DIR directory holding the TCL script library\n"
		1025	" -tk-library DIR directory holding the TK script library\n"
		1026	" -main-script FILE run the script FILE after initialization\n"
		1027	" -read-stdin read standard input\n"
		1028	" -console create a console window\n"
		1029	" -shroud hide compile-in TCL from view\n"
		1030	" -enable-obj use TCL Obj commands where possible\n"
		1031	" -standalone make the \"source\" TCL command only work\n"
		1032	" for builtin scripts\n"
		1033	" -f FILE read more command-line parameters from FILE\n"
		1034	" -i FILE make the binary file FILE part of the C code\n"
		1035	" *.c scan this file for new TCL commands\n"
		1036	" *.tcl compile this file into the generated C code\n");
		1037	exit (1);
		1038	}
		1039
		1040	/*
		1041	** Read one or more characters form "in" that follow a \ and
		1042	** interpret them appropriately. Return the character that
		1043	** results from this interpretation.
		1044	*/
		1045	static int EscapeChar (FILE *in)
		1046	{
		1047	int c, d;
		1048	c = getc (in);
		1049	switch (c)
		1050	{
		1051	case 'n':
		1052	c = '\n';
		1053	break;
		1054	case 'r':
		1055	c = '\r';
		1056	break;
		1057	case 'f':
		1058	c = '\f';
		1059	break;
		1060	case 't':
		1061	c = '\t';
		1062	break;
		1063	case 'b':
		1064	c = '\b';
		1065	break;
		1066	case 'a':
		1067	c = '\a';
		1068	break;
		1069	case '0':
		1070	case '1':
		1071	case '2':
		1072	case '3':
		1073	case '4':
		1074	case '5':
		1075	case '6':
		1076	case '7':
		1077	c -= '0';
		1078	d = getc (in);
		1079	if (d < '0' \|\| d > '7')
		1080	{
		1081	ungetc (d, in);
		1082	break;
		1083	}
		1084	c = (c << 3) + (d - '0');
		1085	if (d < '0' \|\| d > '7')
		1086	{
		1087	ungetc (d, in);
		1088	break;
		1089	}
		1090	c = (c << 3) + (d - '0');
		1091	break;
		1092	default:
		1093	break;
		1094	}
		1095	return c;
		1096	}
		1097
		1098	/* MS-Windows and MS-DOS both have the following serious OS bug: the
		1099	** length of a command line is severely restricted. But this program
		1100	** occasionally requires long command lines. Hence the following
		1101	** work around.
		1102	**
		1103	** If the parameters "-f FILENAME" appear anywhere on the command line,
		1104	** then the named file is scanned for additional command line arguments.
		1105	** These arguments are substituted in place of the "FILENAME" argument
		1106	** in the original argument list.
		1107	**
		1108	** This first parameter to this routine is the index of the "-f"
		1109	** parameter in the argv[] array. The argc and argv are passed by
		1110	** pointer so that they can be changed.
		1111	**
		1112	** Parsing of the parameters in the file is very simple. Parameters
		1113	** can be separated by any amount of white-space (including newlines
		1114	** and carriage returns.) " and ' can be used for quoting strings
		1115	** with embedded spaces. The \ character escapes the following character.
		1116	** The length of a token is limited to about 1000 characters.
		1117	*/
		1118	static void AddParameters (int index, int pArgc, char **pArgv)
		1119	{
		1120	int argc = pArgc; / The original argc value */
		1121	char *argv = pArgv; /* The original argv value */
		1122	int newArgc; /* Value for argc after inserting new arguments */
		1123	char *zNew; / The new argv after this routine is done */
		1124	char zFile; / Name of the input file */
		1125	int nNew = 0; /* Number of new entries in the argv[] file */
		1126	int nAlloc = 0; /* Space allocated for zNew[] */
		1127	int i; /* Loop counter */
		1128	int n; /* Number of characters in a new argument */
		1129	int c; /* Next character of input */
		1130	int startOfLine = 1; /* True if we are where '#' can start a comment */
		1131	FILE in; / The input file */
		1132	char zBuf[1000]; /* A single argument is accumulated here */
		1133
		1134	if (index + 1 == argc)
		1135	return;
		1136	zFile = argv[index + 1];
		1137	in = fopen (zFile, "r");
		1138	if (in == 0)
		1139	{
		1140	fprintf (stderr, "Can't open input file \"%s\"\n", zFile);
		1141	exit (1);
		1142	}
		1143	c = ' ';
		1144	while (c != EOF)
		1145	{
		1146	while (c != EOF && isspace (c))
		1147	{
		1148	if (c == '\n')
		1149	{
		1150	startOfLine = 1;
		1151	}
		1152	c = getc (in);
		1153	if (startOfLine && c == '#')
		1154	{
		1155	while (c != EOF && c != '\n')
		1156	{
		1157	c = getc (in);
		1158	}
		1159	}
		1160	}
		1161	n = 0;
		1162	if (c == '\'' \|\| c == '"')
		1163	{
		1164	int quote = c;
		1165	c = getc (in);
		1166	startOfLine = 0;
		1167	while (c != EOF && c != quote)
		1168	{
		1169	if (c == '\\')
		1170	c = EscapeChar (in);
		1171	if (n < sizeof (zBuf) - 1)
		1172	{
		1173	zBuf[n++] = c;
		1174	}
		1175	c = getc (in);
		1176	}
		1177	if (c != EOF)
		1178	c = getc (in);
		1179	}
		1180	else
		1181	{
		1182	while (c != EOF && !isspace (c))
		1183	{
		1184	if (c == '\\')
		1185	c = EscapeChar (in);
		1186	if (n < sizeof (zBuf) - 1)
		1187	{
		1188	zBuf[n++] = c;
		1189	}
		1190	startOfLine = 0;
		1191	c = getc (in);
		1192	}
		1193	}
		1194	zBuf[n] = 0;
		1195	if (n > 0)
		1196	{
		1197	nNew++;
		1198	if (nNew + argc >= nAlloc)
		1199	{
		1200	if (nAlloc == 0)
		1201	{
		1202	nAlloc = 100 + argc;
		1203	zNew = malloc (sizeof (char ) nAlloc);
		1204	}
		1205	else
		1206	{
		1207	nAlloc *= 2;
		1208	zNew = realloc (zNew, sizeof (char ) nAlloc);
		1209	}
		1210	}
		1211	if (zNew)
		1212	{
		1213	int j = nNew + index;
		1214	zNew[j] = malloc (n + 1);
		1215	if (zNew[j])
		1216	{
		1217	strcpy (zNew[j], zBuf);
		1218	}
		1219	}
		1220	}
		1221	}
		1222	if (nNew > 0)
		1223	{
		1224	newArgc = argc + nNew - 1;
		1225	for (i = 0; i <= index; i++)
		1226	{
		1227	zNew[i] = argv[i];
		1228	}
		1229	}
		1230	else
		1231	{
		1232	zNew = argv;
		1233	}
		1234	for (i = nNew + index + 1; i < newArgc; i++)
		1235	{
		1236	zNew[i] = argv[i + 1 - nNew];
		1237	}
		1238	zNew[newArgc] = 0;
		1239	*pArgc = newArgc;
		1240	*pArgv = zNew;
		1241	}
		1242
		1243	int main (int argc, char **argv)
		1244	{
		1245	int i; /* Loop counter */
		1246	EtCmd pCmd; / A new TCL command found in C code */
		1247	int useTk = 1; /* False if the -notk flag is used */
		1248	int autoFork = 0; /* True if the -autofork flag is used */
		1249	int nTcl = 0; /* Number of TCL scripts */
		1250	char *azTcl; / Name of all TCL scripts */
		1251	int aDoCompress; / Whether or not to compress each TCL script */
		1252	int nData = 0; /* Number of data files */
		1253	char *azData; / Names of all data files */
		1254	int doCompress = 1; /* Current state of the compression flag */
		1255	char zTclLib = 0; / Name of the TCL library */
		1256	char zTkLib = 0; / Name of the TK library */
		1257	char zMainScript = 0; / Name of a script to run first */
		1258	int shroud = 0; /* True to encrypt the compiled-in TCL */
		1259	int readStdin = 0; /* True to read TCL commands from STDIN */
		1260	int enableObj = 0; /* Enable the use of object commands */
		1261	int standalone = 0; /* True to disable the "source" command */
		1262	int stringify = 0; /* True to output only strings of the scripts */
		1263	int console = 0; /* True to put up a debugging console */
		1264	char zExtension = 0; / Name of the extension. NULL if a complete app */
		1265	int nHash; /* Number of entries in hash table */
		1266	extern char zTail[];
		1267
		1268	if (argc >= 2 && strcmp (argv[1], "-header") == 0)
		1269	{
		1270	printf ("%s", zHeader);
		1271	return 0;
		1272	}
		1273	if (argc >= 2 && strcmp (argv[1], "-version") == 0)
		1274	{
		1275	printf ("%s\n", zVersion);
		1276	return 0;
		1277	}
		1278	azTcl = SafeMalloc (sizeof (char ) (argc + 100));
		1279	azData = SafeMalloc (sizeof (char ) (argc + 100));
		1280	aDoCompress = SafeMalloc (sizeof (int) * (argc + 100));
		1281	for (i = 1; i < argc; i++)
		1282	{
		1283	if (argv[i][0] == '-')
		1284	{
		1285	if (strcmp (argv[i], "-header") == 0)
		1286	{
		1287	printf ("%s", zHeader);
		1288	return 0;
		1289	}
		1290	else if (strcmp (argv[i], "-notk") == 0)
		1291	{
		1292	useTk = 0;
		1293	}
		1294	else if (i < argc - 1 && strcmp (argv[i], "-extension") == 0)
		1295	{
		1296	zExtension = argv[++i];
		1297	}
		1298	else if (strcmp (argv[i], "-autofork") == 0)
		1299	{
		1300	autoFork = 1;
		1301	}
		1302	else if (strcmp (argv[i], "-read-stdin") == 0)
		1303	{
		1304	readStdin = 1;
		1305	}
		1306	else if (strcmp (argv[i], "-console") == 0)
		1307	{
		1308	console = 1;
		1309	}
		1310	else if (strcmp (argv[i], "-shroud") == 0)
		1311	{
		1312	shroud = 1;
		1313	}
		1314	else if (strcmp (argv[i], "-strip-tcl") == 0)
		1315	{
		1316	doCompress = 1;
		1317	}
		1318	else if (strcmp (argv[i], "-dont-strip-tcl") == 0)
		1319	{
		1320	doCompress = 0;
		1321	}
		1322	else if (strcmp (argv[i], "-enable-obj") == 0)
		1323	{
		1324	enableObj = 1;
		1325	}
		1326	else if (strcmp (argv[i], "-standalone") == 0)
		1327	{
		1328	standalone = 1;
		1329	}
		1330	else if (strcmp (argv[i], "-stringify") == 0)
		1331	{
		1332	stringify = 1;
		1333	}
		1334	else if (i < argc - 1 && strcmp (argv[i], "-srcdir") == 0)
		1335	{
		1336	chdir (argv[++i]);
		1337	}
		1338	else if (i < argc - 1 && strcmp (argv[i], "-main-script") == 0)
		1339	{
		1340	zMainScript = argv[++i];
		1341	}
		1342	else if (i < argc - 1 && strcmp (argv[i], "-tcl-library") == 0)
		1343	{
		1344	zTclLib = argv[++i];
		1345	}
		1346	else if (i < argc - 1 && strcmp (argv[i], "-tk-library") == 0)
		1347	{
		1348	zTkLib = argv[++i];
		1349	}
		1350	else if (i < argc - 1 && strcmp (argv[i], "-i") == 0)
		1351	{
		1352	i++;
		1353	if (access (argv[i], R_OK))
		1354	{
		1355	fprintf (
		1356	stderr,
		1357	"%s: can't open \"%s\" for reading\n",
		1358	Argv0,
		1359	argv[i]);
		1360	nError++;
		1361	}
		1362	else
		1363	{
		1364	azData[nData] = argv[i];
		1365	}
		1366	nData++;
		1367	}
		1368	else if (strcmp (argv[i], "-f") == 0)
		1369	{
		1370	AddParameters (i, &argc, &argv);
		1371	azTcl = SafeRealloc (azTcl, sizeof (char ) (argc + 100));
		1372	azData = SafeRealloc (azData, sizeof (char ) (argc + 100));
		1373	aDoCompress =
		1374	SafeRealloc (aDoCompress, sizeof (int) * (argc + 100));
		1375	}
		1376	else
		1377	{
		1378	Usage (argv[0]);
		1379	}
		1380	}
		1381	else if (IsTclFile (argv[i]))
		1382	{
		1383	if (access (argv[i], R_OK))
		1384	{
		1385	fprintf (
		1386	stderr,
		1387	"%s: can't open \"%s\" for reading\n",
		1388	Argv0,
		1389	argv[i]);
		1390	nError++;
		1391	}
		1392	else
		1393	{
		1394	int len = strlen (argv[i]);
		1395	azTcl[nTcl] = argv[i];
		1396	if (len >= 9 && strcmp (&argv[i][len - 9], "/tclIndex") == 0)
		1397	{
		1398	aDoCompress[nTcl] = 0;
		1399	}
		1400	else
		1401	{
		1402	aDoCompress[nTcl] = doCompress;
		1403	}
		1404	nTcl++;
		1405	}
		1406	}
		1407	else
		1408	{
		1409	ScanFile (argv[i]);
		1410	}
		1411	}
		1412	if (nError > 0)
		1413	return nError;
		1414	if (shroud > 0)
		1415	{
		1416	shroud = time (0) % 31 + 1;
		1417	}
		1418	if (stringify)
		1419	{
		1420	for (i = 0; i < nTcl; i++)
		1421	{
		1422	char *z;
		1423	z = ReadFileIntoMemory (azTcl[i], 0);
		1424	if (z == 0)
		1425	continue;
		1426	if (aDoCompress[i])
		1427	CompressTcl (z);
		1428	WriteAsString (z, shroud);
		1429	printf (";\n");
		1430	SafeFree (z);
		1431	}
		1432	return 0;
		1433	}
		1434	if (nObjCmd > 0)
		1435	enableObj = 1;
		1436	printf ("/* This code is automatically generated by \"mktclapp\""
		1437	" version 3.9 */\n"
		1438	"/* DO NOT EDIT */\n"
		1439	"#include <tcl.h>\n"
		1440	"#define INTERFACE 1\n"
		1441	"#if INTERFACE\n"
		1442	"#define ET_TCLARGS "
		1443	"ClientData clientData,Tcl_Interpinterp,int argc,char*argv\n"
		1444	"#define ET_OBJARGS "
		1445	"ClientData clientData,Tcl_Interpinterp,int objc,Tcl_ObjCONST objv[]\n"
		1446	"#endif\n");
		1447	printf ("#define ET_ENABLE_OBJ %d\n", enableObj);
		1448	printf ("#define ET_ENABLE_TK %d\n", useTk != 0);
		1449	printf ("#define ET_AUTO_FORK %d\n", autoFork != 0);
		1450	printf ("#define ET_STANDALONE %d\n", standalone != 0);
		1451	printf ("#define ET_N_BUILTIN_SCRIPT %d\n", nTcl);
		1452	printf ("#define ET_VERSION \"3.9\"\n");
		1453	SetMacro ("ET_HAVE_APPINIT", seenEtAppInit);
		1454	SetMacro ("ET_HAVE_PREINIT", seenEtPreInit);
		1455	SetMacro ("ET_HAVE_MAIN", seenMain);
		1456	SetMacro ("ET_HAVE_CUSTOM_MAINLOOP", seenEtCustomMainLoop);
		1457	SetStringMacro ("ET_TCL_LIBRARY", zTclLib);
		1458	SetStringMacro ("ET_TK_LIBRARY", zTkLib);
		1459	SetStringMacro ("ET_MAIN_SCRIPT", zMainScript);
		1460	if (zExtension)
		1461	{
		1462	int i;
		1463	if (islower (zExtension[0]))
		1464	{
		1465	zExtension[0] = toupper (zExtension[0]);
		1466	}
		1467	for (i = 1; zExtension[i]; i++)
		1468	{
		1469	if (isupper (zExtension[i]))
		1470	{
		1471	zExtension[i] = tolower (zExtension[i]);
		1472	}
		1473	}
		1474	printf ("#define ET_EXTENSION_NAME %s_Init\n", zExtension);
		1475	printf ("#define ET_SAFE_EXTENSION_NAME %s_SafeInit\n", zExtension);
		1476	printf ("#define ET_EXTENSION 1\n");
		1477	}
		1478	else
		1479	{
		1480	printf ("#define ET_EXTENSION 0\n");
		1481	}
		1482	printf ("#define ET_SHROUD_KEY %d\n", shroud);
		1483	printf ("#define ET_READ_STDIN %d\n", readStdin);
		1484	printf ("#define ET_CONSOLE %d\n", console);
		1485	for (pCmd = cmdList; pCmd; pCmd = pCmd->pNext)
		1486	{
		1487	if (pCmd->zIf && pCmd->zIf[0] == '0' && pCmd->zIf[1] == 0)
		1488	continue;
		1489	if (pCmd->isObj)
		1490	{
		1491	printf ("extern int ET_OBJCOMMAND_%s(ET_OBJARGS);\n", pCmd->zName);
		1492	}
		1493	else
		1494	{
		1495	printf ("extern int ET_COMMAND_%s(ET_TCLARGS);\n", pCmd->zName);
		1496	}
		1497	}
		1498	printf ("static struct {\n"
		1499	" char *zName;\n"
		1500	" int (*xProc)(ET_TCLARGS);\n"
		1501	"} Et_CmdSet[] = {\n");
		1502	for (pCmd = cmdList; pCmd; pCmd = pCmd->pNext)
		1503	{
		1504	char *zProc;
		1505	if (pCmd->isObj)
		1506	continue;
		1507	if (pCmd->zIf)
		1508	{
		1509	if (pCmd->zIf[0] == '0' && pCmd->zIf[1] == 0)
		1510	continue;
		1511	printf ("#if %s\n", pCmd->zIf);
		1512	}
		1513	zProc = FuncToProc (pCmd->zName);
		1514	printf (" { \"%s\", ET_COMMAND_%s },\n", zProc, pCmd->zName);
		1515	SafeFree (zProc);
		1516	if (pCmd->zIf)
		1517	{
		1518	printf ("#endif\n");
		1519	}
		1520	}
		1521	printf ("{0, 0}};\n");
		1522	if (enableObj)
		1523	{
		1524	char *zProc;
		1525	printf ("static struct {\n"
		1526	" char *zName;\n"
		1527	" int (*xProc)(ET_OBJARGS);\n"
		1528	"} Et_ObjSet[] = {\n");
		1529	for (pCmd = cmdList; pCmd; pCmd = pCmd->pNext)
		1530	{
		1531	if (!pCmd->isObj)
		1532	continue;
		1533	if (pCmd->zIf)
		1534	{
		1535	if (pCmd->zIf[0] == '0' && pCmd->zIf[1] == 0)
		1536	continue;
		1537	printf ("#if %s\n", pCmd->zIf);
		1538	}
		1539	zProc = FuncToProc (pCmd->zName);
		1540	printf (" { \"%s\", ET_OBJCOMMAND_%s },\n", zProc, pCmd->zName);
		1541	SafeFree (zProc);
		1542	if (pCmd->zIf)
		1543	{
		1544	printf ("#endif\n");
		1545	}
		1546	}
		1547	printf ("{0, 0}};\n");
		1548	}
		1549	for (i = 0; i < nTcl; i++)
		1550	{
		1551	char *z;
		1552	printf ("static char Et_zFile%d[] = \n", i);
		1553	z = ReadFileIntoMemory (azTcl[i], 0);
		1554	if (z == 0)
		1555	continue;
		1556	if (aDoCompress[i])
		1557	CompressTcl (z);
		1558	WriteAsString (z, shroud);
		1559	printf (";\n");
		1560	SafeFree (z);
		1561	}
		1562	for (i = 0; i < nData; i++)
		1563	{
		1564	char *z;
		1565	int len, j, col;
		1566	printf ("static unsigned char Et_acData%d[] = {\n", i);
		1567	z = ReadFileIntoMemory (azData[i], &len);
		1568	if (z == 0)
		1569	continue;
		1570	for (j = col = 0; j < len; j++)
		1571	{
		1572	printf (" 0x%02x,", z[j] & 0xff);
		1573	if (++col >= 12)
		1574	{
		1575	printf ("\n");
		1576	col = 0;
		1577	}
		1578	}
		1579	if (col > 0)
		1580	printf ("\n");
		1581	printf ("};\n");
		1582	SafeFree (z);
		1583	}
		1584	printf ("struct EtFile {\n"
		1585	" char *zName;\n"
		1586	" char *zData;\n"
		1587	" int nData;\n"
		1588	" int shrouded;\n"
		1589	" struct EtFile *pNext;\n"
		1590	"};\n"
		1591	"static struct EtFile Et_FileSet[] = {\n");
		1592	for (i = 0; i < nTcl; i++)
		1593	{
		1594	printf (
		1595	" { \"%s\", Et_zFile%d, sizeof(Et_zFile%d)-1, %d, 0 },\n",
		1596	azTcl[i],
		1597	i,
		1598	i,
		1599	shroud);
		1600	}
		1601	for (i = 0; i < nData; i++)
		1602	{
		1603	printf (
		1604	" { \"%s\", Et_acData%d, sizeof(Et_acData%d), 0, 0 },\n",
		1605	azData[i],
		1606	i,
		1607	i);
		1608	}
		1609	fflush (stdout);
		1610	nHash = nTcl * 2 + 1;
		1611	if (nHash < 71)
		1612	{
		1613	nHash = 71;
		1614	}
		1615	printf (
		1616	"{0, 0}};\n"
		1617	"static struct EtFile *Et_FileHashTable[%d];\n"
		1618	"%s",
		1619	nHash,
		1620	zTail);
		1621	return nError;
		1622	}
		1623
		1624	char zTail[] =
		1625	"/* The following copyright notice applies to code generated by\n"
		1626	"** \"mktclapp\". The \"mktclapp\" program itself is covered by the\n"
		1627	"** GNU Public License.\n"
		1628	"**\n"
		1629	"** Copyright (c) 1998 D. Richard Hipp\n"
		1630	"**\n"
		1631	"** The author hereby grants permission to use, copy, modify, distribute,\n"
		1632	"** and license this software and its documentation for any purpose, provided\n"
		1633	"** that existing copyright notices are retained in all copies and that this\n"
		1634	"** notice is included verbatim in any distributions. No written agreement,\n"
		1635	"** license, or royalty fee is required for any of the authorized uses.\n"
		1636	"** Modifications to this software may be copyrighted by their authors\n"
		1637	"** and need not follow the licensing terms described here, provided that\n"
		1638	"** the new terms are clearly indicated on the first page of each file where\n"
		1639	"** they apply.\n"
		1640	"**\n"
		1641	"** In no event shall the author or the distributors be liable to any party\n"
		1642	"** for direct, indirect, special, incidental, or consequential damages\n"
		1643	"** arising out of the use of this software, its documentation, or any\n"
		1644	"** derivatives thereof, even if the author has been advised of the \n"
		1645	"** possibility of such damage. The author and distributors specifically\n"
		1646	"** disclaim any warranties, including but not limited to the implied\n"
		1647	"** warranties of merchantability, fitness for a particular purpose, and\n"
		1648	"** non-infringment. This software is provided at no fee on an\n"
		1649	"** \"as is\" basis. The author and/or distritutors have no obligation\n"
		1650	"** to provide maintenance, support, updates, enhancements and/or\n"
		1651	"** modifications.\n"
		1652	"**\n"
		1653	"** GOVERNMENT USE: If you are acquiring this software on behalf of the\n"
		1654	"** U.S. government, the Government shall have only \"Restricted Rights\"\n"
		1655	"** in the software and related documentation as defined in the Federal \n"
		1656	"** Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you\n"
		1657	"** are acquiring the software on behalf of the Department of Defense, the\n"
		1658	"** software shall be classified as \"Commercial Computer Software\" and the\n"
		1659	"** Government shall have only \"Restricted Rights\" as defined in Clause\n"
		1660	"** 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the\n"
		1661	"** author grants the U.S. Government and others acting in its behalf\n"
		1662	"** permission to use and distribute the software in accordance with the\n"
		1663	"** terms specified in this license. \n"
		1664	"*/\n"
		1665	"#include <ctype.h>\n"
		1666	"#include <string.h>\n"
		1667	"#include <stdarg.h>\n"
		1668	"#include <stdio.h>\n"
		1669	"#include <stdlib.h>\n"
		1670	"#include <sys/types.h>\n"
		1671	"#include <sys/stat.h>\n"
		1672	"#include <fcntl.h>\n"
		1673	"\n"
		1674	"/* Include either the Tcl or the Tk header file. Use the \"Internal\"\n"
		1675	"** version of the header file if and only if we are generating an\n"
		1676	"** extension that is linking against the Stub library.\n"
		1677	"** Many installations do not have the internal header files\n"
		1678	"** available, so using the internal headers only when absolutely\n"
		1679	"** necessary will help to reduce compilation problems.\n"
		1680	"*/\n"
		1681	"#if ET_EXTENSION && defined(TCL_USE_STUBS)\n"
		1682	"# if ET_ENABLE_TK\n"
		1683	"# include <tkInt.h>\n"
		1684	"# else\n"
		1685	"# include <tclInt.h>\n"
		1686	"# endif\n"
		1687	"#else\n"
		1688	"# if ET_ENABLE_TK\n"
		1689	"# include <tk.h>\n"
		1690	"# else\n"
		1691	"# include <tcl.h>\n"
		1692	"# endif\n"
		1693	"#endif\n"
		1694	"\n"
		1695	"/*\n"
		1696	"** ET_WIN32 is true if we are running Tk under windows. The\n"
		1697	"** <tcl.h> module will define __WIN32__ for us if we are compiling\n"
		1698	"** for windows.\n"
		1699	"*/\n"
		1700	"#if defined(__WIN32__) && ET_ENABLE_TK\n"
		1701	"# define ET_WIN32 1\n"
		1702	"# include <windows.h>\n"
		1703	"#else\n"
		1704	"# define ET_WIN32 0\n"
		1705	"#endif\n"
		1706	"\n"
		1707	"/*\n"
		1708	"** Always disable ET_AUTO_FORK under windows. Windows doesn't\n"
		1709	"** fork well.\n"
		1710	"*/\n"
		1711	"#if defined(__WIN32__)\n"
		1712	"# undef ET_AUTO_FORK\n"
		1713	"# define ET_AUTO_FORK 0\n"
		1714	"#endif\n"
		1715	"\n"
		1716	"/*\n"
		1717	"** Omit <unistd.h> under windows. But we need it for Unix.\n"
		1718	"*/\n"
		1719	"#if !defined(__WIN32__)\n"
		1720	"# include <unistd.h>\n"
		1721	"#endif\n"
		1722	"\n"
		1723	"/*\n"
		1724	"** The Tcl*InsertProc functions allow the system calls \"stat\",\n"
		1725	"** \"access\" and \"open\" to be overloaded. This in turns allows us\n"
		1726	"** to substituted compiled-in strings for files in the filesystem.\n"
		1727	"** But the Tcl*InsertProc functions are only available in Tcl8.0.3\n"
		1728	"** and later.\n"
		1729	"**\n"
		1730	"** Define the ET_HAVE_INSERTPROC macro if and only if we are dealing\n"
		1731	"** with Tcl8.0.3 or later.\n"
		1732	"*/\n"
		1733	"#if TCL_MAJOR_VERSION==8 && (TCL_MINOR_VERSION>0 \|\| TCL_RELEASE_SERIAL>=3)\n"
		1734	"# define ET_HAVE_INSERTPROC\n"
		1735	"#endif\n"
		1736	"\n"
		1737	"/*\n"
		1738	"** If we are using the Tcl*InsertProc() functions, we should provide\n"
		1739	"** prototypes for them. But the prototypes are in the tclInt.h include\n"
		1740	"** file, which we don't want to require the user to have on hand. So\n"
		1741	"** we provide our own prototypes here.\n"
		1742	"**\n"
		1743	"** Note that if TCL_USE_STUBS is defined, then the tclInt.h is required\n"
		1744	"** anyway, so these prototypes are not included if TCL_USE_STUBS is\n"
		1745	"** defined. \n"
		1746	"*/\n"
		1747	"#if defined(ET_HAVE_INSERTPROC) && !defined(TCL_USE_STUBS)\n"
		1748	"#ifdef __cplusplus\n"
		1749	" extern \"C\" int TclStatInsertProc(int ()(char, struct stat *));\n"
		1750	" extern \"C\" int TclAccessInsertProc(int ()(char, int));\n"
		1751	" extern \"C\" int TclOpenFileChannelInsertProc(Tcl_Channel ()(Tcl_Interp,char*,\n"
		1752	" char*,int));\n"
		1753	"#else\n"
		1754	" extern int TclStatInsertProc(int ()(char, struct stat *));\n"
		1755	" extern int TclAccessInsertProc(int ()(char, int));\n"
		1756	" extern int TclOpenFileChannelInsertProc(Tcl_Channel ()(Tcl_Interp,char*,\n"
		1757	" char*,int));\n"
		1758	"#endif\n"
		1759	"#endif\n"
		1760	"\n"
		1761	"\n"
		1762	"/*\n"
		1763	"** Don't allow Win32 applications to read from stdin. Nor\n"
		1764	"** programs that automatically go into the background. Force\n"
		1765	"** the use of a console in these cases.\n"
		1766	"*/\n"
		1767	"#if (ET_WIN32 \|\| ET_AUTO_FORK) && ET_READ_STDIN\n"
		1768	"# undef ET_READ_STDIN\n"
		1769	"# undef ET_CONSOLE\n"
		1770	"# define ET_READ_STDIN 0\n"
		1771	"# define ET_CONSOLE 1\n"
		1772	"#endif\n"
		1773	"\n"
		1774	"/*\n"
		1775	"** The console won't work without Tk.\n"
		1776	"*/\n"
		1777	"#if ET_ENABLE_TK==0 && ET_CONSOLE\n"
		1778	"# undef ET_CONSOLE\n"
		1779	"# define ET_CONSOLE 0\n"
		1780	"# undef ET_READ_STDIN\n"
		1781	"# define ET_READ_STDIN 1\n"
		1782	"#endif\n"
		1783	"\n"
		1784	"/*\n"
		1785	"** Set ET_HAVE_OBJ to true if we are able to link against the\n"
		1786	"** new Tcl_Obj interface. This is only the case for Tcl version\n"
		1787	"** 8.0 and later.\n"
		1788	"*/\n"
		1789	"#if ET_ENABLE_OBJ \|\| TCL_MAJOR_VERSION>=8\n"
		1790	"# define ET_HAVE_OBJ 1\n"
		1791	"#else\n"
		1792	"# define ET_HAVE_OBJ 0\n"
		1793	"#endif\n"
		1794	"\n"
		1795	"/*\n"
		1796	"** The Tcl_GetByteArrayFromObj() only appears in Tcl version 8.1\n"
		1797	"** and later. Substitute Tcl_GetStringFromObj() in Tcl version 8.0.X\n"
		1798	"*/\n"
		1799	"#if ET_HAVE_OBJ && TCL_MINOR_VERSION==0\n"
		1800	"# define Tcl_GetByteArrayFromObj Tcl_GetStringFromObj\n"
		1801	"#endif\n"
		1802	"\n"
		1803	"/*\n"
		1804	"** Tcl code to implement the console.\n"
		1805	"**\n"
		1806	"** This code is written and tested separately, then run through\n"
		1807	"** \"mktclapp -stringify\" and then pasted in here.\n"
		1808	"*/\n"
		1809	"#if ET_ENABLE_TK && !ET_EXTENSION\n"
		1810	"static char zEtConsole[] =\n"
		1811	"\"proc console:create {w prompt title} {\\n\"\n"
		1812	"\"upvar #0 $w.t v\\n\"\n"
		1813	"\"if {[winfo exists $w]} {destroy $w}\\n\"\n"
		1814	"\"catch {unset v}\\n\"\n"
		1815	"\"toplevel $w\\n\"\n"
		1816	"\"wm title $w $title\\n\"\n"
		1817	"\"wm iconname $w $title\\n\"\n"
		1818	"\"frame $w.mb -bd 2 -relief raised\\n\"\n"
		1819	"\"pack $w.mb -side top -fill x\\n\"\n"
		1820	"\"menubutton $w.mb.file -text File -menu $w.mb.file.m\\n\"\n"
		1821	"\"menubutton $w.mb.edit -text Edit -menu $w.mb.edit.m\\n\"\n"
		1822	"\"pack $w.mb.file $w.mb.edit -side left -padx 8 -pady 1\\n\"\n"
		1823	"\"set m [menu $w.mb.file.m]\\n\"\n"
		1824	"\"$m add command -label {Source...} -command \\\"console:SourceFile $w.t\\\"\\n\"\n"
		1825	"\"$m add command -label {Save As...} -command \\\"console:SaveFile $w.t\\\"\\n\"\n"
		1826	"\"$m add separator\\n\"\n"
		1827	"\"$m add command -label {Close} -command \\\"destroy $w\\\"\\n\"\n"
		1828	"\"$m add command -label {Exit} -command exit\\n\"\n"
		1829	"\"set m [menu $w.mb.edit.m]\\n\"\n"
		1830	"\"$m add command -label Cut -command \\\"console:Cut $w.t\\\"\\n\"\n"
		1831	"\"$m add command -label Copy -command \\\"console:Copy $w.t\\\"\\n\"\n"
		1832	"\"$m add command -label Paste -command \\\"console:Paste $w.t\\\"\\n\"\n"
		1833	"\"$m add command -label {Clear Screen} -command \\\"console:Clear $w.t\\\"\\n\"\n"
		1834	"\"catch {$m config -postcommand \\\"console:EnableEditMenu $w\\\"}\\n\"\n"
		1835	"\"scrollbar $w.sb -orient vertical -command \\\"$w.t yview\\\"\\n\"\n"
		1836	"\"pack $w.sb -side right -fill y\\n\"\n"
		1837	"\"text $w.t -font fixed -yscrollcommand \\\"$w.sb set\\\"\\n\"\n"
		1838	"\"pack $w.t -side right -fill both -expand 1\\n\"\n"
		1839	"\"bindtags $w.t Console\\n\"\n"
		1840	"\"set v(text) $w.t\\n\"\n"
		1841	"\"set v(history) 0\\n\"\n"
		1842	"\"set v(historycnt) 0\\n\"\n"
		1843	"\"set v(current) -1\\n\"\n"
		1844	"\"set v(prompt) $prompt\\n\"\n"
		1845	"\"set v(prior) {}\\n\"\n"
		1846	"\"set v(plength) [string length $v(prompt)]\\n\"\n"
		1847	"\"set v(x) 0\\n\"\n"
		1848	"\"set v(y) 0\\n\"\n"
		1849	"\"$w.t mark set insert end\\n\"\n"
		1850	"\"$w.t tag config ok -foreground blue\\n\"\n"
		1851	"\"$w.t tag config err -foreground red\\n\"\n"
		1852	"\"$w.t insert end $v(prompt)\\n\"\n"
		1853	"\"$w.t mark set out 1.0\\n\"\n"
		1854	"\"catch {rename puts console:oldputs$w}\\n\"\n"
		1855	"\"proc puts args [format {\\n\"\n"
		1856	"\"if {![winfo exists %s]} {\\n\"\n"
		1857	"\"rename puts {}\\n\"\n"
		1858	"\"rename console:oldputs%s puts\\n\"\n"
		1859	"\"return [uplevel #0 puts $args]\\n\"\n"
		1860	"\"}\\n\"\n"
		1861	"\"switch -glob -- \\\"[llength $args] $args\\\" {\\n\"\n"
		1862	"\"{1 *} {\\n\"\n"
		1863	"\"set msg [lindex $args 0]\\\\n\\n\"\n"
		1864	"\"set tag ok\\n\"\n"
		1865	"\"}\\n\"\n"
		1866	"\"{2 stdout *} {\\n\"\n"
		1867	"\"set msg [lindex $args 1]\\\\n\\n\"\n"
		1868	"\"set tag ok\\n\"\n"
		1869	"\"}\\n\"\n"
		1870	"\"{2 stderr *} {\\n\"\n"
		1871	"\"set msg [lindex $args 1]\\\\n\\n\"\n"
		1872	"\"set tag err\\n\"\n"
		1873	"\"}\\n\"\n"
		1874	"\"{2 -nonewline *} {\\n\"\n"
		1875	"\"set msg [lindex $args 1]\\n\"\n"
		1876	"\"set tag ok\\n\"\n"
		1877	"\"}\\n\"\n"
		1878	"\"{3 -nonewline stdout *} {\\n\"\n"
		1879	"\"set msg [lindex $args 2]\\n\"\n"
		1880	"\"set tag ok\\n\"\n"
		1881	"\"}\\n\"\n"
		1882	"\"{3 -nonewline stderr *} {\\n\"\n"
		1883	"\"set msg [lindex $args 2]\\n\"\n"
		1884	"\"set tag err\\n\"\n"
		1885	"\"}\\n\"\n"
		1886	"\"default {\\n\"\n"
		1887	"\"uplevel #0 console:oldputs%s $args\\n\"\n"
		1888	"\"return\\n\"\n"
		1889	"\"}\\n\"\n"
		1890	"\"}\\n\"\n"
		1891	"\"console:Puts %s $msg $tag\\n\"\n"
		1892	"\"} $w $w $w $w.t]\\n\"\n"
		1893	"\"after idle \\\"focus $w.t\\\"\\n\"\n"
		1894	"\"}\\n\"\n"
		1895	"\"bind Console <1> {console:Button1 %W %x %y}\\n\"\n"
		1896	"\"bind Console <B1-Motion> {console:B1Motion %W %x %y}\\n\"\n"
		1897	"\"bind Console <B1-Leave> {console:B1Leave %W %x %y}\\n\"\n"
		1898	"\"bind Console <B1-Enter> {console:cancelMotor %W}\\n\"\n"
		1899	"\"bind Console <ButtonRelease-1> {console:cancelMotor %W}\\n\"\n"
		1900	"\"bind Console <KeyPress> {console:Insert %W %A}\\n\"\n"
		1901	"\"bind Console <Left> {console:Left %W}\\n\"\n"
		1902	"\"bind Console <Control-b> {console:Left %W}\\n\"\n"
		1903	"\"bind Console <Right> {console:Right %W}\\n\"\n"
		1904	"\"bind Console <Control-f> {console:Right %W}\\n\"\n"
		1905	"\"bind Console <BackSpace> {console:Backspace %W}\\n\"\n"
		1906	"\"bind Console <Control-h> {console:Backspace %W}\\n\"\n"
		1907	"\"bind Console <Delete> {console:Delete %W}\\n\"\n"
		1908	"\"bind Console <Control-d> {console:Delete %W}\\n\"\n"
		1909	"\"bind Console <Home> {console:Home %W}\\n\"\n"
		1910	"\"bind Console <Control-a> {console:Home %W}\\n\"\n"
		1911	"\"bind Console <End> {console:End %W}\\n\"\n"
		1912	"\"bind Console <Control-e> {console:End %W}\\n\"\n"
		1913	"\"bind Console <Return> {console:Enter %W}\\n\"\n"
		1914	"\"bind Console <KP_Enter> {console:Enter %W}\\n\"\n"
		1915	"\"bind Console <Up> {console:Prior %W}\\n\"\n"
		1916	"\"bind Console <Control-p> {console:Prior %W}\\n\"\n"
		1917	"\"bind Console <Down> {console:Next %W}\\n\"\n"
		1918	"\"bind Console <Control-n> {console:Next %W}\\n\"\n"
		1919	"\"bind Console <Control-k> {console:EraseEOL %W}\\n\"\n"
		1920	"\"bind Console <<Cut>> {console:Cut %W}\\n\"\n"
		1921	"\"bind Console <<Copy>> {console:Copy %W}\\n\"\n"
		1922	"\"bind Console <<Paste>> {console:Paste %W}\\n\"\n"
		1923	"\"bind Console <<Clear>> {console:Clear %W}\\n\"\n"
		1924	"\"proc console:Puts {w t tag} {\\n\"\n"
		1925	"\"set nc [string length $t]\\n\"\n"
		1926	"\"set endc [string index $t [expr $nc-1]]\\n\"\n"
		1927	"\"if {$endc==\\\"\\\\n\\\"} {\\n\"\n"
		1928	"\"if {[$w index out]<[$w index {insert linestart}]} {\\n\"\n"
		1929	"\"$w insert out [string range $t 0 [expr $nc-2]] $tag\\n\"\n"
		1930	"\"$w mark set out {out linestart +1 lines}\\n\"\n"
		1931	"\"} else {\\n\"\n"
		1932	"\"$w insert out $t $tag\\n\"\n"
		1933	"\"}\\n\"\n"
		1934	"\"} else {\\n\"\n"
		1935	"\"if {[$w index out]<[$w index {insert linestart}]} {\\n\"\n"
		1936	"\"$w insert out $t $tag\\n\"\n"
		1937	"\"} else {\\n\"\n"
		1938	"\"$w insert out $t\\\\n $tag\\n\"\n"
		1939	"\"$w mark set out {out -1 char}\\n\"\n"
		1940	"\"}\\n\"\n"
		1941	"\"}\\n\"\n"
		1942	"\"$w yview insert\\n\"\n"
		1943	"\"}\\n\"\n"
		1944	"\"proc console:Insert {w a} {\\n\"\n"
		1945	"\"$w insert insert $a\\n\"\n"
		1946	"\"$w yview insert\\n\"\n"
		1947	"\"}\\n\"\n"
		1948	"\"proc console:Left {w} {\\n\"\n"
		1949	"\"upvar #0 $w v\\n\"\n"
		1950	"\"scan [$w index insert] %d.%d row col\\n\"\n"
		1951	"\"if {$col>$v(plength)} {\\n\"\n"
		1952	"\"$w mark set insert \\\"insert -1c\\\"\\n\"\n"
		1953	"\"}\\n\"\n"
		1954	"\"}\\n\"\n"
		1955	"\"proc console:Backspace {w} {\\n\"\n"
		1956	"\"upvar #0 $w v\\n\"\n"
		1957	"\"scan [$w index insert] %d.%d row col\\n\"\n"
		1958	"\"if {$col>$v(plength)} {\\n\"\n"
		1959	"\"$w delete {insert -1c}\\n\"\n"
		1960	"\"}\\n\"\n"
		1961	"\"}\\n\"\n"
		1962	"\"proc console:EraseEOL {w} {\\n\"\n"
		1963	"\"upvar #0 $w v\\n\"\n"
		1964	"\"scan [$w index insert] %d.%d row col\\n\"\n"
		1965	"\"if {$col>=$v(plength)} {\\n\"\n"
		1966	"\"$w delete insert {insert lineend}\\n\"\n"
		1967	"\"}\\n\"\n"
		1968	"\"}\\n\"\n"
		1969	"\"proc console:Right {w} {\\n\"\n"
		1970	"\"$w mark set insert \\\"insert +1c\\\"\\n\"\n"
		1971	"\"}\\n\"\n"
		1972	"\"proc console:Delete w {\\n\"\n"
		1973	"\"$w delete insert\\n\"\n"
		1974	"\"}\\n\"\n"
		1975	"\"proc console:Home w {\\n\"\n"
		1976	"\"upvar #0 $w v\\n\"\n"
		1977	"\"scan [$w index insert] %d.%d row col\\n\"\n"
		1978	"\"$w mark set insert $row.$v(plength)\\n\"\n"
		1979	"\"}\\n\"\n"
		1980	"\"proc console:End w {\\n\"\n"
		1981	"\"$w mark set insert {insert lineend}\\n\"\n"
		1982	"\"}\\n\"\n"
		1983	"\"proc console:Enter w {\\n\"\n"
		1984	"\"upvar #0 $w v\\n\"\n"
		1985	"\"scan [$w index insert] %d.%d row col\\n\"\n"
		1986	"\"set start $row.$v(plength)\\n\"\n"
		1987	"\"set line [$w get $start \\\"$start lineend\\\"]\\n\"\n"
		1988	"\"if {$v(historycnt)>0} {\\n\"\n"
		1989	"\"set last [lindex $v(history) [expr $v(historycnt)-1]]\\n\"\n"
		1990	"\"if {[string compare $last $line]} {\\n\"\n"
		1991	"\"lappend v(history) $line\\n\"\n"
		1992	"\"incr v(historycnt)\\n\"\n"
		1993	"\"}\\n\"\n"
		1994	"\"} else {\\n\"\n"
		1995	"\"set v(history) [list $line]\\n\"\n"
		1996	"\"set v(historycnt) 1\\n\"\n"
		1997	"\"}\\n\"\n"
		1998	"\"set v(current) $v(historycnt)\\n\"\n"
		1999	"\"$w insert end \\\\n\\n\"\n"
		2000	"\"$w mark set out end\\n\"\n"
		2001	"\"if {$v(prior)==\\\"\\\"} {\\n\"\n"
		2002	"\"set cmd $line\\n\"\n"
		2003	"\"} else {\\n\"\n"
		2004	"\"set cmd $v(prior)\\\\n$line\\n\"\n"
		2005	"\"}\\n\"\n"
		2006	"\"if {[info complete $cmd]} {\\n\"\n"
		2007	"\"set rc [catch {uplevel #0 $cmd} res]\\n\"\n"
		2008	"\"if {![winfo exists $w]} return\\n\"\n"
		2009	"\"if {$rc} {\\n\"\n"
		2010	"\"$w insert end $res\\\\n err\\n\"\n"
		2011	"\"} elseif {[string length $res]>0} {\\n\"\n"
		2012	"\"$w insert end $res\\\\n ok\\n\"\n"
		2013	"\"}\\n\"\n"
		2014	"\"set v(prior) {}\\n\"\n"
		2015	"\"$w insert end $v(prompt)\\n\"\n"
		2016	"\"} else {\\n\"\n"
		2017	"\"set v(prior) $cmd\\n\"\n"
		2018	"\"regsub -all {[^ ]} $v(prompt) . x\\n\"\n"
		2019	"\"$w insert end $x\\n\"\n"
		2020	"\"}\\n\"\n"
		2021	"\"$w mark set insert end\\n\"\n"
		2022	"\"$w mark set out {insert linestart}\\n\"\n"
		2023	"\"$w yview insert\\n\"\n"
		2024	"\"}\\n\"\n"
		2025	"\"proc console:Prior w {\\n\"\n"
		2026	"\"upvar #0 $w v\\n\"\n"
		2027	"\"if {$v(current)<=0} return\\n\"\n"
		2028	"\"incr v(current) -1\\n\"\n"
		2029	"\"set line [lindex $v(history) $v(current)]\\n\"\n"
		2030	"\"console:SetLine $w $line\\n\"\n"
		2031	"\"}\\n\"\n"
		2032	"\"proc console:Next w {\\n\"\n"
		2033	"\"upvar #0 $w v\\n\"\n"
		2034	"\"if {$v(current)>=$v(historycnt)} return\\n\"\n"
		2035	"\"incr v(current) 1\\n\"\n"
		2036	"\"set line [lindex $v(history) $v(current)]\\n\"\n"
		2037	"\"console:SetLine $w $line\\n\"\n"
		2038	"\"}\\n\"\n"
		2039	"\"proc console:SetLine {w line} {\\n\"\n"
		2040	"\"upvar #0 $w v\\n\"\n"
		2041	"\"scan [$w index insert] %d.%d row col\\n\"\n"
		2042	"\"set start $row.$v(plength)\\n\"\n"
		2043	"\"$w delete $start end\\n\"\n"
		2044	"\"$w insert end $line\\n\"\n"
		2045	"\"$w mark set insert end\\n\"\n"
		2046	"\"$w yview insert\\n\"\n"
		2047	"\"}\\n\"\n"
		2048	"\"proc console:Button1 {w x y} {\\n\"\n"
		2049	"\"global tkPriv\\n\"\n"
		2050	"\"upvar #0 $w v\\n\"\n"
		2051	"\"set v(mouseMoved) 0\\n\"\n"
		2052	"\"set v(pressX) $x\\n\"\n"
		2053	"\"set p [console:nearestBoundry $w $x $y]\\n\"\n"
		2054	"\"scan [$w index insert] %d.%d ix iy\\n\"\n"
		2055	"\"scan $p %d.%d px py\\n\"\n"
		2056	"\"if {$px==$ix} {\\n\"\n"
		2057	"\"$w mark set insert $p\\n\"\n"
		2058	"\"}\\n\"\n"
		2059	"\"$w mark set anchor $p\\n\"\n"
		2060	"\"focus $w\\n\"\n"
		2061	"\"}\\n\"\n"
		2062	"\"proc console:nearestBoundry {w x y} {\\n\"\n"
		2063	"\"set p [$w index @$x,$y]\\n\"\n"
		2064	"\"set bb [$w bbox $p]\\n\"\n"
		2065	"\"if {![string compare $bb \\\"\\\"]} {return $p}\\n\"\n"
		2066	"\"if {($x-[lindex $bb 0])<([lindex $bb 2]/2)} {return $p}\\n\"\n"
		2067	"\"$w index \\\"$p + 1 char\\\"\\n\"\n"
		2068	"\"}\\n\"\n"
		2069	"\"proc console:SelectTo {w x y} {\\n\"\n"
		2070	"\"upvar #0 $w v\\n\"\n"
		2071	"\"set cur [console:nearestBoundry $w $x $y]\\n\"\n"
		2072	"\"if {[catch {$w index anchor}]} {\\n\"\n"
		2073	"\"$w mark set anchor $cur\\n\"\n"
		2074	"\"}\\n\"\n"
		2075	"\"set anchor [$w index anchor]\\n\"\n"
		2076	"\"if {[$w compare $cur != $anchor] \|\| (abs($v(pressX) - $x) >= 3)} {\\n\"\n"
		2077	"\"if {$v(mouseMoved)==0} {\\n\"\n"
		2078	"\"$w tag remove sel 0.0 end\\n\"\n"
		2079	"\"}\\n\"\n"
		2080	"\"set v(mouseMoved) 1\\n\"\n"
		2081	"\"}\\n\"\n"
		2082	"\"if {[$w compare $cur < anchor]} {\\n\"\n"
		2083	"\"set first $cur\\n\"\n"
		2084	"\"set last anchor\\n\"\n"
		2085	"\"} else {\\n\"\n"
		2086	"\"set first anchor\\n\"\n"
		2087	"\"set last $cur\\n\"\n"
		2088	"\"}\\n\"\n"
		2089	"\"if {$v(mouseMoved)} {\\n\"\n"
		2090	"\"$w tag remove sel 0.0 $first\\n\"\n"
		2091	"\"$w tag add sel $first $last\\n\"\n"
		2092	"\"$w tag remove sel $last end\\n\"\n"
		2093	"\"update idletasks\\n\"\n"
		2094	"\"}\\n\"\n"
		2095	"\"}\\n\"\n"
		2096	"\"proc console:B1Motion {w x y} {\\n\"\n"
		2097	"\"upvar #0 $w v\\n\"\n"
		2098	"\"set v(y) $y\\n\"\n"
		2099	"\"set v(x) $x\\n\"\n"
		2100	"\"console:SelectTo $w $x $y\\n\"\n"
		2101	"\"}\\n\"\n"
		2102	"\"proc console:B1Leave {w x y} {\\n\"\n"
		2103	"\"upvar #0 $w v\\n\"\n"
		2104	"\"set v(y) $y\\n\"\n"
		2105	"\"set v(x) $x\\n\"\n"
		2106	"\"console:motor $w\\n\"\n"
		2107	"\"}\\n\"\n"
		2108	"\"proc console:motor w {\\n\"\n"
		2109	"\"upvar #0 $w v\\n\"\n"
		2110	"\"if {![winfo exists $w]} return\\n\"\n"
		2111	"\"if {$v(y)>=[winfo height $w]} {\\n\"\n"
		2112	"\"$w yview scroll 1 units\\n\"\n"
		2113	"\"} elseif {$v(y)<0} {\\n\"\n"
		2114	"\"$w yview scroll -1 units\\n\"\n"
		2115	"\"} else {\\n\"\n"
		2116	"\"return\\n\"\n"
		2117	"\"}\\n\"\n"
		2118	"\"console:SelectTo $w $v(x) $v(y)\\n\"\n"
		2119	"\"set v(timer) [after 50 console:motor $w]\\n\"\n"
		2120	"\"}\\n\"\n"
		2121	"\"proc console:cancelMotor w {\\n\"\n"
		2122	"\"upvar #0 $w v\\n\"\n"
		2123	"\"catch {after cancel $v(timer)}\\n\"\n"
		2124	"\"catch {unset v(timer)}\\n\"\n"
		2125	"\"}\\n\"\n"
		2126	"\"proc console:Copy w {\\n\"\n"
		2127	"\"if {![catch {set text [$w get sel.first sel.last]}]} {\\n\"\n"
		2128	"\"clipboard clear -displayof $w\\n\"\n"
		2129	"\"clipboard append -displayof $w $text\\n\"\n"
		2130	"\"}\\n\"\n"
		2131	"\"}\\n\"\n"
		2132	"\"proc console:canCut w {\\n\"\n"
		2133	"\"set r [catch {\\n\"\n"
		2134	"\"scan [$w index sel.first] %d.%d s1x s1y\\n\"\n"
		2135	"\"scan [$w index sel.last] %d.%d s2x s2y\\n\"\n"
		2136	"\"scan [$w index insert] %d.%d ix iy\\n\"\n"
		2137	"\"}]\\n\"\n"
		2138	"\"if {$r==1} {return 0}\\n\"\n"
		2139	"\"if {$s1x==$ix && $s2x==$ix} {return 1}\\n\"\n"
		2140	"\"return 2\\n\"\n"
		2141	"\"}\\n\"\n"
		2142	"\"proc console:Cut w {\\n\"\n"
		2143	"\"if {[console:canCut $w]==1} {\\n\"\n"
		2144	"\"console:Copy $w\\n\"\n"
		2145	"\"$w delete sel.first sel.last\\n\"\n"
		2146	"\"}\\n\"\n"
		2147	"\"}\\n\"\n"
		2148	"\"proc console:Paste w {\\n\"\n"
		2149	"\"if {[console:canCut $w]==1} {\\n\"\n"
		2150	"\"$w delete sel.first sel.last\\n\"\n"
		2151	"\"}\\n\"\n"
		2152	"\"if {[catch {selection get -displayof $w -selection CLIPBOARD} topaste]} {\\n\"\n"
		2153	"\"return\\n\"\n"
		2154	"\"}\\n\"\n"
		2155	"\"set prior 0\\n\"\n"
		2156	"\"foreach line [split $topaste \\\\n] {\\n\"\n"
		2157	"\"if {$prior} {\\n\"\n"
		2158	"\"console:Enter $w\\n\"\n"
		2159	"\"update\\n\"\n"
		2160	"\"}\\n\"\n"
		2161	"\"set prior 1\\n\"\n"
		2162	"\"$w insert insert $line\\n\"\n"
		2163	"\"}\\n\"\n"
		2164	"\"}\\n\"\n"
		2165	"\"proc console:EnableEditMenu w {\\n\"\n"
		2166	"\"set m $w.mb.edit.m\\n\"\n"
		2167	"\"switch [console:canCut $w.t] {\\n\"\n"
		2168	"\"0 {\\n\"\n"
		2169	"\"$m entryconf Copy -state disabled\\n\"\n"
		2170	"\"$m entryconf Cut -state disabled\\n\"\n"
		2171	"\"}\\n\"\n"
		2172	"\"1 {\\n\"\n"
		2173	"\"$m entryconf Copy -state normal\\n\"\n"
		2174	"\"$m entryconf Cut -state normal\\n\"\n"
		2175	"\"}\\n\"\n"
		2176	"\"2 {\\n\"\n"
		2177	"\"$m entryconf Copy -state normal\\n\"\n"
		2178	"\"$m entryconf Cut -state disabled\\n\"\n"
		2179	"\"}\\n\"\n"
		2180	"\"}\\n\"\n"
		2181	"\"}\\n\"\n"
		2182	"\"proc console:SourceFile w {\\n\"\n"
		2183	"\"set types {\\n\"\n"
		2184	"\"{{TCL Scripts} {.tcl}}\\n\"\n"
		2185	"\"{{All Files} *}\\n\"\n"
		2186	"\"}\\n\"\n"
		2187	"\"set f [tk_getOpenFile -filetypes $types -title \\\"TCL Script To Source...\\\"]\\n\"\n"
		2188	"\"if {$f!=\\\"\\\"} {\\n\"\n"
		2189	"\"uplevel #0 source $f\\n\"\n"
		2190	"\"}\\n\"\n"
		2191	"\"}\\n\"\n"
		2192	"\"proc console:SaveFile w {\\n\"\n"
		2193	"\"set types {\\n\"\n"
		2194	"\"{{Text Files} {.txt}}\\n\"\n"
		2195	"\"{{All Files} *}\\n\"\n"
		2196	"\"}\\n\"\n"
		2197	"\"set f [tk_getSaveFile -filetypes $types -title \\\"Write Screen To...\\\"]\\n\"\n"
		2198	"\"if {$f!=\\\"\\\"} {\\n\"\n"
		2199	"\"if {[catch {open $f w} fd]} {\\n\"\n"
		2200	"\"tk_messageBox -type ok -icon error -message $fd\\n\"\n"
		2201	"\"} else {\\n\"\n"
		2202	"\"puts $fd [string trimright [$w get 1.0 end] \\\\n]\\n\"\n"
		2203	"\"close $fd\\n\"\n"
		2204	"\"}\\n\"\n"
		2205	"\"}\\n\"\n"
		2206	"\"}\\n\"\n"
		2207	"\"proc console:Clear w {\\n\"\n"
		2208	"\"$w delete 1.0 {insert linestart}\\n\"\n"
		2209	"\"}\\n\"\n"
		2210	"; /* End of the console code */\n"
		2211	"#endif /* ET_ENABLE_TK */\n"
		2212	"\n"
		2213	"/*\n"
		2214	"** The \"printf\" code that follows dates from the 1980's. It is in\n"
		2215	"** the public domain. The original comments are included here for\n"
		2216	"** completeness. They are slightly out-of-date.\n"
		2217	"**\n"
		2218	"** The following modules is an enhanced replacement for the \"printf\" programs\n"
		2219	"** found in the standard library. The following enhancements are\n"
		2220	"** supported:\n"
		2221	"**\n"
		2222	"** + Additional functions. The standard set of \"printf\" functions\n"
		2223	"** includes printf, fprintf, sprintf, vprintf, vfprintf, and\n"
		2224	"** vsprintf. This module adds the following:\n"
		2225	"**\n"
		2226	"** * snprintf -- Works like sprintf, but has an extra argument\n"
		2227	"** which is the size of the buffer written to.\n"
		2228	"**\n"
		2229	"** * mprintf -- Similar to sprintf. Writes output to memory\n"
		2230	"** obtained from malloc.\n"
		2231	"**\n"
		2232	"** * xprintf -- Calls a function to dispose of output.\n"
		2233	"**\n"
		2234	"** * nprintf -- No output, but returns the number of characters\n"
		2235	"** that would have been output by printf.\n"
		2236	"**\n"
		2237	"** * A v- version (ex: vsnprintf) of every function is also\n"
		2238	"** supplied.\n"
		2239	"**\n"
		2240	"** + A few extensions to the formatting notation are supported:\n"
		2241	"**\n"
		2242	"** * The \"=\" flag (similar to \"-\") causes the output to be\n"
		2243	"** be centered in the appropriately sized field.\n"
		2244	"**\n"
		2245	"** * The %b field outputs an integer in binary notation.\n"
		2246	"**\n"
		2247	"** * The %c field now accepts a precision. The character output\n"
		2248	"** is repeated by the number of times the precision specifies.\n"
		2249	"**\n"
		2250	"** * The %' field works like %c, but takes as its character the\n"
		2251	"** next character of the format string, instead of the next\n"
		2252	"** argument. For example, printf(\"%.78'-\") prints 78 minus\n"
		2253	"** signs, the same as printf(\"%.78c\",'-').\n"
		2254	"**\n"
		2255	"** + When compiled using GCC on a SPARC, this version of printf is\n"
		2256	"** faster than the library printf for SUN OS 4.1.\n"
		2257	"**\n"
		2258	"** + All functions are fully reentrant.\n"
		2259	"**\n"
		2260	"*/\n"
		2261	"/*\n"
		2262	"** Undefine COMPATIBILITY to make some slight changes in the way things\n"
		2263	"** work. I think the changes are an improvement, but they are not\n"
		2264	"** backwards compatible.\n"
		2265	"*/\n"
		2266	"/* #define COMPATIBILITY / * Compatible with SUN OS 4.1 */\n"
		2267	"\n"
		2268	"/*\n"
		2269	"** Characters that need to be escaped inside a TCL string.\n"
		2270	"*/\n"
		2271	"static char NeedEsc[] = {\n"
		2272	" 1, 1, 1, 1, 1, 1, 1, 1, 'b', 't', 'n', 1, 'f', 'r', 1, 1,\n"
		2273	" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
		2274	" 0, 0, '\"', 0, '$', 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\n"
		2275	" 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\n"
		2276	" 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\n"
		2277	" 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, '[','\\\\', ']', 0, 0,\n"
		2278	" 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\n"
		2279	" 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1,\n"
		2280	" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
		2281	" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
		2282	" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
		2283	" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
		2284	" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
		2285	" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
		2286	" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
		2287	" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
		2288	"};\n"
		2289	"\n"
		2290	"/*\n"
		2291	"** Conversion types fall into various categories as defined by the\n"
		2292	"** following enumeration.\n"
		2293	"*/\n"
		2294	"enum et_type { /* The type of the format field */\n"
		2295	" etRADIX, /* Integer types. %d, %x, %o, and so forth */\n"
		2296	" etFLOAT, /* Floating point. %f */\n"
		2297	" etEXP, /* Exponentional notation. %e and %E */\n"
		2298	" etGENERIC, /* Floating or exponential, depending on exponent. %g */\n"
		2299	" etSIZE, /* Return number of characters processed so far. %n */\n"
		2300	" etSTRING, /* Strings. %s */\n"
		2301	" etPERCENT, /* Percent symbol. %% */\n"
		2302	" etCHARX, /* Characters. %c */\n"
		2303	" etERROR, /* Used to indicate no such conversion type */\n"
		2304	"/* The rest are extensions, not normally found in printf() */\n"
		2305	" etCHARLIT, /* Literal characters. %' */\n"
		2306	" etTCLESCAPE, /* Strings with special characters escaped. %q */\n"
		2307	" etMEMSTRING, /* A string which should be deleted after use. %z */\n"
		2308	" etORDINAL /* 1st, 2nd, 3rd and so forth */\n"
		2309	"};\n"
		2310	"\n"
		2311	"/*\n"
		2312	"** Each builtin conversion character (ex: the 'd' in \"%d\") is described\n"
		2313	"** by an instance of the following structure\n"
		2314	"*/\n"
		2315	"typedef struct et_info { /* Information about each format field */\n"
		2316	" int fmttype; /* The format field code letter */\n"
		2317	" int base; /* The base for radix conversion */\n"
		2318	" char charset; / The character set for conversion */\n"
		2319	" int flag_signed; /* Is the quantity signed? */\n"
		2320	" char prefix; / Prefix on non-zero values in alt format */\n"
		2321	" enum et_type type; /* Conversion paradigm */\n"
		2322	"} et_info;\n"
		2323	"\n"
		2324	"/*\n"
		2325	"** The following table is searched linearly, so it is good to put the\n"
		2326	"** most frequently used conversion types first.\n"
		2327	"*/\n"
		2328	"static et_info fmtinfo[] = {\n"
		2329	" { 'd', 10, \"0123456789\", 1, 0, etRADIX, },\n"
		2330	" { 's', 0, 0, 0, 0, etSTRING, }, \n"
		2331	" { 'q', 0, 0, 0, 0, etTCLESCAPE, },\n"
		2332	" { 'z', 0, 0, 0, 0, etMEMSTRING, },\n"
		2333	" { 'c', 0, 0, 0, 0, etCHARX, },\n"
		2334	" { 'o', 8, \"01234567\", 0, \"0\", etRADIX, },\n"
		2335	" { 'u', 10, \"0123456789\", 0, 0, etRADIX, },\n"
		2336	" { 'x', 16, \"0123456789abcdef\", 0, \"x0\", etRADIX, },\n"
		2337	" { 'X', 16, \"0123456789ABCDEF\", 0, \"X0\", etRADIX, },\n"
		2338	" { 'r', 10, \"0123456789\", 0, 0, etORDINAL, },\n"
		2339	" { 'f', 0, 0, 1, 0, etFLOAT, },\n"
		2340	" { 'e', 0, \"e\", 1, 0, etEXP, },\n"
		2341	" { 'E', 0, \"E\", 1, 0, etEXP, },\n"
		2342	" { 'g', 0, \"e\", 1, 0, etGENERIC, },\n"
		2343	" { 'G', 0, \"E\", 1, 0, etGENERIC, },\n"
		2344	" { 'i', 10, \"0123456789\", 1, 0, etRADIX, },\n"
		2345	" { 'n', 0, 0, 0, 0, etSIZE, },\n"
		2346	" { '%', 0, 0, 0, 0, etPERCENT, },\n"
		2347	" { 'b', 2, \"01\", 0, \"b0\", etRADIX, }, /* Binary */\n"
		2348	" { 'p', 10, \"0123456789\", 0, 0, etRADIX, }, /* Pointers */\n"
		2349	" { '\\'', 0, 0, 0, 0, etCHARLIT, }, /* Literal char */\n"
		2350	"};\n"
		2351	"#define etNINFO (sizeof(fmtinfo)/sizeof(fmtinfo[0]))\n"
		2352	"\n"
		2353	"/*\n"
		2354	"** If NOFLOATINGPOINT is defined, then none of the floating point\n"
		2355	"** conversions will work.\n"
		2356	"*/\n"
		2357	"#ifndef etNOFLOATINGPOINT\n"
		2358	"/*\n"
		2359	"** \"val\" is a double such that 0.1 <= val < 10.0\n"
		2360	"** Return the ascii code for the leading digit of *val, then\n"
		2361	"** multiply \"*val\" by 10.0 to renormalize.\n"
		2362	"**\n"
		2363	"** Example:\n"
		2364	"** input: *val = 3.14159\n"
		2365	"** output: *val = 1.4159 function return = '3'\n"
		2366	"**\n"
		2367	"** The counter *cnt is incremented each time. After counter exceeds\n"
		2368	"** 16 (the number of significant digits in a 64-bit float) '0' is\n"
		2369	"** always returned.\n"
		2370	"*/\n"
		2371	"static int et_getdigit(double val, int cnt){\n"
		2372	" int digit;\n"
		2373	" double d;\n"
		2374	" if( (*cnt)++ >= 16 ) return '0';\n"
		2375	" digit = (int)*val;\n"
		2376	" d = digit;\n"
		2377	" digit += '0';\n"
		2378	" val = (val - d)*10.0;\n"
		2379	" return digit;\n"
		2380	"}\n"
		2381	"#endif\n"
		2382	"\n"
		2383	"#define etBUFSIZE 1000 /* Size of the output buffer */\n"
		2384	"\n"
		2385	"/*\n"
		2386	"** The root program. All variations call this core.\n"
		2387	"**\n"
		2388	"** INPUTS:\n"
		2389	"** func This is a pointer to a function taking three arguments\n"
		2390	"** 1. A pointer to anything. Same as the \"arg\" parameter.\n"
		2391	"** 2. A pointer to the list of characters to be output\n"
		2392	"** (Note, this list is NOT null terminated.)\n"
		2393	"** 3. An integer number of characters to be output.\n"
		2394	"** (Note: This number might be zero.)\n"
		2395	"**\n"
		2396	"** arg This is the pointer to anything which will be passed as the\n"
		2397	"** first argument to \"func\". Use it for whatever you like.\n"
		2398	"**\n"
		2399	"** fmt This is the format string, as in the usual print.\n"
		2400	"**\n"
		2401	"** ap This is a pointer to a list of arguments. Same as in\n"
		2402	"** vfprint.\n"
		2403	"**\n"
		2404	"** OUTPUTS:\n"
		2405	"** The return value is the total number of characters sent to\n"
		2406	"** the function \"func\". Returns -1 on a error.\n"
		2407	"**\n"
		2408	"** Note that the order in which automatic variables are declared below\n"
		2409	"** seems to make a big difference in determining how fast this beast\n"
		2410	"** will run.\n"
		2411	"*/\n"
		2412	"int vxprintf(\n"
		2413	" void (func)(void,char*,int),\n"
		2414	" void *arg,\n"
		2415	" const char *format,\n"
		2416	" va_list ap\n"
		2417	"){\n"
		2418	" register const char fmt; / The format string. */\n"
		2419	" register int c; /* Next character in the format string */\n"
		2420	" register char bufpt; / Pointer to the conversion buffer */\n"
		2421	" register int precision; /* Precision of the current field */\n"
		2422	" register int length; /* Length of the field */\n"
		2423	" register int idx; /* A general purpose loop counter */\n"
		2424	" int count; /* Total number of characters output */\n"
		2425	" int width; /* Width of the current field */\n"
		2426	" int flag_leftjustify; /* True if \"-\" flag is present */\n"
		2427	" int flag_plussign; /* True if \"+\" flag is present */\n"
		2428	" int flag_blanksign; /* True if \" \" flag is present */\n"
		2429	" int flag_alternateform; /* True if \"#\" flag is present */\n"
		2430	" int flag_zeropad; /* True if field width constant starts with zero */\n"
		2431	" int flag_long; /* True if \"l\" flag is present */\n"
		2432	" int flag_center; /* True if \"=\" flag is present */\n"
		2433	" unsigned long longvalue; /* Value for integer types */\n"
		2434	" double realvalue; /* Value for real types */\n"
		2435	" et_info infop; / Pointer to the appropriate info structure */\n"
		2436	" char buf[etBUFSIZE]; /* Conversion buffer */\n"
		2437	" char prefix; /* Prefix character. \"+\" or \"-\" or \" \" or '\\0'. */\n"
		2438	" int errorflag = 0; /* True if an error is encountered */\n"
		2439	" enum et_type xtype; /* Conversion paradigm */\n"
		2440	" char zMem; / String to be freed */\n"
		2441	" char zExtra; / Extra memory used for etTCLESCAPE conversions */\n"
		2442	" static char spaces[] = \" \"\n"
		2443	" \" \";\n"
		2444	"#define etSPACESIZE (sizeof(spaces)-1)\n"
		2445	"#ifndef etNOFLOATINGPOINT\n"
		2446	" int exp; /* exponent of real numbers */\n"
		2447	" double rounder; /* Used for rounding floating point values */\n"
		2448	" int flag_dp; /* True if decimal point should be shown */\n"
		2449	" int flag_rtz; /* True if trailing zeros should be removed */\n"
		2450	" int flag_exp; /* True to force display of the exponent */\n"
		2451	" int nsd; /* Number of significant digits returned */\n"
		2452	"#endif\n"
		2453	"\n"
		2454	" fmt = format; /* Put in a register for speed */\n"
		2455	" count = length = 0;\n"
		2456	" bufpt = 0;\n"
		2457	" for(; (c=(*fmt))!=0; ++fmt){\n"
		2458	" if( c!='%' ){\n"
		2459	" register int amt;\n"
		2460	" bufpt = (char *)fmt;\n"
		2461	" amt = 1;\n"
		2462	" while( (c=(*++fmt))!='%' && c!=0 ) amt++;\n"
		2463	" (*func)(arg,bufpt,amt);\n"
		2464	" count += amt;\n"
		2465	" if( c==0 ) break;\n"
		2466	" }\n"
		2467	" if( (c=(*++fmt))==0 ){\n"
		2468	" errorflag = 1;\n"
		2469	" (*func)(arg,\"%\",1);\n"
		2470	" count++;\n"
		2471	" break;\n"
		2472	" }\n"
		2473	" /* Find out what flags are present */\n"
		2474	" flag_leftjustify = flag_plussign = flag_blanksign = \n"
		2475	" flag_alternateform = flag_zeropad = flag_center = 0;\n"
		2476	" do{\n"
		2477	" switch( c ){\n"
		2478	" case '-': flag_leftjustify = 1; c = 0; break;\n"
		2479	" case '+': flag_plussign = 1; c = 0; break;\n"
		2480	" case ' ': flag_blanksign = 1; c = 0; break;\n"
		2481	" case '#': flag_alternateform = 1; c = 0; break;\n"
		2482	" case '0': flag_zeropad = 1; c = 0; break;\n"
		2483	" case '=': flag_center = 1; c = 0; break;\n"
		2484	" default: break;\n"
		2485	" }\n"
		2486	" }while( c==0 && (c=(*++fmt))!=0 );\n"
		2487	" if( flag_center ) flag_leftjustify = 0;\n"
		2488	" /* Get the field width */\n"
		2489	" width = 0;\n"
		2490	" if( c=='*' ){\n"
		2491	" width = va_arg(ap,int);\n"
		2492	" if( width<0 ){\n"
		2493	" flag_leftjustify = 1;\n"
		2494	" width = -width;\n"
		2495	" }\n"
		2496	" c = *++fmt;\n"
		2497	" }else{\n"
		2498	" while( isdigit(c) ){\n"
		2499	" width = width*10 + c - '0';\n"
		2500	" c = *++fmt;\n"
		2501	" }\n"
		2502	" }\n"
		2503	" if( width > etBUFSIZE-10 ){\n"
		2504	" width = etBUFSIZE-10;\n"
		2505	" }\n"
		2506	" /* Get the precision */\n"
		2507	" if( c=='.' ){\n"
		2508	" precision = 0;\n"
		2509	" c = *++fmt;\n"
		2510	" if( c=='*' ){\n"
		2511	" precision = va_arg(ap,int);\n"
		2512	"#ifndef etCOMPATIBILITY\n"
		2513	" /* This is sensible, but SUN OS 4.1 doesn't do it. */\n"
		2514	" if( precision<0 ) precision = -precision;\n"
		2515	"#endif\n"
		2516	" c = *++fmt;\n"
		2517	" }else{\n"
		2518	" while( isdigit(c) ){\n"
		2519	" precision = precision*10 + c - '0';\n"
		2520	" c = *++fmt;\n"
		2521	" }\n"
		2522	" }\n"
		2523	" /* Limit the precision to prevent overflowing buf[] during conversion */\n"
		2524	" if( precision>etBUFSIZE-40 ) precision = etBUFSIZE-40;\n"
		2525	" }else{\n"
		2526	" precision = -1;\n"
		2527	" }\n"
		2528	" /* Get the conversion type modifier */\n"
		2529	" if( c=='l' ){\n"
		2530	" flag_long = 1;\n"
		2531	" c = *++fmt;\n"
		2532	" }else{\n"
		2533	" flag_long = 0;\n"
		2534	" }\n"
		2535	" /* Fetch the info entry for the field */\n"
		2536	" infop = 0;\n"
		2537	" for(idx=0; idx<etNINFO; idx++){\n"
		2538	" if( c==fmtinfo[idx].fmttype ){\n"
		2539	" infop = &fmtinfo[idx];\n"
		2540	" break;\n"
		2541	" }\n"
		2542	" }\n"
		2543	" /* No info entry found. It must be an error. */\n"
		2544	" if( infop==0 ){\n"
		2545	" xtype = etERROR;\n"
		2546	" }else{\n"
		2547	" xtype = infop->type;\n"
		2548	" }\n"
		2549	" zExtra = 0;\n"
		2550	"\n"
		2551	" /*\n"
		2552	" ** At this point, variables are initialized as follows:\n"
		2553	" **\n"
		2554	" ** flag_alternateform TRUE if a '#' is present.\n"
		2555	" ** flag_plussign TRUE if a '+' is present.\n"
		2556	" ** flag_leftjustify TRUE if a '-' is present or if the\n"
		2557	" ** field width was negative.\n"
		2558	" ** flag_zeropad TRUE if the width began with 0.\n"
		2559	" ** flag_long TRUE if the letter 'l' (ell) prefixed\n"
		2560	" ** the conversion character.\n"
		2561	" ** flag_blanksign TRUE if a ' ' is present.\n"
		2562	" ** width The specified field width. This is\n"
		2563	" ** always non-negative. Zero is the default.\n"
		2564	" ** precision The specified precision. The default\n"
		2565	" ** is -1.\n"
		2566	" ** xtype The class of the conversion.\n"
		2567	" ** infop Pointer to the appropriate info struct.\n"
		2568	" */\n"
		2569	" switch( xtype ){\n"
		2570	" case etORDINAL:\n"
		2571	" case etRADIX:\n"
		2572	" if( flag_long ) longvalue = va_arg(ap,long);\n"
		2573	" else longvalue = va_arg(ap,int);\n"
		2574	"#ifdef etCOMPATIBILITY\n"
		2575	" /* For the format %#x, the value zero is printed \"0\" not \"0x0\".\n"
		2576	" ** I think this is stupid. */\n"
		2577	" if( longvalue==0 ) flag_alternateform = 0;\n"
		2578	"#else\n"
		2579	" /* More sensible: turn off the prefix for octal (to prevent \"00\"),\n"
		2580	" ** but leave the prefix for hex. */\n"
		2581	" if( longvalue==0 && infop->base==8 ) flag_alternateform = 0;\n"
		2582	"#endif\n"
		2583	" if( infop->flag_signed ){\n"
		2584	" if( (long)&longvalue<0 ){\n"
		2585	" longvalue = -(long)&longvalue;\n"
		2586	" prefix = '-';\n"
		2587	" }else if( flag_plussign ) prefix = '+';\n"
		2588	" else if( flag_blanksign ) prefix = ' ';\n"
		2589	" else prefix = 0;\n"
		2590	" }else prefix = 0;\n"
		2591	" if( flag_zeropad && precision<width-(prefix!=0) ){\n"
		2592	" precision = width-(prefix!=0);\n"
		2593	" }\n"
		2594	" bufpt = &buf[etBUFSIZE];\n"
		2595	" if( xtype==etORDINAL ){\n"
		2596	" long a,b;\n"
		2597	" a = longvalue%10;\n"
		2598	" b = longvalue%100;\n"
		2599	" bufpt -= 2;\n"
		2600	" if( a==0 \|\| a>3 \|\| (b>10 && b<14) ){\n"
		2601	" bufpt[0] = 't';\n"
		2602	" bufpt[1] = 'h';\n"
		2603	" }else if( a==1 ){\n"
		2604	" bufpt[0] = 's';\n"
		2605	" bufpt[1] = 't';\n"
		2606	" }else if( a==2 ){\n"
		2607	" bufpt[0] = 'n';\n"
		2608	" bufpt[1] = 'd';\n"
		2609	" }else if( a==3 ){\n"
		2610	" bufpt[0] = 'r';\n"
		2611	" bufpt[1] = 'd';\n"
		2612	" }\n"
		2613	" }\n"
		2614	" {\n"
		2615	" register char cset; / Use registers for speed */\n"
		2616	" register int base;\n"
		2617	" cset = infop->charset;\n"
		2618	" base = infop->base;\n"
		2619	" do{ /* Convert to ascii */\n"
		2620	" *(--bufpt) = cset[longvalue%base];\n"
		2621	" longvalue = longvalue/base;\n"
		2622	" }while( longvalue>0 );\n"
		2623	" }\n"
		2624	" length = (long)&buf[etBUFSIZE]-(long)bufpt;\n"
		2625	" for(idx=precision-length; idx>0; idx--){\n"
		2626	" (--bufpt) = '0'; / Zero pad */\n"
		2627	" }\n"
		2628	" if( prefix ) (--bufpt) = prefix; / Add sign */\n"
		2629	" if( flag_alternateform && infop->prefix ){ /* Add \"0\" or \"0x\" */\n"
		2630	" char *pre, x;\n"
		2631	" pre = infop->prefix;\n"
		2632	" if( *bufpt!=pre[0] ){\n"
		2633	" for(pre=infop->prefix; (x=(pre))!=0; pre++) (--bufpt) = x;\n"
		2634	" }\n"
		2635	" }\n"
		2636	" length = (long)&buf[etBUFSIZE]-(long)bufpt;\n"
		2637	" break;\n"
		2638	" case etFLOAT:\n"
		2639	" case etEXP:\n"
		2640	" case etGENERIC:\n"
		2641	" realvalue = va_arg(ap,double);\n"
		2642	"#ifndef etNOFLOATINGPOINT\n"
		2643	" if( precision<0 ) precision = 6; /* Set default precision */\n"
		2644	" if( precision>etBUFSIZE-10 ) precision = etBUFSIZE-10;\n"
		2645	" if( realvalue<0.0 ){\n"
		2646	" realvalue = -realvalue;\n"
		2647	" prefix = '-';\n"
		2648	" }else{\n"
		2649	" if( flag_plussign ) prefix = '+';\n"
		2650	" else if( flag_blanksign ) prefix = ' ';\n"
		2651	" else prefix = 0;\n"
		2652	" }\n"
		2653	" if( infop->type==etGENERIC && precision>0 ) precision--;\n"
		2654	" rounder = 0.0;\n"
		2655	"#ifdef COMPATIBILITY\n"
		2656	" /* Rounding works like BSD when the constant 0.4999 is used. Wierd! */\n"
		2657	" for(idx=precision, rounder=0.4999; idx>0; idx--, rounder*=0.1);\n"
		2658	"#else\n"
		2659	" /* It makes more sense to use 0.5 */\n"
		2660	" for(idx=precision, rounder=0.5; idx>0; idx--, rounder*=0.1);\n"
		2661	"#endif\n"
		2662	" if( infop->type==etFLOAT ) realvalue += rounder;\n"
		2663	" /* Normalize realvalue to within 10.0 > realvalue >= 1.0 */\n"
		2664	" exp = 0;\n"
		2665	" if( realvalue>0.0 ){\n"
		2666	" int k = 0;\n"
		2667	" while( realvalue>=1e8 && k++<100 ){ realvalue *= 1e-8; exp+=8; }\n"
		2668	" while( realvalue>=10.0 && k++<100 ){ realvalue *= 0.1; exp++; }\n"
		2669	" while( realvalue<1e-8 && k++<100 ){ realvalue *= 1e8; exp-=8; }\n"
		2670	" while( realvalue<1.0 && k++<100 ){ realvalue *= 10.0; exp--; }\n"
		2671	" if( k>=100 ){\n"
		2672	" bufpt = \"NaN\";\n"
		2673	" length = 3;\n"
		2674	" break;\n"
		2675	" }\n"
		2676	" }\n"
		2677	" bufpt = buf;\n"
		2678	" /*\n"
		2679	" ** If the field type is etGENERIC, then convert to either etEXP\n"
		2680	" ** or etFLOAT, as appropriate.\n"
		2681	" */\n"
		2682	" flag_exp = xtype==etEXP;\n"
		2683	" if( xtype!=etFLOAT ){\n"
		2684	" realvalue += rounder;\n"
		2685	" if( realvalue>=10.0 ){ realvalue *= 0.1; exp++; }\n"
		2686	" }\n"
		2687	" if( xtype==etGENERIC ){\n"
		2688	" flag_rtz = !flag_alternateform;\n"
		2689	" if( exp<-4 \|\| exp>precision ){\n"
		2690	" xtype = etEXP;\n"
		2691	" }else{\n"
		2692	" precision = precision - exp;\n"
		2693	" xtype = etFLOAT;\n"
		2694	" }\n"
		2695	" }else{\n"
		2696	" flag_rtz = 0;\n"
		2697	" }\n"
		2698	" /*\n"
		2699	" ** The \"exp+precision\" test causes output to be of type etEXP if\n"
		2700	" ** the precision is too large to fit in buf[].\n"
		2701	" */\n"
		2702	" nsd = 0;\n"
		2703	" if( xtype==etFLOAT && exp+precision<etBUFSIZE-30 ){\n"
		2704	" flag_dp = (precision>0 \|\| flag_alternateform);\n"
		2705	" if( prefix ) (bufpt++) = prefix; / Sign */\n"
		2706	" if( exp<0 ) (bufpt++) = '0'; / Digits before \".\" */\n"
		2707	" else for(; exp>=0; exp--) *(bufpt++) = et_getdigit(&realvalue,&nsd);\n"
		2708	" if( flag_dp ) (bufpt++) = '.'; / The decimal point */\n"
		2709	" for(exp++; exp<0 && precision>0; precision--, exp++){\n"
		2710	" *(bufpt++) = '0';\n"
		2711	" }\n"
		2712	" while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd);\n"
		2713	" (bufpt--) = 0; / Null terminate */\n"
		2714	" if( flag_rtz && flag_dp ){ /* Remove trailing zeros and \".\" */\n"
		2715	" while( bufpt>=buf && bufpt=='0' ) (bufpt--) = 0;\n"
		2716	" if( bufpt>=buf && bufpt=='.' ) (bufpt--) = 0;\n"
		2717	" }\n"
		2718	" bufpt++; /* point to next free slot */\n"
		2719	" }else{ /* etEXP or etGENERIC */\n"
		2720	" flag_dp = (precision>0 \|\| flag_alternateform);\n"
		2721	" if( prefix ) (bufpt++) = prefix; / Sign */\n"
		2722	" (bufpt++) = et_getdigit(&realvalue,&nsd); / First digit */\n"
		2723	" if( flag_dp ) (bufpt++) = '.'; / Decimal point */\n"
		2724	" while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd);\n"
		2725	" bufpt--; /* point to last digit */\n"
		2726	" if( flag_rtz && flag_dp ){ /* Remove tail zeros */\n"
		2727	" while( bufpt>=buf && bufpt=='0' ) (bufpt--) = 0;\n"
		2728	" if( bufpt>=buf && bufpt=='.' ) (bufpt--) = 0;\n"
		2729	" }\n"
		2730	" bufpt++; /* point to next free slot */\n"
		2731	" if( exp \|\| flag_exp ){\n"
		2732	" *(bufpt++) = infop->charset[0];\n"
		2733	" if( exp<0 ){ (bufpt++) = '-'; exp = -exp; } / sign of exp */\n"
		2734	" else { *(bufpt++) = '+'; }\n"
		2735	" if( exp>=100 ){\n"
		2736	" (bufpt++) = (exp/100)+'0'; / 100's digit */\n"
		2737	" exp %= 100;\n"
		2738	" }\n"
		2739	" (bufpt++) = exp/10+'0'; / 10's digit */\n"
		2740	" (bufpt++) = exp%10+'0'; / 1's digit */\n"
		2741	" }\n"
		2742	" }\n"
		2743	" /* The converted number is in buf[] and zero terminated. Output it.\n"
		2744	" ** Note that the number is in the usual order, not reversed as with\n"
		2745	" ** integer conversions. */\n"
		2746	" length = (long)bufpt-(long)buf;\n"
		2747	" bufpt = buf;\n"
		2748	"\n"
		2749	" /* Special case: Add leading zeros if the flag_zeropad flag is\n"
		2750	" ** set and we are not left justified */\n"
		2751	" if( flag_zeropad && !flag_leftjustify && length < width){\n"
		2752	" int i;\n"
		2753	" int nPad = width - length;\n"
		2754	" for(i=width; i>=nPad; i--){\n"
		2755	" bufpt[i] = bufpt[i-nPad];\n"
		2756	" }\n"
		2757	" i = prefix!=0;\n"
		2758	" while( nPad-- ) bufpt[i++] = '0';\n"
		2759	" length = width;\n"
		2760	" }\n"
		2761	"#endif\n"
		2762	" break;\n"
		2763	" case etSIZE:\n"
		2764	" (va_arg(ap,int)) = count;\n"
		2765	" length = width = 0;\n"
		2766	" break;\n"
		2767	" case etPERCENT:\n"
		2768	" buf[0] = '%';\n"
		2769	" bufpt = buf;\n"
		2770	" length = 1;\n"
		2771	" break;\n"
		2772	" case etCHARLIT:\n"
		2773	" case etCHARX:\n"
		2774	" c = buf[0] = (xtype==etCHARX ? va_arg(ap,int) : *++fmt);\n"
		2775	" if( precision>=0 ){\n"
		2776	" for(idx=1; idx<precision; idx++) buf[idx] = c;\n"
		2777	" length = precision;\n"
		2778	" }else{\n"
		2779	" length =1;\n"
		2780	" }\n"
		2781	" bufpt = buf;\n"
		2782	" break;\n"
		2783	" case etSTRING:\n"
		2784	" case etMEMSTRING:\n"
		2785	" zMem = bufpt = va_arg(ap,char*);\n"
		2786	" if( bufpt==0 ) bufpt = \"(null)\";\n"
		2787	" length = strlen(bufpt);\n"
		2788	" if( precision>=0 && precision<length ) length = precision;\n"
		2789	" break;\n"
		2790	" case etTCLESCAPE:\n"
		2791	" {\n"
		2792	" int i, j, n, c, k;\n"
		2793	" char arg = va_arg(ap,char);\n"
		2794	" if( arg==0 ) arg = \"(NULL)\";\n"
		2795	" for(i=n=0; (c=arg[i])!=0; i++){\n"
		2796	" k = NeedEsc[c&0xff];\n"
		2797	" if( k==0 ){\n"
		2798	" n++;\n"
		2799	" }else if( k==1 ){\n"
		2800	" n+=4;\n"
		2801	" }else{\n"
		2802	" n+=2;\n"
		2803	" }\n"
		2804	" }\n"
		2805	" n++;\n"
		2806	" if( n>etBUFSIZE ){\n"
		2807	" bufpt = zExtra = Tcl_Alloc( n );\n"
		2808	" }else{\n"
		2809	" bufpt = buf;\n"
		2810	" }\n"
		2811	" for(i=j=0; (c=arg[i])!=0; i++){\n"
		2812	" k = NeedEsc[c&0xff];\n"
		2813	" if( k==0 ){\n"
		2814	" bufpt[j++] = c;\n"
		2815	" }else if( k==1 ){\n"
		2816	" bufpt[j++] = '\\\\';\n"
		2817	" bufpt[j++] = ((c>>6) & 3) + '0';\n"
		2818	" bufpt[j++] = ((c>>3) & 7) + '0';\n"
		2819	" bufpt[j++] = (c & 7) + '0';\n"
		2820	" }else{\n"
		2821	" bufpt[j++] = '\\\\';\n"
		2822	" bufpt[j++] = k;\n"
		2823	" }\n"
		2824	" }\n"
		2825	" bufpt[j] = 0;\n"
		2826	" length = j;\n"
		2827	" if( precision>=0 && precision<length ) length = precision;\n"
		2828	" }\n"
		2829	" break;\n"
		2830	" case etERROR:\n"
		2831	" buf[0] = '%';\n"
		2832	" buf[1] = c;\n"
		2833	" errorflag = 0;\n"
		2834	" idx = 1+(c!=0);\n"
		2835	" (*func)(arg,\"%\",idx);\n"
		2836	" count += idx;\n"
		2837	" if( c==0 ) fmt--;\n"
		2838	" break;\n"
		2839	" }/* End switch over the format type */\n"
		2840	" /*\n"
		2841	" ** The text of the conversion is pointed to by \"bufpt\" and is\n"
		2842	" ** \"length\" characters long. The field width is \"width\". Do\n"
		2843	" ** the output.\n"
		2844	" */\n"
		2845	" if( !flag_leftjustify ){\n"
		2846	" register int nspace;\n"
		2847	" nspace = width-length;\n"
		2848	" if( nspace>0 ){\n"
		2849	" if( flag_center ){\n"
		2850	" nspace = nspace/2;\n"
		2851	" width -= nspace;\n"
		2852	" flag_leftjustify = 1;\n"
		2853	" }\n"
		2854	" count += nspace;\n"
		2855	" while( nspace>=etSPACESIZE ){\n"
		2856	" (*func)(arg,spaces,etSPACESIZE);\n"
		2857	" nspace -= etSPACESIZE;\n"
		2858	" }\n"
		2859	" if( nspace>0 ) (*func)(arg,spaces,nspace);\n"
		2860	" }\n"
		2861	" }\n"
		2862	" if( length>0 ){\n"
		2863	" (*func)(arg,bufpt,length);\n"
		2864	" count += length;\n"
		2865	" }\n"
		2866	" if( xtype==etMEMSTRING && zMem ){\n"
		2867	" Tcl_Free(zMem);\n"
		2868	" }\n"
		2869	" if( flag_leftjustify ){\n"
		2870	" register int nspace;\n"
		2871	" nspace = width-length;\n"
		2872	" if( nspace>0 ){\n"
		2873	" count += nspace;\n"
		2874	" while( nspace>=etSPACESIZE ){\n"
		2875	" (*func)(arg,spaces,etSPACESIZE);\n"
		2876	" nspace -= etSPACESIZE;\n"
		2877	" }\n"
		2878	" if( nspace>0 ) (*func)(arg,spaces,nspace);\n"
		2879	" }\n"
		2880	" }\n"
		2881	" if( zExtra ){\n"
		2882	" Tcl_Free(zExtra);\n"
		2883	" }\n"
		2884	" }/* End for loop over the format string */\n"
		2885	" return errorflag ? -1 : count;\n"
		2886	"} /* End of function */\n"
		2887	"\n"
		2888	"/*\n"
		2889	"** The following section of code handles the mprintf routine, that\n"
		2890	"** writes to memory obtained from malloc().\n"
		2891	"*/\n"
		2892	"\n"
		2893	"/* This structure is used to store state information about the\n"
		2894	"** write to memory that is currently in progress.\n"
		2895	"*/\n"
		2896	"struct sgMprintf {\n"
		2897	" char zBase; / A base allocation */\n"
		2898	" char zText; / The string collected so far */\n"
		2899	" int nChar; /* Length of the string so far */\n"
		2900	" int nAlloc; /* Amount of space allocated in zText */\n"
		2901	"};\n"
		2902	"\n"
		2903	"/* \n"
		2904	"** The xprintf callback function. \n"
		2905	"**\n"
		2906	"** This routine add nNewChar characters of text in zNewText to\n"
		2907	"** the sgMprintf structure pointed to by \"arg\".\n"
		2908	"*/\n"
		2909	"static void mout(void arg, char zNewText, int nNewChar){\n"
		2910	" struct sgMprintf pM = (struct sgMprintf)arg;\n"
		2911	" if( pM->nChar + nNewChar + 1 > pM->nAlloc ){\n"
		2912	" pM->nAlloc = pM->nChar + nNewChar*2 + 1;\n"
		2913	" if( pM->zText==pM->zBase ){\n"
		2914	" pM->zText = Tcl_Alloc(pM->nAlloc);\n"
		2915	" if( pM->zText && pM->nChar ) memcpy(pM->zText,pM->zBase,pM->nChar);\n"
		2916	" }else{\n"
		2917	" pM->zText = Tcl_Realloc(pM->zText, pM->nAlloc);\n"
		2918	" }\n"
		2919	" }\n"
		2920	" if( pM->zText ){\n"
		2921	" memcpy(&pM->zText[pM->nChar], zNewText, nNewChar);\n"
		2922	" pM->nChar += nNewChar;\n"
		2923	" pM->zText[pM->nChar] = 0;\n"
		2924	" }\n"
		2925	"}\n"
		2926	"\n"
		2927	"/*\n"
		2928	"** mprintf() works like printf(), but allocations memory to hold the\n"
		2929	"** resulting string and returns a pointer to the allocated memory.\n"
		2930	"*/\n"
		2931	"char mprintf(const char zFormat, ...){\n"
		2932	" va_list ap;\n"
		2933	" struct sgMprintf sMprintf;\n"
		2934	" char *zNew;\n"
		2935	" char zBuf[200];\n"
		2936	"\n"
		2937	" sMprintf.nChar = 0;\n"
		2938	" sMprintf.nAlloc = sizeof(zBuf);\n"
		2939	" sMprintf.zText = zBuf;\n"
		2940	" sMprintf.zBase = zBuf;\n"
		2941	" va_start(ap,zFormat);\n"
		2942	" vxprintf(mout,&sMprintf,zFormat,ap);\n"
		2943	" va_end(ap);\n"
		2944	" sMprintf.zText[sMprintf.nChar] = 0;\n"
		2945	" if( sMprintf.zText==sMprintf.zBase ){\n"
		2946	" zNew = Tcl_Alloc( sMprintf.nChar+1 );\n"
		2947	" if( zNew ) strcpy(zNew,zBuf);\n"
		2948	" }else{\n"
		2949	" zNew = Tcl_Realloc(sMprintf.zText,sMprintf.nChar+1);\n"
		2950	" }\n"
		2951	" return zNew;\n"
		2952	"}\n"
		2953	"\n"
		2954	"/* This is the varargs version of mprintf. \n"
		2955	"*/\n"
		2956	"char vmprintf(const char zFormat, va_list ap){\n"
		2957	" struct sgMprintf sMprintf;\n"
		2958	" char zBuf[200];\n"
		2959	" sMprintf.nChar = 0;\n"
		2960	" sMprintf.zText = zBuf;\n"
		2961	" sMprintf.nAlloc = sizeof(zBuf);\n"
		2962	" sMprintf.zBase = zBuf;\n"
		2963	" vxprintf(mout,&sMprintf,zFormat,ap);\n"
		2964	" sMprintf.zText[sMprintf.nChar] = 0;\n"
		2965	" if( sMprintf.zText==sMprintf.zBase ){\n"
		2966	" sMprintf.zText = Tcl_Alloc( strlen(zBuf)+1 );\n"
		2967	" if( sMprintf.zText ) strcpy(sMprintf.zText,zBuf);\n"
		2968	" }else{\n"
		2969	" sMprintf.zText = Tcl_Realloc(sMprintf.zText,sMprintf.nChar+1);\n"
		2970	" }\n"
		2971	" return sMprintf.zText;\n"
		2972	"}\n"
		2973	"\n"
		2974	"/*\n"
		2975	"** Add text output to a Tcl_DString.\n"
		2976	"**\n"
		2977	"** This routine is called by vxprintf(). It's job is to add\n"
		2978	"** nNewChar characters of text from zNewText to the Tcl_DString\n"
		2979	"** that \"arg\" is pointing to.\n"
		2980	"*/\n"
		2981	"static void dstringout(void arg, char zNewText, int nNewChar){\n"
		2982	" Tcl_DString str = (Tcl_DString)arg;\n"
		2983	" Tcl_DStringAppend(str,zNewText,nNewChar);\n"
		2984	"}\n"
		2985	"\n"
		2986	"/*\n"
		2987	"** Append formatted output to a DString.\n"
		2988	"*/\n"
		2989	"char Et_DStringAppendF(Tcl_DString str, const char *zFormat, ...){\n"
		2990	" va_list ap;\n"
		2991	" va_start(ap,zFormat);\n"
		2992	" vxprintf(dstringout,str,zFormat,ap);\n"
		2993	" va_end(ap);\n"
		2994	" return Tcl_DStringValue(str);\n"
		2995	"}\n"
		2996	"\n"
		2997	"/*\n"
		2998	"** Make this variable true to trace all calls to EvalF\n"
		2999	"*/\n"
		3000	"int Et_EvalTrace = 0;\n"
		3001	"\n"
		3002	"/*\n"
		3003	"** Eval the results of a string.\n"
		3004	"*/\n"
		3005	"int Et_EvalF(Tcl_Interp interp, const char zFormat, ...){\n"
		3006	" char *zCmd;\n"
		3007	" va_list ap;\n"
		3008	" int result;\n"
		3009	" va_start(ap,zFormat);\n"
		3010	" zCmd = vmprintf(zFormat,ap);\n"
		3011	" if( Et_EvalTrace ) printf(\"%s\\n\",zCmd);\n"
		3012	" result = Tcl_Eval(interp,zCmd);\n"
		3013	" if( Et_EvalTrace ) printf(\"%d %s\\n\",result,interp->result);\n"
		3014	" Tcl_Free(zCmd);\n"
		3015	" return result;\n"
		3016	"}\n"
		3017	"int Et_GlobalEvalF(Tcl_Interp interp, const char zFormat, ...){\n"
		3018	" char *zCmd;\n"
		3019	" va_list ap;\n"
		3020	" int result;\n"
		3021	" va_start(ap,zFormat);\n"
		3022	" zCmd = vmprintf(zFormat,ap);\n"
		3023	" if( Et_EvalTrace ) printf(\"%s\\n\",zCmd);\n"
		3024	" result = Tcl_GlobalEval(interp,zCmd);\n"
		3025	" if( Et_EvalTrace ) printf(\"%d %s\\n\",result,interp->result);\n"
		3026	" Tcl_Free(zCmd);\n"
		3027	" return result;\n"
		3028	"}\n"
		3029	"\n"
		3030	"/*\n"
		3031	"** Set the result of an interpreter using printf-like arguments.\n"
		3032	"*/\n"
		3033	"void Et_ResultF(Tcl_Interp interp, const char zFormat, ...){\n"
		3034	" Tcl_DString str;\n"
		3035	" va_list ap;\n"
		3036	"\n"
		3037	" Tcl_DStringInit(&str);\n"
		3038	" va_start(ap,zFormat);\n"
		3039	" vxprintf(dstringout,&str,zFormat,ap);\n"
		3040	" va_end(ap);\n"
		3041	" Tcl_DStringResult(interp,&str); \n"
		3042	"}\n"
		3043	"\n"
		3044	"#if ET_HAVE_OBJ\n"
		3045	"/*\n"
		3046	"** Append text to a string object.\n"
		3047	"*/\n"
		3048	"int Et_AppendObjF(Tcl_Obj pObj, const char zFormat, ...){\n"
		3049	" va_list ap;\n"
		3050	" int rc;\n"
		3051	"\n"
		3052	" va_start(ap,zFormat);\n"
		3053	" rc = vxprintf((void()(void,char*,int))Tcl_AppendToObj, pObj, zFormat, ap);\n"
		3054	" va_end(ap);\n"
		3055	" return rc;\n"
		3056	"}\n"
		3057	"#endif\n"
		3058	"\n"
		3059	"\n"
		3060	"#if ET_WIN32\n"
		3061	"/*\n"
		3062	"** This array translates all characters into themselves. Except\n"
		3063	"** for the \\ which gets translated into /. And all upper-case\n"
		3064	"** characters are translated into lower case. This is used for\n"
		3065	"** hashing and comparing filenames, to work around the Windows\n"
		3066	"** bug of ignoring filename case and using the wrong separator\n"
		3067	"** character for directories.\n"
		3068	"**\n"
		3069	"** The array is initialized by FilenameHashInit().\n"
		3070	"**\n"
		3071	"** We also define a macro ET_TRANS() that actually does\n"
		3072	"** the character translation. ET_TRANS() is a no-op under\n"
		3073	"** unix.\n"
		3074	"*/\n"
		3075	"static char charTrans[256];\n"
		3076	"#define ET_TRANS(X) (charTrans[0xff&(int)(X)])\n"
		3077	"#else\n"
		3078	"#define ET_TRANS(X) (X)\n"
		3079	"#endif\n"
		3080	"\n"
		3081	"/*\n"
		3082	"** Hash a filename. The value returned is appropriate for\n"
		3083	"** indexing into the Et_FileHashTable[] array.\n"
		3084	"*/\n"
		3085	"static int FilenameHash(char *zName){\n"
		3086	" int h = 0;\n"
		3087	" while( *zName ){\n"
		3088	" h = h ^ (h<<5) ^ ET_TRANS(*(zName++));\n"
		3089	" }\n"
		3090	" if( h<0 ) h = -h;\n"
		3091	" return h % (sizeof(Et_FileHashTable)/sizeof(Et_FileHashTable[0]));\n"
		3092	"}\n"
		3093	"\n"
		3094	"/*\n"
		3095	"** Compare two filenames. Return 0 if they are the same and\n"
		3096	"** non-zero if they are different.\n"
		3097	"*/\n"
		3098	"static int FilenameCmp(char z1, char z2){\n"
		3099	" int diff;\n"
		3100	" while( (diff = ET_TRANS(z1)-ET_TRANS(z2))==0 && *z1!=0){\n"
		3101	" z1++;\n"
		3102	" z2++;\n"
		3103	" }\n"
		3104	" return diff;\n"
		3105	"}\n"
		3106	"\n"
		3107	"/*\n"
		3108	"** Initialize the file hash table\n"
		3109	"*/\n"
		3110	"static void FilenameHashInit(void){\n"
		3111	" int i;\n"
		3112	"#if ET_WIN32\n"
		3113	" for(i=0; i<sizeof(charTrans); i++){\n"
		3114	" charTrans[i] = i;\n"
		3115	" }\n"
		3116	" for(i='A'; i<='Z'; i++){\n"
		3117	" charTrans[i] = i + 'a' - 'A';\n"
		3118	" }\n"
		3119	" charTrans['\\\\'] = '/';\n"
		3120	"#endif\n"
		3121	" for(i=0; i<sizeof(Et_FileSet)/sizeof(Et_FileSet[0]) - 1; i++){\n"
		3122	" struct EtFile *p;\n"
		3123	" int h;\n"
		3124	" p = &Et_FileSet[i];\n"
		3125	" h = FilenameHash(p->zName);\n"
		3126	" p->pNext = Et_FileHashTable[h];\n"
		3127	" Et_FileHashTable[h] = p;\n"
		3128	" }\n"
		3129	"}\n"
		3130	"\n"
		3131	"/*\n"
		3132	"** Locate the text of a built-in file given its name. \n"
		3133	"** Return 0 if not found. Return this size of the file (not\n"
		3134	"** counting the null-terminator) in *pSize if pSize!=NULL.\n"
		3135	"**\n"
		3136	"** If deshroud==1 and the file is shrouded, then descramble\n"
		3137	"** the text.\n"
		3138	"*/\n"
		3139	"static char FindBuiltinFile(char zName, int deshroud, int *pSize){\n"
		3140	" int h;\n"
		3141	" struct EtFile *p;\n"
		3142	"\n"
		3143	" h = FilenameHash(zName);\n"
		3144	" p = Et_FileHashTable[h];\n"
		3145	" while( p && FilenameCmp(p->zName,zName)!=0 ){ p = p->pNext; }\n"
		3146	"#if ET_SHROUD_KEY>0\n"
		3147	" if( p && p->shrouded && deshroud ){\n"
		3148	" char *z;\n"
		3149	" int xor = ET_SHROUD_KEY;\n"
		3150	" for(z=p->zData; *z; z++){\n"
		3151	" if( z>=0x20 ){ z ^= xor; xor = (xor+1)&0x1f; }\n"
		3152	" }\n"
		3153	" p->shrouded = 0;\n"
		3154	" }\n"
		3155	"#endif\n"
		3156	" if( p && pSize ){\n"
		3157	" *pSize = p->nData;\n"
		3158	" }\n"
		3159	" return p ? p->zData : 0;\n"
		3160	"}\n"
		3161	"\n"
		3162	"/*\n"
		3163	"** Add a new file to the list of built-in files.\n"
		3164	"**\n"
		3165	"** This routine makes a copy of zFilename. But it does NOT make\n"
		3166	"** a copy of zData. It just holds a pointer to zData and uses\n"
		3167	"** that for all file access. So after calling this routine,\n"
		3168	"** you should never change zData!\n"
		3169	"*/\n"
		3170	"void Et_NewBuiltinFile(\n"
		3171	" char zFilename, / Name of the new file */\n"
		3172	" char zData, / Data for the new file */\n"
		3173	" int nData /* Number of bytes in the new file */\n"
		3174	"){\n"
		3175	" int h;\n"
		3176	" struct EtFile *p;\n"
		3177	"\n"
		3178	" p = (struct EtFile*)Tcl_Alloc( sizeof(struct EtFile) + strlen(zFilename) + 1);\n"
		3179	" if( p==0 ) return;\n"
		3180	" p->zName = (char*)&p[1];\n"
		3181	" strcpy(p->zName, zFilename);\n"
		3182	" p->zData = zData;\n"
		3183	" p->nData = nData;\n"
		3184	" p->shrouded = 0;\n"
		3185	" h = FilenameHash(zFilename);\n"
		3186	" p->pNext = Et_FileHashTable[h];\n"
		3187	" Et_FileHashTable[h] = p;\n"
		3188	"}\n"
		3189	"\n"
		3190	"/*\n"
		3191	"** A TCL interface to the Et_NewBuiltinFile function. For Tcl8.0\n"
		3192	"** and later, we make this an Obj command so that it can deal with\n"
		3193	"** binary data.\n"
		3194	"*/\n"
		3195	"#if ET_HAVE_OBJ\n"
		3196	"static int Et_NewBuiltinFileCmd(ET_OBJARGS){\n"
		3197	" char zData, zNew;\n"
		3198	" int nData;\n"
		3199	" if( objc!=3 ){\n"
		3200	" Tcl_WrongNumArgs(interp, 1, objv, \"filename data\");\n"
		3201	" return TCL_ERROR;\n"
		3202	" }\n"
		3203	" zData = (char*)Tcl_GetByteArrayFromObj(objv[2], &nData);\n"
		3204	" zNew = Tcl_Alloc( nData + 1 );\n"
		3205	" if( zNew ){\n"
		3206	" memcpy(zNew, zData, nData);\n"
		3207	" zNew[nData] = 0;\n"
		3208	" Et_NewBuiltinFile(Tcl_GetStringFromObj(objv[1], 0), zNew, nData);\n"
		3209	" }\n"
		3210	" return TCL_OK;\n"
		3211	"}\n"
		3212	"#else\n"
		3213	"static int Et_NewBuiltinFileCmd(ET_TCLARGS){\n"
		3214	" char *zData;\n"
		3215	" int nData;\n"
		3216	" if( argc!=3 ){\n"
		3217	" Et_ResultF(interp,\"wrong # args: should be \\\"%s FILENAME DATA\\\"\", argv[0]);\n"
		3218	" return TCL_ERROR;\n"
		3219	" }\n"
		3220	" nData = strlen(argv[2]) + 1;\n"
		3221	" zData = Tcl_Alloc( nData );\n"
		3222	" if( zData ){\n"
		3223	" strcpy(zData, argv[2]);\n"
		3224	" Et_NewBuiltinFile(argv[1], zData, nData);\n"
		3225	" }\n"
		3226	" return TCL_OK;\n"
		3227	"}\n"
		3228	"#endif\n"
		3229	"\n"
		3230	"/*\n"
		3231	"** The following section implements the InsertProc functionality. The\n"
		3232	"** new InsertProc feature of Tcl8.0.3 and later allows us to overload\n"
		3233	"** the usual system call commands for file I/O and replace them with\n"
		3234	"** commands that operate on the built-in files.\n"
		3235	"*/\n"
		3236	"#ifdef ET_HAVE_INSERTPROC\n"
		3237	"\n"
		3238	"/* \n"
		3239	"** Each open channel to a built-in file is an instance of the\n"
		3240	"** following structure.\n"
		3241	"*/\n"
		3242	"typedef struct Et_FileStruct {\n"
		3243	" char zData; / All of the data */\n"
		3244	" int nData; /* Bytes of data, not counting the null terminator */\n"
		3245	" int cursor; /* How much of the data has been read so far */\n"
		3246	"} Et_FileStruct;\n"
		3247	"\n"
		3248	"/*\n"
		3249	"** Close a previously opened built-in file.\n"
		3250	"*/\n"
		3251	"static int Et_FileClose(ClientData instanceData, Tcl_Interp *interp){\n"
		3252	" Et_FileStruct p = (Et_FileStruct)instanceData;\n"
		3253	" Tcl_Free((char*)p);\n"
		3254	" return 0;\n"
		3255	"}\n"
		3256	"\n"
		3257	"/*\n"
		3258	"** Read from a built-in file.\n"
		3259	"*/\n"
		3260	"static int Et_FileInput(\n"
		3261	" ClientData instanceData, /* The file structure */\n"
		3262	" char buf, / Write the data read here */\n"
		3263	" int bufSize, /* Read this much data */\n"
		3264	" int pErrorCode / Write the error code here */\n"
		3265	"){\n"
		3266	" Et_FileStruct p = (Et_FileStruct)instanceData;\n"
		3267	" *pErrorCode = 0;\n"
		3268	" if( p->cursor+bufSize>p->nData ){\n"
		3269	" bufSize = p->nData - p->cursor;\n"
		3270	" }\n"
		3271	" memcpy(buf, &p->zData[p->cursor], bufSize);\n"
		3272	" p->cursor += bufSize;\n"
		3273	" return bufSize;\n"
		3274	"}\n"
		3275	"\n"
		3276	"/*\n"
		3277	"** Writes to a built-in file always return EOF.\n"
		3278	"*/\n"
		3279	"static int Et_FileOutput(\n"
		3280	" ClientData instanceData, /* The file structure */\n"
		3281	" char buf, / Read the data from here */\n"
		3282	" int toWrite, /* Write this much data */\n"
		3283	" int pErrorCode / Write the error code here */\n"
		3284	"){\n"
		3285	" *pErrorCode = 0;\n"
		3286	" return 0;\n"
		3287	"}\n"
		3288	"\n"
		3289	"/*\n"
		3290	"** Move the cursor around within the built-in file.\n"
		3291	"*/\n"
		3292	"static int Et_FileSeek(\n"
		3293	" ClientData instanceData, /* The file structure */\n"
		3294	" long offset, /* Offset to seek to */\n"
		3295	" int mode, /* One of SEEK_CUR, SEEK_SET or SEEK_END */\n"
		3296	" int pErrorCode / Write the error code here */\n"
		3297	"){\n"
		3298	" Et_FileStruct p = (Et_FileStruct)instanceData;\n"
		3299	" switch( mode ){\n"
		3300	" case SEEK_CUR: offset += p->cursor; break;\n"
		3301	" case SEEK_END: offset += p->nData; break;\n"
		3302	" default: break;\n"
		3303	" }\n"
		3304	" if( offset<0 ) offset = 0;\n"
		3305	" if( offset>p->nData ) offset = p->nData;\n"
		3306	" p->cursor = offset;\n"
		3307	" return offset;\n"
		3308	"}\n"
		3309	"\n"
		3310	"/*\n"
		3311	"** The Watch method is a no-op\n"
		3312	"*/\n"
		3313	"static void Et_FileWatch(ClientData instanceData, int mask){\n"
		3314	"}\n"
		3315	"\n"
		3316	"/*\n"
		3317	"** The Handle method always returns an error.\n"
		3318	"*/\n"
		3319	"static int Et_FileHandle(ClientData notUsed, int dir, ClientData *handlePtr){\n"
		3320	" return TCL_ERROR;\n"
		3321	"}\n"
		3322	"\n"
		3323	"/*\n"
		3324	"** This is the channel type that will access the built-in files.\n"
		3325	"*/\n"
		3326	"static Tcl_ChannelType builtinChannelType = {\n"
		3327	" \"builtin\", /* Type name. */\n"
		3328	" NULL, /* Always non-blocking.*/\n"
		3329	" Et_FileClose, /* Close proc. */\n"
		3330	" Et_FileInput, /* Input proc. */\n"
		3331	" Et_FileOutput, /* Output proc. */\n"
		3332	" Et_FileSeek, /* Seek proc. */\n"
		3333	" NULL, /* Set option proc. */\n"
		3334	" NULL, /* Get option proc. */\n"
		3335	" Et_FileWatch, /* Watch for events on console. */\n"
		3336	" Et_FileHandle, /* Get a handle from the device. */\n"
		3337	"};\n"
		3338	"\n"
		3339	"/*\n"
		3340	"** This routine attempts to do an open of a built-in file.\n"
		3341	"*/\n"
		3342	"static Tcl_Channel Et_FileOpen(\n"
		3343	" Tcl_Interp interp, / The TCL interpreter doing the open */\n"
		3344	" char zFilename, / Name of the file to open */\n"
		3345	" char modeString, / Mode string for the open (ignored) */\n"
		3346	" int permissions /* Permissions for a newly created file (ignored) */\n"
		3347	"){\n"
		3348	" char *zData;\n"
		3349	" Et_FileStruct *p;\n"
		3350	" int nData;\n"
		3351	" char zName[50];\n"
		3352	" Tcl_Channel chan;\n"
		3353	" static int count = 1;\n"
		3354	"\n"
		3355	" zData = FindBuiltinFile(zFilename, 1, &nData);\n"
		3356	" if( zData==0 ) return NULL;\n"
		3357	" p = (Et_FileStruct*)Tcl_Alloc( sizeof(Et_FileStruct) );\n"
		3358	" if( p==0 ) return NULL;\n"
		3359	" p->zData = zData;\n"
		3360	" p->nData = nData;\n"
		3361	" p->cursor = 0;\n"
		3362	" sprintf(zName,\"etbi_%x_%x\",((int)Et_FileOpen)>>12,count++);\n"
		3363	" chan = Tcl_CreateChannel(&builtinChannelType, zName, \n"
		3364	" (ClientData)p, TCL_READABLE);\n"
		3365	" return chan;\n"
		3366	"}\n"
		3367	"\n"
		3368	"/*\n"
		3369	"** This routine does a stat() system call for a built-in file.\n"
		3370	"*/\n"
		3371	"static int Et_FileStat(char path, struct stat buf){\n"
		3372	" char *zData;\n"
		3373	" int nData;\n"
		3374	"\n"
		3375	" zData = FindBuiltinFile(path, 0, &nData);\n"
		3376	" if( zData==0 ){\n"
		3377	" return -1;\n"
		3378	" }\n"
		3379	" memset(buf, 0, sizeof(*buf));\n"
		3380	" buf->st_mode = 0400;\n"
		3381	" buf->st_size = nData;\n"
		3382	" return 0;\n"
		3383	"}\n"
		3384	"\n"
		3385	"/*\n"
		3386	"** This routien does an access() system call for a built-in file.\n"
		3387	"*/\n"
		3388	"static int Et_FileAccess(char *path, int mode){\n"
		3389	" char *zData;\n"
		3390	"\n"
		3391	" if( mode & 3 ){\n"
		3392	" return -1;\n"
		3393	" }\n"
		3394	" zData = FindBuiltinFile(path, 0, 0);\n"
		3395	" if( zData==0 ){\n"
		3396	" return -1;\n"
		3397	" }\n"
		3398	" return 0; \n"
		3399	"}\n"
		3400	"#endif /* ET_HAVE_INSERTPROC */\n"
		3401	"\n"
		3402	"/*\n"
		3403	"** An overloaded version of \"source\". First check for the file\n"
		3404	"** is one of the built-ins. If it isn't a built-in, then check the\n"
		3405	"** disk. But if ET_STANDALONE is set (which corresponds to the\n"
		3406	"** \"Strict\" option in the user interface) then never check the disk.\n"
		3407	"** This gives us a quick way to check for the common error of\n"
		3408	"** sourcing a file that exists on the development by mistake, \n"
		3409	"** and only discovering the mistake when you move the program\n"
		3410	"** to your customer's machine.\n"
		3411	"*/\n"
		3412	"static int Et_Source(ET_TCLARGS){\n"
		3413	" char *z;\n"
		3414	"\n"
		3415	" if( argc!=2 ){\n"
		3416	" Et_ResultF(interp,\"wrong # args: should be \\\"%s FILENAME\\\"\", argv[0]);\n"
		3417	" return TCL_ERROR;\n"
		3418	" }\n"
		3419	" z = FindBuiltinFile(argv[1], 1, 0);\n"
		3420	" if( z ){\n"
		3421	" int rc;\n"
		3422	" rc = Tcl_Eval(interp,z);\n"
		3423	" if (rc == TCL_ERROR) {\n"
		3424	" char msg[200];\n"
		3425	" sprintf(msg, \"\\n (file \\\"%.150s\\\" line %d)\", argv[1],\n"
		3426	" interp->errorLine);\n"
		3427	" Tcl_AddErrorInfo(interp, msg);\n"
		3428	" } else {\n"
		3429	" rc = TCL_OK;\n"
		3430	" }\n"
		3431	" return rc;\n"
		3432	" }\n"
		3433	"#if ET_STANDALONE\n"
		3434	" Et_ResultF(interp,\"no such file: \\\"%s\\\"\", argv[1]);\n"
		3435	" return TCL_ERROR;\n"
		3436	"#else\n"
		3437	" return Tcl_EvalFile(interp,argv[1]);\n"
		3438	"#endif\n"
		3439	"}\n"
		3440	"\n"
		3441	"#ifndef ET_HAVE_INSERTPROC\n"
		3442	"/*\n"
		3443	"** An overloaded version of \"file exists\". First check for the file\n"
		3444	"** in the file table, then go to disk.\n"
		3445	"**\n"
		3446	"** We only overload \"file exists\" if we don't have InsertProc() \n"
		3447	"** procedures. If we do have InsertProc() procedures, they will\n"
		3448	"** handle this more efficiently.\n"
		3449	"*/\n"
		3450	"static int Et_FileExists(ET_TCLARGS){\n"
		3451	" int i, rc;\n"
		3452	" Tcl_DString str;\n"
		3453	" if( argc==3 && strncmp(argv[1],\"exis\",4)==0 ){\n"
		3454	" if( FindBuiltinFile(argv[2], 0, 0)!=0 ){\n"
		3455	" interp->result = \"1\";\n"
		3456	" return TCL_OK;\n"
		3457	" }\n"
		3458	" }\n"
		3459	" Tcl_DStringInit(&str);\n"
		3460	" Tcl_DStringAppendElement(&str,\"Et_FileCmd\");\n"
		3461	" for(i=1; i<argc; i++){\n"
		3462	" Tcl_DStringAppendElement(&str, argv[i]);\n"
		3463	" }\n"
		3464	" rc = Tcl_Eval(interp, Tcl_DStringValue(&str));\n"
		3465	" Tcl_DStringFree(&str);\n"
		3466	" return rc;\n"
		3467	"}\n"
		3468	"#endif\n"
		3469	"\n"
		3470	"/*\n"
		3471	"** This is the main Tcl interpreter. It's a global variable so it\n"
		3472	"** can be accessed easily from C code.\n"
		3473	"*/\n"
		3474	"Tcl_Interp *Et_Interp = 0;\n"
		3475	"\n"
		3476	"\n"
		3477	"#if ET_WIN32\n"
		3478	"/*\n"
		3479	"** Implement the Et_MessageBox command on Windows platforms. We\n"
		3480	"** use the MessageBox() function from the Win32 API so that the\n"
		3481	"** error message will be displayed as a dialog box. Writing to\n"
		3482	"** standard error doesn't do anything on windows.\n"
		3483	"*/\n"
		3484	"int Et_MessageBox(ET_TCLARGS){\n"
		3485	" char *zMsg = \"(Empty Message)\";\n"
		3486	" char *zTitle = \"Message...\";\n"
		3487	"\n"
		3488	" if( argc>1 ){\n"
		3489	" zTitle = argv[1];\n"
		3490	" }\n"
		3491	" if( argc>2 ){\n"
		3492	" zMsg = argv[2];\n"
		3493	" }\n"
		3494	" MessageBox(0, zMsg, zTitle, MB_ICONSTOP \| MB_OK);\n"
		3495	" return TCL_OK;\n"
		3496	"}\n"
		3497	"#endif\n"
		3498	"\n"
		3499	"/*\n"
		3500	"** A default implementation for \"bgerror\"\n"
		3501	"*/\n"
		3502	"static char zBgerror[] = \n"
		3503	" \"proc Et_Bgerror err {\\n\"\n"
		3504	" \" global errorInfo tk_library\\n\"\n"
		3505	" \" if {[info exists errorInfo]} {\\n\"\n"
		3506	" \" set ei $errorInfo\\n\"\n"
		3507	" \" } else {\\n\"\n"
		3508	" \" set ei {}\\n\"\n"
		3509	" \" }\\n\"\n"
		3510	" \" if {[catch {bgerror $err}]==0} return\\n\"\n"
		3511	" \" if {[string length $ei]>0} {\\n\"\n"
		3512	" \" set err $ei\\n\"\n"
		3513	" \" }\\n\"\n"
		3514	" \" if {[catch {Et_MessageBox {Error} $err}]} {\\n\"\n"
		3515	" \" puts stderr $err\\n\"\n"
		3516	" \" }\\n\"\n"
		3517	" \" exit\\n\"\n"
		3518	" \"}\\n\"\n"
		3519	";\n"
		3520	"\n"
		3521	"/*\n"
		3522	"** Do the initialization.\n"
		3523	"**\n"
		3524	"** This routine is called after the interpreter is created, but\n"
		3525	"** before Et_PreInit() or Et_AppInit() have been run.\n"
		3526	"*/\n"
		3527	"static int Et_DoInit(Tcl_Interp *interp){\n"
		3528	" int i;\n"
		3529	" extern int Et_PreInit(Tcl_Interp*);\n"
		3530	" extern int Et_AppInit(Tcl_Interp*);\n"
		3531	"\n"
		3532	" /* Insert our alternative stat(), access() and open() procedures\n"
		3533	" ** so that any attempt to work with a file will check our built-in\n"
		3534	" ** scripts first.\n"
		3535	" */\n"
		3536	"#ifdef ET_HAVE_INSERTPROC\n"
		3537	" TclStatInsertProc(Et_FileStat);\n"
		3538	" TclAccessInsertProc(Et_FileAccess);\n"
		3539	" TclOpenFileChannelInsertProc(Et_FileOpen);\n"
		3540	"#endif\n"
		3541	"\n"
		3542	" /* Initialize the hash-table for built-in scripts\n"
		3543	" */\n"
		3544	" FilenameHashInit();\n"
		3545	"\n"
		3546	" /* The Et_NewBuiltFile command is inserted for use by FreeWrap\n"
		3547	" ** and similar tools.\n"
		3548	" */\n"
		3549	"#if ET_HAVE_OBJ\n"
		3550	" Tcl_CreateObjCommand(interp,\"Et_NewBuiltinFile\",Et_NewBuiltinFileCmd,0,0);\n"
		3551	"#else\n"
		3552	" Tcl_CreateCommand(interp,\"Et_NewBuiltinFile\",Et_NewBuiltinFileCmd,0,0);\n"
		3553	"#endif\n"
		3554	"\n"
		3555	" /* Overload the \"file\" and \"source\" commands\n"
		3556	" */\n"
		3557	"#ifndef ET_HAVE_INSERTPROC\n"
		3558	" {\n"
		3559	" static char zRename[] = \"rename file Et_FileCmd\";\n"
		3560	" Tcl_Eval(interp,zRename);\n"
		3561	" Tcl_CreateCommand(interp,\"file\",Et_FileExists,0,0);\n"
		3562	" }\n"
		3563	"#endif\n"
		3564	" Tcl_CreateCommand(interp,\"source\",Et_Source,0,0);\n"
		3565	"\n"
		3566	" Et_Interp = interp;\n"
		3567	"#ifdef ET_TCL_LIBRARY\n"
		3568	" Tcl_SetVar(interp,\"tcl_library\",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);\n"
		3569	" Tcl_SetVar(interp,\"tcl_libPath\",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);\n"
		3570	" Tcl_SetVar2(interp,\"env\",\"TCL_LIBRARY\",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);\n"
		3571	"#endif\n"
		3572	"#ifdef ET_TK_LIBRARY\n"
		3573	" Tcl_SetVar(interp,\"tk_library\",ET_TK_LIBRARY,TCL_GLOBAL_ONLY);\n"
		3574	" Tcl_SetVar2(interp,\"env\",\"TK_LIBRARY\",ET_TK_LIBRARY,TCL_GLOBAL_ONLY);\n"
		3575	"#endif\n"
		3576	"#if ET_WIN32\n"
		3577	" Tcl_CreateCommand(interp,\"Et_MessageBox\",Et_MessageBox, 0, 0);\n"
		3578	"#endif \n"
		3579	" Tcl_Eval(interp,zBgerror);\n"
		3580	"#if ET_HAVE_PREINIT\n"
		3581	" if( Et_PreInit(interp) == TCL_ERROR ){\n"
		3582	" goto initerr;\n"
		3583	" }\n"
		3584	"#endif\n"
		3585	" if( Tcl_Init(interp) == TCL_ERROR ){\n"
		3586	" goto initerr;\n"
		3587	" }\n"
		3588	" Et_GlobalEvalF(interp,\"set dir $tcl_library;source $dir/tclIndex;unset dir\");\n"
		3589	"#if ET_ENABLE_TK\n"
		3590	" if( Tk_Init(interp) == TCL_ERROR ){\n"
		3591	" goto initerr;\n"
		3592	" }\n"
		3593	" Tcl_StaticPackage(interp,\"Tk\", Tk_Init, 0);\n"
		3594	" Et_GlobalEvalF(interp,\"set dir $tk_library;source $dir/tclIndex;unset dir\");\n"
		3595	"#endif\n"
		3596	" /* Tcl_SetVar(interp, \"tcl_rcFileName\", \"~/.wishrc\", TCL_GLOBAL_ONLY); */\n"
		3597	" for(i=0; i<sizeof(Et_CmdSet)/sizeof(Et_CmdSet[0]) - 1; i++){\n"
		3598	" Tcl_CreateCommand(interp, Et_CmdSet[i].zName, Et_CmdSet[i].xProc, 0, 0);\n"
		3599	" }\n"
		3600	"#if ET_ENABLE_OBJ\n"
		3601	" for(i=0; i<sizeof(Et_ObjSet)/sizeof(Et_ObjSet[0]) - 1; i++){\n"
		3602	" Tcl_CreateObjCommand(interp, Et_ObjSet[i].zName, Et_ObjSet[i].xProc, 0, 0);\n"
		3603	" }\n"
		3604	"#endif\n"
		3605	" Tcl_LinkVar(interp,\"Et_EvalTrace\",(char*)&Et_EvalTrace,TCL_LINK_BOOLEAN);\n"
		3606	" Tcl_SetVar(interp,\"et_version\",ET_VERSION,TCL_GLOBAL_ONLY);\n"
		3607	"#if ET_HAVE_APPINIT\n"
		3608	" if( Et_AppInit(interp) == TCL_ERROR ){\n"
		3609	" goto initerr;\n"
		3610	" }\n"
		3611	"#endif\n"
		3612	"#if ET_ENABLE_TK && !ET_EXTENSION\n"
		3613	" Et_NewBuiltinFile(\"builtin:/console.tcl\", zEtConsole, sizeof(zEtConsole));\n"
		3614	"#if ET_CONSOLE\n"
		3615	" Tcl_Eval(interp,\n"
		3616	" \"source builtin:/console.tcl\\n\"\n"
		3617	" \"console:create {.@console} {% } {Tcl/Tk Console}\\n\"\n"
		3618	" );\n"
		3619	"#endif\n"
		3620	"#endif\n"
		3621	"#ifdef ET_MAIN_SCRIPT\n"
		3622	" if( Et_EvalF(interp,\"source \\\"%q\\\"\", ET_MAIN_SCRIPT)!=TCL_OK ){\n"
		3623	" goto initerr;\n"
		3624	" }\n"
		3625	"#endif\n"
		3626	" return TCL_OK;\n"
		3627	"\n"
		3628	"initerr:\n"
		3629	" Et_EvalF(interp,\"Et_Bgerror \\\"%q\\\"\", interp->result);\n"
		3630	" return TCL_ERROR;\n"
		3631	"}\n"
		3632	"\n"
		3633	"#if ET_READ_STDIN==0 \|\| ET_AUTO_FORK!=0\n"
		3634	"/*\n"
		3635	"** Initialize everything.\n"
		3636	"*/\n"
		3637	"static int Et_Local_Init(int argc, char **argv){\n"
		3638	" Tcl_Interp *interp;\n"
		3639	" char *args;\n"
		3640	" char buf[100];\n"
		3641	"#if !ET_HAVE_CUSTOM_MAINLOOP\n"
		3642	" static char zWaitForever[] = \n"
		3643	"#if ET_ENABLE_TK\n"
		3644	" \"bind . <Destroy> {if {![winfo exists .]} exit}\\n\"\n"
		3645	"#endif\n"
		3646	" \"while 1 {vwait forever}\";\n"
		3647	"#endif\n"
		3648	"\n"
		3649	" Tcl_FindExecutable(argv[0]);\n"
		3650	" interp = Tcl_CreateInterp();\n"
		3651	" args = Tcl_Merge(argc-1, argv+1);\n"
		3652	" Tcl_SetVar(interp, \"argv\", args, TCL_GLOBAL_ONLY);\n"
		3653	" ckfree(args);\n"
		3654	" sprintf(buf, \"%d\", argc-1);\n"
		3655	" Tcl_SetVar(interp, \"argc\", buf, TCL_GLOBAL_ONLY);\n"
		3656	" Tcl_SetVar(interp, \"argv0\", argv[0], TCL_GLOBAL_ONLY);\n"
		3657	" Tcl_SetVar(interp, \"tcl_interactive\", \"0\", TCL_GLOBAL_ONLY);\n"
		3658	" Et_DoInit(interp);\n"
		3659	"#if ET_HAVE_CUSTOM_MAINLOOP\n"
		3660	" Et_CustomMainLoop(interp);\n"
		3661	"#else\n"
		3662	" Tcl_Eval(interp,zWaitForever);\n"
		3663	"#endif\n"
		3664	" return 0;\n"
		3665	"}\n"
		3666	"#endif\n"
		3667	"\n"
		3668	"/*\n"
		3669	"** This routine is called to do the complete initialization.\n"
		3670	"*/\n"
		3671	"int Et_Init(int argc, char **argv){\n"
		3672	"#ifdef ET_TCL_LIBRARY\n"
		3673	" putenv(\"TCL_LIBRARY=\" ET_TCL_LIBRARY);\n"
		3674	"#endif\n"
		3675	"#ifdef ET_TK_LIBRARY\n"
		3676	" putenv(\"TK_LIBRARY=\" ET_TK_LIBRARY);\n"
		3677	"#endif\n"
		3678	"#if ET_CONSOLE \|\| !ET_READ_STDIN\n"
		3679	" Et_Local_Init(argc, argv);\n"
		3680	"#else\n"
		3681	"# if ET_ENABLE_TK\n"
		3682	" Tk_Main(argc,argv,Et_DoInit);\n"
		3683	"# else\n"
		3684	" Tcl_Main(argc, argv, Et_DoInit);\n"
		3685	"# endif\n"
		3686	"#endif\n"
		3687	" return 0;\n"
		3688	"}\n"
		3689	"\n"
		3690	"#if !ET_HAVE_MAIN && !ET_EXTENSION\n"
		3691	"/*\n"
		3692	"** Main routine for UNIX programs. If the user has supplied\n"
		3693	"** their own main() routine in a C module, then the ET_HAVE_MAIN\n"
		3694	"** macro will be set to 1 and this code will be skipped.\n"
		3695	"*/\n"
		3696	"int main(int argc, char **argv){\n"
		3697	"#if ET_AUTO_FORK\n"
		3698	" int rc = fork();\n"
		3699	" if( rc<0 ){\n"
		3700	" perror(\"can't fork\");\n"
		3701	" exit(1);\n"
		3702	" }\n"
		3703	" if( rc>0 ) return 0;\n"
		3704	" close(0);\n"
		3705	" open(\"/dev/null\",O_RDONLY);\n"
		3706	" close(1);\n"
		3707	" open(\"/dev/null\",O_WRONLY);\n"
		3708	"#endif\n"
		3709	" return Et_Init(argc,argv)!=TCL_OK;\n"
		3710	"}\n"
		3711	"#endif\n"
		3712	"\n"
		3713	"#if ET_EXTENSION\n"
		3714	"/*\n"
		3715	"** If the -extension flag is used, then generate code that will be\n"
		3716	"** turned into a loadable shared library or DLL, not a standalone\n"
		3717	"** executable.\n"
		3718	"*/\n"
		3719	"int ET_EXTENSION_NAME(Tcl_Interp *interp){\n"
		3720	" int i;\n"
		3721	"#ifndef ET_HAVE_INSERTPROC\n"
		3722	" Tcl_AppendResult(interp,\n"
		3723	" \"mktclapp can only generate extensions for Tcl/Tk version \"\n"
		3724	" \"8.0.3 and later. This is version \"\n"
		3725	" TCL_MAJOR_VERSION \".\" TCL_MINOR_VERSION \".\" TCL_RELEASE_SERIAL, 0);\n"
		3726	" return TCL_ERROR;\n"
		3727	"#endif\n"
		3728	"#ifdef ET_HAVE_INSERTPROC\n"
		3729	"#ifdef USE_TCL_STUBS\n"
		3730	" if( Tcl_InitStubs(interp,\"8.0\",0)==0 ){\n"
		3731	" return TCL_ERROR;\n"
		3732	" }\n"
		3733	" if( Tk_InitStubs(interp,\"8.0\",0)==0 ){\n"
		3734	" return TCL_ERROR;\n"
		3735	" }\n"
		3736	"#endif\n"
		3737	" Et_Interp = interp;\n"
		3738	" TclStatInsertProc(Et_FileStat);\n"
		3739	" TclAccessInsertProc(Et_FileAccess);\n"
		3740	" TclOpenFileChannelInsertProc(Et_FileOpen);\n"
		3741	" FilenameHashInit();\n"
		3742	" for(i=0; i<sizeof(Et_CmdSet)/sizeof(Et_CmdSet[0]) - 1; i++){\n"
		3743	" Tcl_CreateCommand(interp, Et_CmdSet[i].zName, Et_CmdSet[i].xProc, 0, 0);\n"
		3744	" }\n"
		3745	"#if ET_ENABLE_OBJ\n"
		3746	" for(i=0; i<sizeof(Et_ObjSet)/sizeof(Et_ObjSet[0]) - 1; i++){\n"
		3747	" Tcl_CreateObjCommand(interp, Et_ObjSet[i].zName, Et_ObjSet[i].xProc, 0, 0);\n"
		3748	" }\n"
		3749	"#endif\n"
		3750	" Tcl_LinkVar(interp,\"Et_EvalTrace\",(char*)&Et_EvalTrace,TCL_LINK_BOOLEAN);\n"
		3751	" Tcl_SetVar(interp,\"et_version\",ET_VERSION,TCL_GLOBAL_ONLY);\n"
		3752	"#if ET_HAVE_APPINIT\n"
		3753	" if( Et_AppInit(interp) == TCL_ERROR ){\n"
		3754	" return TCL_ERROR;\n"
		3755	" }\n"
		3756	"#endif\n"
		3757	"#ifdef ET_MAIN_SCRIPT\n"
		3758	" if( Et_EvalF(interp,\"source \\\"%q\\\"\", ET_MAIN_SCRIPT)!=TCL_OK ){\n"
		3759	" return TCL_ERROR;\n"
		3760	" }\n"
		3761	"#endif\n"
		3762	" return TCL_OK;\n"
		3763	"#endif /* ET_HAVE_INSERTPROC */\n"
		3764	"}\n"
		3765	"int ET_SAFE_EXTENSION_NAME(Tcl_Interp *interp){\n"
		3766	" return ET_EXTENSION_NAME(interp);\n"
		3767	"}\n"
		3768	"#endif\n";

Subversion Repositories Vertical

(root)/branches/metal/mktclapp/mktclapp.c – Rev 11