WebSVN – Vertical – Blame – /branches/metal/vertcl_src/vertcl_main.c

Rev	Author	Line No.	Line
2	mjames	1	/* This code is automatically generated by "mktclapp" version 3.9 */
		2	/* DO NOT EDIT */
		3	#include <tcl.h>
		4	#define INTERFACE 1
		5	#if INTERFACE
		6	#define ET_TCLARGS ClientData clientData, Tcl_Interp interp, int argc, char *argv
		7	#define ET_OBJARGS ClientData clientData, Tcl_Interp interp, int objc, Tcl_Obj CONST objv[]
		8	#endif
		9	#define ET_ENABLE_OBJ 0
		10	#define ET_ENABLE_TK 1
		11	#define ET_AUTO_FORK 0
		12	#define ET_STANDALONE 0
		13	#define ET_N_BUILTIN_SCRIPT 2
		14	#define ET_VERSION "3.9"
		15	#define ET_HAVE_APPINIT 0
		16	#define ET_HAVE_PREINIT 0
		17	#define ET_HAVE_MAIN 1
		18	#define ET_HAVE_CUSTOM_MAINLOOP 0
		19	#define ET_TCL_LIBRARY "C:/cygwin/usr/share/tcl8.0"
		20	#define ET_TK_LIBRARY "C:/cygwin/usr/share/tk8.0"
		21	#define ET_MAIN_SCRIPT "C:/cygwin/home/vertical/scripts/trial.tcl"
		22	#define ET_EXTENSION 0
		23	#define ET_SHROUD_KEY 0
		24	#define ET_READ_STDIN 1
		25	#define ET_CONSOLE 0
		26	extern int ET_COMMAND_vertical (ET_TCLARGS);
		27	extern int ET_COMMAND_wossat (ET_TCLARGS);
		28	static struct
		29	{
		30	char *zName;
		31	int (*xProc) (ET_TCLARGS);
		32	} Et_CmdSet[] = {{"vertical", ET_COMMAND_vertical}, {"wossat", ET_COMMAND_wossat}, {0, 0}};
		33	static char Et_zFile0[] =
		34	"# Tcl autoload index file, version 2.0\n"
		35	"# This file is generated by the \"auto_mkindex\" command\n"
		36	"# and sourced to set up indexing information for one or\n"
		37	"# more commands. Typically each line is a command that\n"
		38	"# sets an element in the auto_index array, where the\n"
		39	"# element name is the name of a command and the value is\n"
		40	"# a script that loads the command.\n"
		41	"\n"
		42	"set auto_index(history) [list source [file join $dir history.tcl]]\n"
		43	"set auto_index(tclLdAout) [list source [file join $dir ldAout.tcl]]\n"
		44	"set auto_index(parray) [list source [file join $dir parray.tcl]]\n"
		45	"set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]]\n"
		46	"set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]]\n"
		47	"set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]]\n"
		48	"set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]]\n"
		49	"set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]]\n"
		50	"set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]]\n"
		51	"set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]]\n"
		52	"set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]]\n"
		53	"set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]]\n"
		54	"set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]]\n"
		55	"set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]]\n"
		56	"set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]]\n";
		57	static char Et_zFile1[] =
		58	"# Tcl autoload index file, version 2.0\n"
		59	"# This file is generated by the \"auto_mkindex\" command\n"
		60	"# and sourced to set up indexing information for one or\n"
		61	"# more commands. Typically each line is a command that\n"
		62	"# sets an element in the auto_index array, where the\n"
		63	"# element name is the name of a command and the value is\n"
		64	"# a script that loads the command.\n"
		65	"\n"
		66	"set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]\n"
		67	"set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]\n"
		68	"set auto_index(tkCheckRadioEnter) [list source [file join $dir button.tcl]]\n"
		69	"set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]\n"
		70	"set auto_index(tkCheckRadioDown) [list source [file join $dir button.tcl]]\n"
		71	"set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]\n"
		72	"set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]\n"
		73	"set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]\n"
		74	"set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]\n"
		75	"set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]\n"
		76	"set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]\n"
		77	"set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]\n"
		78	"set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]\n"
		79	"set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]\n"
		80	"set auto_index(tkButtonInvoke) [list source [file join $dir button.tcl]]\n"
		81	"set auto_index(tkCheckRadioInvoke) [list source [file join $dir button.tcl]]\n"
		82	"set auto_index(tk_dialog) [list source [file join $dir dialog.tcl]]\n"
		83	"set auto_index(tkEntryClosestGap) [list source [file join $dir entry.tcl]]\n"
		84	"set auto_index(tkEntryButton1) [list source [file join $dir entry.tcl]]\n"
		85	"set auto_index(tkEntryMouseSelect) [list source [file join $dir entry.tcl]]\n"
		86	"set auto_index(tkEntryPaste) [list source [file join $dir entry.tcl]]\n"
		87	"set auto_index(tkEntryAutoScan) [list source [file join $dir entry.tcl]]\n"
		88	"set auto_index(tkEntryKeySelect) [list source [file join $dir entry.tcl]]\n"
		89	"set auto_index(tkEntryInsert) [list source [file join $dir entry.tcl]]\n"
		90	"set auto_index(tkEntryBackspace) [list source [file join $dir entry.tcl]]\n"
		91	"set auto_index(tkEntrySeeInsert) [list source [file join $dir entry.tcl]]\n"
		92	"set auto_index(tkEntrySetCursor) [list source [file join $dir entry.tcl]]\n"
		93	"set auto_index(tkEntryTranspose) [list source [file join $dir entry.tcl]]\n"
		94	"set auto_index(tkEntryPreviousWord) [list source [file join $dir entry.tcl]]\n"
		95	"set auto_index(tkListboxBeginSelect) [list source [file join $dir listbox.tcl]]\n"
		96	"set auto_index(tkListboxMotion) [list source [file join $dir listbox.tcl]]\n"
		97	"set auto_index(tkListboxBeginExtend) [list source [file join $dir listbox.tcl]]\n"
		98	"set auto_index(tkListboxBeginToggle) [list source [file join $dir listbox.tcl]]\n"
		99	"set auto_index(tkListboxAutoScan) [list source [file join $dir listbox.tcl]]\n"
		100	"set auto_index(tkListboxUpDown) [list source [file join $dir listbox.tcl]]\n"
		101	"set auto_index(tkListboxExtendUpDown) [list source [file join $dir listbox.tcl]]\n"
		102	"set auto_index(tkListboxDataExtend) [list source [file join $dir listbox.tcl]]\n"
		103	"set auto_index(tkListboxCancel) [list source [file join $dir listbox.tcl]]\n"
		104	"set auto_index(tkListboxSelectAll) [list source [file join $dir listbox.tcl]]\n"
		105	"set auto_index(tkMbEnter) [list source [file join $dir menu.tcl]]\n"
		106	"set auto_index(tkMbLeave) [list source [file join $dir menu.tcl]]\n"
		107	"set auto_index(tkMbPost) [list source [file join $dir menu.tcl]]\n"
		108	"set auto_index(tkMenuUnpost) [list source [file join $dir menu.tcl]]\n"
		109	"set auto_index(tkMbMotion) [list source [file join $dir menu.tcl]]\n"
		110	"set auto_index(tkMbButtonUp) [list source [file join $dir menu.tcl]]\n"
		111	"set auto_index(tkMenuMotion) [list source [file join $dir menu.tcl]]\n"
		112	"set auto_index(tkMenuButtonDown) [list source [file join $dir menu.tcl]]\n"
		113	"set auto_index(tkMenuLeave) [list source [file join $dir menu.tcl]]\n"
		114	"set auto_index(tkMenuInvoke) [list source [file join $dir menu.tcl]]\n"
		115	"set auto_index(tkMenuEscape) [list source [file join $dir menu.tcl]]\n"
		116	"set auto_index(tkMenuUpArrow) [list source [file join $dir menu.tcl]]\n"
		117	"set auto_index(tkMenuDownArrow) [list source [file join $dir menu.tcl]]\n"
		118	"set auto_index(tkMenuLeftArrow) [list source [file join $dir menu.tcl]]\n"
		119	"set auto_index(tkMenuRightArrow) [list source [file join $dir menu.tcl]]\n"
		120	"set auto_index(tkMenuNextMenu) [list source [file join $dir menu.tcl]]\n"
		121	"set auto_index(tkMenuNextEntry) [list source [file join $dir menu.tcl]]\n"
		122	"set auto_index(tkMenuFind) [list source [file join $dir menu.tcl]]\n"
		123	"set auto_index(tkTraverseToMenu) [list source [file join $dir menu.tcl]]\n"
		124	"set auto_index(tkFirstMenu) [list source [file join $dir menu.tcl]]\n"
		125	"set auto_index(tkTraverseWithinMenu) [list source [file join $dir menu.tcl]]\n"
		126	"set auto_index(tkMenuFirstEntry) [list source [file join $dir menu.tcl]]\n"
		127	"set auto_index(tkMenuFindName) [list source [file join $dir menu.tcl]]\n"
		128	"set auto_index(tkPostOverPoint) [list source [file join $dir menu.tcl]]\n"
		129	"set auto_index(tkSaveGrabInfo) [list source [file join $dir menu.tcl]]\n"
		130	"set auto_index(tkRestoreOldGrab) [list source [file join $dir menu.tcl]]\n"
		131	"set auto_index(tk_menuSetFocus) [list source [file join $dir menu.tcl]]\n"
		132	"set auto_index(tkGenerateMenuSelect) [list source [file join $dir menu.tcl]]\n"
		133	"set auto_index(tk_popup) [list source [file join $dir menu.tcl]]\n"
		134	"set auto_index(tkScrollButtonDown) [list source [file join $dir scrlbar.tcl]]\n"
		135	"set auto_index(tkScrollButtonUp) [list source [file join $dir scrlbar.tcl]]\n"
		136	"set auto_index(tkScrollSelect) [list source [file join $dir scrlbar.tcl]]\n"
		137	"set auto_index(tkScrollStartDrag) [list source [file join $dir scrlbar.tcl]]\n"
		138	"set auto_index(tkScrollDrag) [list source [file join $dir scrlbar.tcl]]\n"
		139	"set auto_index(tkScrollEndDrag) [list source [file join $dir scrlbar.tcl]]\n"
		140	"set auto_index(tkScrollByUnits) [list source [file join $dir scrlbar.tcl]]\n"
		141	"set auto_index(tkScrollByPages) [list source [file join $dir scrlbar.tcl]]\n"
		142	"set auto_index(tkScrollToPos) [list source [file join $dir scrlbar.tcl]]\n"
		143	"set auto_index(tkScrollTopBottom) [list source [file join $dir scrlbar.tcl]]\n"
		144	"set auto_index(tkScrollButton2Down) [list source [file join $dir scrlbar.tcl]]\n"
		145	"set auto_index(tkTextClosestGap) [list source [file join $dir text.tcl]]\n"
		146	"set auto_index(tkTextButton1) [list source [file join $dir text.tcl]]\n"
		147	"set auto_index(tkTextSelectTo) [list source [file join $dir text.tcl]]\n"
		148	"set auto_index(tkTextKeyExtend) [list source [file join $dir text.tcl]]\n"
		149	"set auto_index(tkTextPaste) [list source [file join $dir text.tcl]]\n"
		150	"set auto_index(tkTextAutoScan) [list source [file join $dir text.tcl]]\n"
		151	"set auto_index(tkTextSetCursor) [list source [file join $dir text.tcl]]\n"
		152	"set auto_index(tkTextKeySelect) [list source [file join $dir text.tcl]]\n"
		153	"set auto_index(tkTextResetAnchor) [list source [file join $dir text.tcl]]\n"
		154	"set auto_index(tkTextInsert) [list source [file join $dir text.tcl]]\n"
		155	"set auto_index(tkTextUpDownLine) [list source [file join $dir text.tcl]]\n"
		156	"set auto_index(tkTextPrevPara) [list source [file join $dir text.tcl]]\n"
		157	"set auto_index(tkTextNextPara) [list source [file join $dir text.tcl]]\n"
		158	"set auto_index(tkTextScrollPages) [list source [file join $dir text.tcl]]\n"
		159	"set auto_index(tkTextTranspose) [list source [file join $dir text.tcl]]\n"
		160	"set auto_index(tk_textCopy) [list source [file join $dir text.tcl]]\n"
		161	"set auto_index(tk_textCut) [list source [file join $dir text.tcl]]\n"
		162	"set auto_index(tk_textPaste) [list source [file join $dir text.tcl]]\n"
		163	"set auto_index(tkTextNextPos) [list source [file join $dir text.tcl]]\n"
		164	"set auto_index(tkTextPrevPos) [list source [file join $dir text.tcl]]\n"
		165	"set auto_index(tkScreenChanged) [list source [file join $dir tk.tcl]]\n"
		166	"set auto_index(tkEventMotifBindings) [list source [file join $dir tk.tcl]]\n"
		167	"set auto_index(tkCancelRepeat) [list source [file join $dir tk.tcl]]\n"
		168	"set auto_index(tkTabToWindow) [list source [file join $dir tk.tcl]]\n"
		169	"set auto_index(bgerror) [list source [file join $dir bgerror.tcl]]\n"
		170	"set auto_index(tkScaleActivate) [list source [file join $dir scale.tcl]]\n"
		171	"set auto_index(tkScaleButtonDown) [list source [file join $dir scale.tcl]]\n"
		172	"set auto_index(tkScaleDrag) [list source [file join $dir scale.tcl]]\n"
		173	"set auto_index(tkScaleEndDrag) [list source [file join $dir scale.tcl]]\n"
		174	"set auto_index(tkScaleIncrement) [list source [file join $dir scale.tcl]]\n"
		175	"set auto_index(tkScaleControlPress) [list source [file join $dir scale.tcl]]\n"
		176	"set auto_index(tkScaleButton2Down) [list source [file join $dir scale.tcl]]\n"
		177	"set auto_index(tk_optionMenu) [list source [file join $dir optMenu.tcl]]\n"
		178	"set auto_index(tkTearOffMenu) [list source [file join $dir tearoff.tcl]]\n"
		179	"set auto_index(tkMenuDup) [list source [file join $dir tearoff.tcl]]\n"
		180	"set auto_index(tk_menuBar) [list source [file join $dir obsolete.tcl]]\n"
		181	"set auto_index(tk_bindForTraversal) [list source [file join $dir obsolete.tcl]]\n"
		182	"set auto_index(tk_focusNext) [list source [file join $dir focus.tcl]]\n"
		183	"set auto_index(tk_focusPrev) [list source [file join $dir focus.tcl]]\n"
		184	"set auto_index(tkFocusOK) [list source [file join $dir focus.tcl]]\n"
		185	"set auto_index(tk_focusFollowsMouse) [list source [file join $dir focus.tcl]]\n"
		186	"set auto_index(tkConsoleInit) [list source [file join $dir console.tcl]]\n"
		187	"set auto_index(tkConsoleSource) [list source [file join $dir console.tcl]]\n"
		188	"set auto_index(tkConsoleInvoke) [list source [file join $dir console.tcl]]\n"
		189	"set auto_index(tkConsoleHistory) [list source [file join $dir console.tcl]]\n"
		190	"set auto_index(tkConsolePrompt) [list source [file join $dir console.tcl]]\n"
		191	"set auto_index(tkConsoleBind) [list source [file join $dir console.tcl]]\n"
		192	"set auto_index(tkConsoleInsert) [list source [file join $dir console.tcl]]\n"
		193	"set auto_index(tkConsoleOutput) [list source [file join $dir console.tcl]]\n"
		194	"set auto_index(tkConsoleExit) [list source [file join $dir console.tcl]]\n"
		195	"set auto_index(tkConsoleAbout) [list source [file join $dir console.tcl]]\n"
		196	"set auto_index(tk_setPalette) [list source [file join $dir palette.tcl]]\n"
		197	"set auto_index(tkRecolorTree) [list source [file join $dir palette.tcl]]\n"
		198	"set auto_index(tkDarken) [list source [file join $dir palette.tcl]]\n"
		199	"set auto_index(tk_bisque) [list source [file join $dir palette.tcl]]\n"
		200	"set auto_index(tkColorDialog) [list source [file join $dir clrpick.tcl]]\n"
		201	"set auto_index(tkColorDialog_InitValues) [list source [file join $dir clrpick.tcl]]\n"
		202	"set auto_index(tkColorDialog_Config) [list source [file join $dir clrpick.tcl]]\n"
		203	"set auto_index(tkColorDialog_BuildDialog) [list source [file join $dir clrpick.tcl]]\n"
		204	"set auto_index(tkColorDialog_SetRGBValue) [list source [file join $dir clrpick.tcl]]\n"
		205	"set auto_index(tkColorDialog_XToRgb) [list source [file join $dir clrpick.tcl]]\n"
		206	"set auto_index(tkColorDialog_RgbToX) [list source [file join $dir clrpick.tcl]]\n"
		207	"set auto_index(tkColorDialog_DrawColorScale) [list source [file join $dir clrpick.tcl]]\n"
		208	"set auto_index(tkColorDialog_CreateSelector) [list source [file join $dir clrpick.tcl]]\n"
		209	"set auto_index(tkColorDialog_RedrawFinalColor) [list source [file join $dir "
		210	"clrpick.tcl]]\n"
		211	"set auto_index(tkColorDialog_RedrawColorBars) [list source [file join $dir "
		212	"clrpick.tcl]]\n"
		213	"set auto_index(tkColorDialog_StartMove) [list source [file join $dir clrpick.tcl]]\n"
		214	"set auto_index(tkColorDialog_MoveSelector) [list source [file join $dir clrpick.tcl]]\n"
		215	"set auto_index(tkColorDialog_ReleaseMouse) [list source [file join $dir clrpick.tcl]]\n"
		216	"set auto_index(tkColorDialog_ResizeColorBars) [list source [file join $dir "
		217	"clrpick.tcl]]\n"
		218	"set auto_index(tkColorDialog_HandleSelEntry) [list source [file join $dir clrpick.tcl]]\n"
		219	"set auto_index(tkColorDialog_HandleRGBEntry) [list source [file join $dir clrpick.tcl]]\n"
		220	"set auto_index(tkColorDialog_EnterColorBar) [list source [file join $dir clrpick.tcl]]\n"
		221	"set auto_index(tkColorDialog_LeaveColorBar) [list source [file join $dir clrpick.tcl]]\n"
		222	"set auto_index(tkColorDialog_OkCmd) [list source [file join $dir clrpick.tcl]]\n"
		223	"set auto_index(tkColorDialog_CancelCmd) [list source [file join $dir clrpick.tcl]]\n"
		224	"set auto_index(tclParseConfigSpec) [list source [file join $dir comdlg.tcl]]\n"
		225	"set auto_index(tclListValidFlags) [list source [file join $dir comdlg.tcl]]\n"
		226	"set auto_index(tclSortNoCase) [list source [file join $dir comdlg.tcl]]\n"
		227	"set auto_index(tclVerifyInteger) [list source [file join $dir comdlg.tcl]]\n"
		228	"set auto_index(tkFocusGroup_Create) [list source [file join $dir comdlg.tcl]]\n"
		229	"set auto_index(tkFocusGroup_BindIn) [list source [file join $dir comdlg.tcl]]\n"
		230	"set auto_index(tkFocusGroup_BindOut) [list source [file join $dir comdlg.tcl]]\n"
		231	"set auto_index(tkFocusGroup_Destroy) [list source [file join $dir comdlg.tcl]]\n"
		232	"set auto_index(tkFocusGroup_In) [list source [file join $dir comdlg.tcl]]\n"
		233	"set auto_index(tkFocusGroup_Out) [list source [file join $dir comdlg.tcl]]\n"
		234	"set auto_index(tkFDGetFileTypes) [list source [file join $dir comdlg.tcl]]\n"
		235	"set auto_index(::safe::loadTk) [list source [file join $dir safetk.tcl]]\n"
		236	"set auto_index(::safe::TkInit) [list source [file join $dir safetk.tcl]]\n"
		237	"set auto_index(::safe::allowTk) [list source [file join $dir safetk.tcl]]\n"
		238	"set auto_index(::safe::tkTopLevel) [list source [file join $dir safetk.tcl]]\n"
		239	"set auto_index(tkMessageBox) [list source [file join $dir msgbox.tcl]]\n"
		240	"set auto_index(tkIconList) [list source [file join $dir tkfbox.tcl]]\n"
		241	"set auto_index(tkIconList_Config) [list source [file join $dir tkfbox.tcl]]\n"
		242	"set auto_index(tkIconList_Create) [list source [file join $dir tkfbox.tcl]]\n"
		243	"set auto_index(tkIconList_AutoScan) [list source [file join $dir tkfbox.tcl]]\n"
		244	"set auto_index(tkIconList_DeleteAll) [list source [file join $dir tkfbox.tcl]]\n"
		245	"set auto_index(tkIconList_Add) [list source [file join $dir tkfbox.tcl]]\n"
		246	"set auto_index(tkIconList_Arrange) [list source [file join $dir tkfbox.tcl]]\n"
		247	"set auto_index(tkIconList_Invoke) [list source [file join $dir tkfbox.tcl]]\n"
		248	"set auto_index(tkIconList_See) [list source [file join $dir tkfbox.tcl]]\n"
		249	"set auto_index(tkIconList_SelectAtXY) [list source [file join $dir tkfbox.tcl]]\n"
		250	"set auto_index(tkIconList_Select) [list source [file join $dir tkfbox.tcl]]\n"
		251	"set auto_index(tkIconList_Unselect) [list source [file join $dir tkfbox.tcl]]\n"
		252	"set auto_index(tkIconList_Get) [list source [file join $dir tkfbox.tcl]]\n"
		253	"set auto_index(tkIconList_Btn1) [list source [file join $dir tkfbox.tcl]]\n"
		254	"set auto_index(tkIconList_Motion1) [list source [file join $dir tkfbox.tcl]]\n"
		255	"set auto_index(tkIconList_Double1) [list source [file join $dir tkfbox.tcl]]\n"
		256	"set auto_index(tkIconList_ReturnKey) [list source [file join $dir tkfbox.tcl]]\n"
		257	"set auto_index(tkIconList_Leave1) [list source [file join $dir tkfbox.tcl]]\n"
		258	"set auto_index(tkIconList_FocusIn) [list source [file join $dir tkfbox.tcl]]\n"
		259	"set auto_index(tkIconList_UpDown) [list source [file join $dir tkfbox.tcl]]\n"
		260	"set auto_index(tkIconList_LeftRight) [list source [file join $dir tkfbox.tcl]]\n"
		261	"set auto_index(tkIconList_KeyPress) [list source [file join $dir tkfbox.tcl]]\n"
		262	"set auto_index(tkIconList_Goto) [list source [file join $dir tkfbox.tcl]]\n"
		263	"set auto_index(tkIconList_Reset) [list source [file join $dir tkfbox.tcl]]\n"
		264	"set auto_index(tkFDialog) [list source [file join $dir tkfbox.tcl]]\n"
		265	"set auto_index(tkFDialog_Config) [list source [file join $dir tkfbox.tcl]]\n"
		266	"set auto_index(tkFDialog_Create) [list source [file join $dir tkfbox.tcl]]\n"
		267	"set auto_index(tkFDialog_UpdateWhenIdle) [list source [file join $dir tkfbox.tcl]]\n"
		268	"set auto_index(tkFDialog_Update) [list source [file join $dir tkfbox.tcl]]\n"
		269	"set auto_index(tkFDialog_SetPathSilently) [list source [file join $dir tkfbox.tcl]]\n"
		270	"set auto_index(tkFDialog_SetPath) [list source [file join $dir tkfbox.tcl]]\n"
		271	"set auto_index(tkFDialog_SetFilter) [list source [file join $dir tkfbox.tcl]]\n"
		272	"set auto_index(tkFDialogResolveFile) [list source [file join $dir tkfbox.tcl]]\n"
		273	"set auto_index(tkFDialog_EntFocusIn) [list source [file join $dir tkfbox.tcl]]\n"
		274	"set auto_index(tkFDialog_EntFocusOut) [list source [file join $dir tkfbox.tcl]]\n"
		275	"set auto_index(tkFDialog_ActivateEnt) [list source [file join $dir tkfbox.tcl]]\n"
		276	"set auto_index(tkFDialog_InvokeBtn) [list source [file join $dir tkfbox.tcl]]\n"
		277	"set auto_index(tkFDialog_UpDirCmd) [list source [file join $dir tkfbox.tcl]]\n"
		278	"set auto_index(tkFDialog_JoinFile) [list source [file join $dir tkfbox.tcl]]\n"
		279	"set auto_index(tkFDialog_OkCmd) [list source [file join $dir tkfbox.tcl]]\n"
		280	"set auto_index(tkFDialog_CancelCmd) [list source [file join $dir tkfbox.tcl]]\n"
		281	"set auto_index(tkFDialog_ListBrowse) [list source [file join $dir tkfbox.tcl]]\n"
		282	"set auto_index(tkFDialog_ListInvoke) [list source [file join $dir tkfbox.tcl]]\n"
		283	"set auto_index(tkFDialog_Done) [list source [file join $dir tkfbox.tcl]]\n"
		284	"set auto_index(tkMotifFDialog) [list source [file join $dir xmfbox.tcl]]\n"
		285	"set auto_index(tkMotifFDialog_Config) [list source [file join $dir xmfbox.tcl]]\n"
		286	"set auto_index(tkMotifFDialog_Create) [list source [file join $dir xmfbox.tcl]]\n"
		287	"set auto_index(tkMotifFDialog_MakeSList) [list source [file join $dir xmfbox.tcl]]\n"
		288	"set auto_index(tkMotifFDialog_BrowseDList) [list source [file join $dir xmfbox.tcl]]\n"
		289	"set auto_index(tkMotifFDialog_ActivateDList) [list source [file join $dir xmfbox.tcl]]\n"
		290	"set auto_index(tkMotifFDialog_BrowseFList) [list source [file join $dir xmfbox.tcl]]\n"
		291	"set auto_index(tkMotifFDialog_ActivateFList) [list source [file join $dir xmfbox.tcl]]\n"
		292	"set auto_index(tkMotifFDialog_ActivateFEnt) [list source [file join $dir xmfbox.tcl]]\n"
		293	"set auto_index(tkMotifFDialog_InterpFilter) [list source [file join $dir xmfbox.tcl]]\n"
		294	"set auto_index(tkMotifFDialog_ActivateSEnt) [list source [file join $dir xmfbox.tcl]]\n"
		295	"set auto_index(tkMotifFDialog_OkCmd) [list source [file join $dir xmfbox.tcl]]\n"
		296	"set auto_index(tkMotifFDialog_FilterCmd) [list source [file join $dir xmfbox.tcl]]\n"
		297	"set auto_index(tkMotifFDialog_CancelCmd) [list source [file join $dir xmfbox.tcl]]\n"
		298	"set auto_index(tkMotifFDialog_Update) [list source [file join $dir xmfbox.tcl]]\n"
		299	"set auto_index(tkMotifFDialog_LoadFiles) [list source [file join $dir xmfbox.tcl]]\n"
		300	"set auto_index(tkListBoxKeyAccel_Set) [list source [file join $dir xmfbox.tcl]]\n"
		301	"set auto_index(tkListBoxKeyAccel_Unset) [list source [file join $dir xmfbox.tcl]]\n"
		302	"set auto_index(tkListBoxKeyAccel_Key) [list source [file join $dir xmfbox.tcl]]\n"
		303	"set auto_index(tkListBoxKeyAccel_Goto) [list source [file join $dir xmfbox.tcl]]\n"
		304	"set auto_index(tkListBoxKeyAccel_Reset) [list source [file join $dir xmfbox.tcl]]\n";
		305	struct EtFile
		306	{
		307	char *zName;
		308	char *zData;
		309	int nData;
		310	int shrouded;
		311	struct EtFile *pNext;
		312	};
		313	static struct EtFile Et_FileSet[] = {
		314	{"C:/cygwin/usr/share/tcl8.0/tclIndex", Et_zFile0, sizeof (Et_zFile0) - 1, 0, 0},
		315	{"C:/cygwin/usr/share/tk8.0/tclIndex", Et_zFile1, sizeof (Et_zFile1) - 1, 0, 0},
		316	{0, 0}};
		317	static struct EtFile *Et_FileHashTable[71];
		318	/* The following copyright notice applies to code generated by
		319	** "mktclapp". The "mktclapp" program itself is covered by the
		320	** GNU Public License.
		321	**
		322	** Copyright (c) 1998 D. Richard Hipp
		323	**
		324	** The author hereby grants permission to use, copy, modify, distribute,
		325	** and license this software and its documentation for any purpose, provided
		326	** that existing copyright notices are retained in all copies and that this
		327	** notice is included verbatim in any distributions. No written agreement,
		328	** license, or royalty fee is required for any of the authorized uses.
		329	** Modifications to this software may be copyrighted by their authors
		330	** and need not follow the licensing terms described here, provided that
		331	** the new terms are clearly indicated on the first page of each file where
		332	** they apply.
		333	**
		334	** In no event shall the author or the distributors be liable to any party
		335	** for direct, indirect, special, incidental, or consequential damages
		336	** arising out of the use of this software, its documentation, or any
		337	** derivatives thereof, even if the author has been advised of the
		338	** possibility of such damage. The author and distributors specifically
		339	** disclaim any warranties, including but not limited to the implied
		340	** warranties of merchantability, fitness for a particular purpose, and
		341	** non-infringment. This software is provided at no fee on an
		342	** "as is" basis. The author and/or distritutors have no obligation
		343	** to provide maintenance, support, updates, enhancements and/or
		344	** modifications.
		345	**
		346	** GOVERNMENT USE: If you are acquiring this software on behalf of the
		347	** U.S. government, the Government shall have only "Restricted Rights"
		348	** in the software and related documentation as defined in the Federal
		349	** Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
		350	** are acquiring the software on behalf of the Department of Defense, the
		351	** software shall be classified as "Commercial Computer Software" and the
		352	** Government shall have only "Restricted Rights" as defined in Clause
		353	** 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
		354	** author grants the U.S. Government and others acting in its behalf
		355	** permission to use and distribute the software in accordance with the
		356	** terms specified in this license.
		357	*/
		358	#include <ctype.h>
		359	#include <fcntl.h>
		360	#include <stdarg.h>
		361	#include <stdio.h>
		362	#include <stdlib.h>
		363	#include <string.h>
		364	#include <sys/stat.h>
		365	#include <sys/types.h>
		366
		367	/* Include either the Tcl or the Tk header file. Use the "Internal"
		368	** version of the header file if and only if we are generating an
		369	** extension that is linking against the Stub library.
		370	** Many installations do not have the internal header files
		371	** available, so using the internal headers only when absolutely
		372	** necessary will help to reduce compilation problems.
		373	*/
		374	#if ET_EXTENSION && defined(TCL_USE_STUBS)
		375	#if ET_ENABLE_TK
		376	#include <tkInt.h>
		377	#else
		378	#include <tclInt.h>
		379	#endif
		380	#else
		381	#if ET_ENABLE_TK
		382	#include <tk.h>
		383	#else
		384	#include <tcl.h>
		385	#endif
		386	#endif
		387
		388	/*
		389	** ET_WIN32 is true if we are running Tk under windows. The
		390	** <tcl.h> module will define __WIN32__ for us if we are compiling
		391	** for windows.
		392	*/
		393	#if defined(__WIN32__) && ET_ENABLE_TK
		394	#define ET_WIN32 1
		395	#include <windows.h>
		396	#else
		397	#define ET_WIN32 0
		398	#endif
		399
		400	/*
		401	** Always disable ET_AUTO_FORK under windows. Windows doesn't
		402	** fork well.
		403	*/
		404	#if defined(__WIN32__)
		405	#undef ET_AUTO_FORK
		406	#define ET_AUTO_FORK 0
		407	#endif
		408
		409	/*
		410	** Omit <unistd.h> under windows. But we need it for Unix.
		411	*/
		412	#if !defined(__WIN32__)
		413	#include <unistd.h>
		414	#endif
		415
		416	/*
		417	** The Tcl*InsertProc functions allow the system calls "stat",
		418	** "access" and "open" to be overloaded. This in turns allows us
		419	** to substituted compiled-in strings for files in the filesystem.
		420	** But the Tcl*InsertProc functions are only available in Tcl8.0.3
		421	** and later.
		422	**
		423	** Define the ET_HAVE_INSERTPROC macro if and only if we are dealing
		424	** with Tcl8.0.3 or later.
		425	*/
		426	#if TCL_MAJOR_VERSION == 8 && (TCL_MINOR_VERSION > 0 \|\| TCL_RELEASE_SERIAL >= 3)
		427	#define ET_HAVE_INSERTPROC
		428	#endif
		429
		430	/*
		431	** If we are using the Tcl*InsertProc() functions, we should provide
		432	** prototypes for them. But the prototypes are in the tclInt.h include
		433	** file, which we don't want to require the user to have on hand. So
		434	** we provide our own prototypes here.
		435	**
		436	** Note that if TCL_USE_STUBS is defined, then the tclInt.h is required
		437	** anyway, so these prototypes are not included if TCL_USE_STUBS is
		438	** defined.
		439	*/
		440	#if defined(ET_HAVE_INSERTPROC) && !defined(TCL_USE_STUBS)
		441	#ifdef __cplusplus
		442	extern "C" int TclStatInsertProc (int () (char , struct stat *));
		443	extern "C" int TclAccessInsertProc (int () (char , int));
		444	extern "C" int
		445	TclOpenFileChannelInsertProc (Tcl_Channel () (Tcl_Interp , char , char , int));
		446	#else
		447	extern int TclStatInsertProc (int () (char , struct stat *));
		448	extern int TclAccessInsertProc (int () (char , int));
		449	extern int TclOpenFileChannelInsertProc (Tcl_Channel () (Tcl_Interp , char , char , int));
		450	#endif
		451	#endif
		452
		453	/*
		454	** Don't allow Win32 applications to read from stdin. Nor
		455	** programs that automatically go into the background. Force
		456	** the use of a console in these cases.
		457	*/
		458	#if (ET_WIN32 \|\| ET_AUTO_FORK) && ET_READ_STDIN
		459	#undef ET_READ_STDIN
		460	#undef ET_CONSOLE
		461	#define ET_READ_STDIN 0
		462	#define ET_CONSOLE 1
		463	#endif
		464
		465	/*
		466	** The console won't work without Tk.
		467	*/
		468	#if ET_ENABLE_TK == 0 && ET_CONSOLE
		469	#undef ET_CONSOLE
		470	#define ET_CONSOLE 0
		471	#undef ET_READ_STDIN
		472	#define ET_READ_STDIN 1
		473	#endif
		474
		475	/*
		476	** Set ET_HAVE_OBJ to true if we are able to link against the
		477	** new Tcl_Obj interface. This is only the case for Tcl version
		478	** 8.0 and later.
		479	*/
		480	#if ET_ENABLE_OBJ \|\| TCL_MAJOR_VERSION >= 8
		481	#define ET_HAVE_OBJ 1
		482	#else
		483	#define ET_HAVE_OBJ 0
		484	#endif
		485
		486	/*
		487	** The Tcl_GetByteArrayFromObj() only appears in Tcl version 8.1
		488	** and later. Substitute Tcl_GetStringFromObj() in Tcl version 8.0.X
		489	*/
		490	#if ET_HAVE_OBJ && TCL_MINOR_VERSION == 0
		491	#define Tcl_GetByteArrayFromObj Tcl_GetStringFromObj
		492	#endif
		493
		494	/*
		495	** Tcl code to implement the console.
		496	**
		497	** This code is written and tested separately, then run through
		498	** "mktclapp -stringify" and then pasted in here.
		499	*/
		500	#if ET_ENABLE_TK && !ET_EXTENSION
		501	static char zEtConsole[] =
		502	"proc console:create {w prompt title} {\n"
		503	"upvar #0 $w.t v\n"
		504	"if {[winfo exists $w]} {destroy $w}\n"
		505	"catch {unset v}\n"
		506	"toplevel $w\n"
		507	"wm title $w $title\n"
		508	"wm iconname $w $title\n"
		509	"frame $w.mb -bd 2 -relief raised\n"
		510	"pack $w.mb -side top -fill x\n"
		511	"menubutton $w.mb.file -text File -menu $w.mb.file.m\n"
		512	"menubutton $w.mb.edit -text Edit -menu $w.mb.edit.m\n"
		513	"pack $w.mb.file $w.mb.edit -side left -padx 8 -pady 1\n"
		514	"set m [menu $w.mb.file.m]\n"
		515	"$m add command -label {Source...} -command \"console:SourceFile $w.t\"\n"
		516	"$m add command -label {Save As...} -command \"console:SaveFile $w.t\"\n"
		517	"$m add separator\n"
		518	"$m add command -label {Close} -command \"destroy $w\"\n"
		519	"$m add command -label {Exit} -command exit\n"
		520	"set m [menu $w.mb.edit.m]\n"
		521	"$m add command -label Cut -command \"console:Cut $w.t\"\n"
		522	"$m add command -label Copy -command \"console:Copy $w.t\"\n"
		523	"$m add command -label Paste -command \"console:Paste $w.t\"\n"
		524	"$m add command -label {Clear Screen} -command \"console:Clear $w.t\"\n"
		525	"catch {$m config -postcommand \"console:EnableEditMenu $w\"}\n"
		526	"scrollbar $w.sb -orient vertical -command \"$w.t yview\"\n"
		527	"pack $w.sb -side right -fill y\n"
		528	"text $w.t -font fixed -yscrollcommand \"$w.sb set\"\n"
		529	"pack $w.t -side right -fill both -expand 1\n"
		530	"bindtags $w.t Console\n"
		531	"set v(text) $w.t\n"
		532	"set v(history) 0\n"
		533	"set v(historycnt) 0\n"
		534	"set v(current) -1\n"
		535	"set v(prompt) $prompt\n"
		536	"set v(prior) {}\n"
		537	"set v(plength) [string length $v(prompt)]\n"
		538	"set v(x) 0\n"
		539	"set v(y) 0\n"
		540	"$w.t mark set insert end\n"
		541	"$w.t tag config ok -foreground blue\n"
		542	"$w.t tag config err -foreground red\n"
		543	"$w.t insert end $v(prompt)\n"
		544	"$w.t mark set out 1.0\n"
		545	"catch {rename puts console:oldputs$w}\n"
		546	"proc puts args [format {\n"
		547	"if {![winfo exists %s]} {\n"
		548	"rename puts {}\n"
		549	"rename console:oldputs%s puts\n"
		550	"return [uplevel #0 puts $args]\n"
		551	"}\n"
		552	"switch -glob -- \"[llength $args] $args\" {\n"
		553	"{1 *} {\n"
		554	"set msg [lindex $args 0]\\n\n"
		555	"set tag ok\n"
		556	"}\n"
		557	"{2 stdout *} {\n"
		558	"set msg [lindex $args 1]\\n\n"
		559	"set tag ok\n"
		560	"}\n"
		561	"{2 stderr *} {\n"
		562	"set msg [lindex $args 1]\\n\n"
		563	"set tag err\n"
		564	"}\n"
		565	"{2 -nonewline *} {\n"
		566	"set msg [lindex $args 1]\n"
		567	"set tag ok\n"
		568	"}\n"
		569	"{3 -nonewline stdout *} {\n"
		570	"set msg [lindex $args 2]\n"
		571	"set tag ok\n"
		572	"}\n"
		573	"{3 -nonewline stderr *} {\n"
		574	"set msg [lindex $args 2]\n"
		575	"set tag err\n"
		576	"}\n"
		577	"default {\n"
		578	"uplevel #0 console:oldputs%s $args\n"
		579	"return\n"
		580	"}\n"
		581	"}\n"
		582	"console:Puts %s $msg $tag\n"
		583	"} $w $w $w $w.t]\n"
		584	"after idle \"focus $w.t\"\n"
		585	"}\n"
		586	"bind Console <1> {console:Button1 %W %x %y}\n"
		587	"bind Console <B1-Motion> {console:B1Motion %W %x %y}\n"
		588	"bind Console <B1-Leave> {console:B1Leave %W %x %y}\n"
		589	"bind Console <B1-Enter> {console:cancelMotor %W}\n"
		590	"bind Console <ButtonRelease-1> {console:cancelMotor %W}\n"
		591	"bind Console <KeyPress> {console:Insert %W %A}\n"
		592	"bind Console <Left> {console:Left %W}\n"
		593	"bind Console <Control-b> {console:Left %W}\n"
		594	"bind Console <Right> {console:Right %W}\n"
		595	"bind Console <Control-f> {console:Right %W}\n"
		596	"bind Console <BackSpace> {console:Backspace %W}\n"
		597	"bind Console <Control-h> {console:Backspace %W}\n"
		598	"bind Console <Delete> {console:Delete %W}\n"
		599	"bind Console <Control-d> {console:Delete %W}\n"
		600	"bind Console <Home> {console:Home %W}\n"
		601	"bind Console <Control-a> {console:Home %W}\n"
		602	"bind Console <End> {console:End %W}\n"
		603	"bind Console <Control-e> {console:End %W}\n"
		604	"bind Console <Return> {console:Enter %W}\n"
		605	"bind Console <KP_Enter> {console:Enter %W}\n"
		606	"bind Console <Up> {console:Prior %W}\n"
		607	"bind Console <Control-p> {console:Prior %W}\n"
		608	"bind Console <Down> {console:Next %W}\n"
		609	"bind Console <Control-n> {console:Next %W}\n"
		610	"bind Console <Control-k> {console:EraseEOL %W}\n"
		611	"bind Console <<Cut>> {console:Cut %W}\n"
		612	"bind Console <<Copy>> {console:Copy %W}\n"
		613	"bind Console <<Paste>> {console:Paste %W}\n"
		614	"bind Console <<Clear>> {console:Clear %W}\n"
		615	"proc console:Puts {w t tag} {\n"
		616	"set nc [string length $t]\n"
		617	"set endc [string index $t [expr $nc-1]]\n"
		618	"if {$endc==\"\\n\"} {\n"
		619	"if {[$w index out]<[$w index {insert linestart}]} {\n"
		620	"$w insert out [string range $t 0 [expr $nc-2]] $tag\n"
		621	"$w mark set out {out linestart +1 lines}\n"
		622	"} else {\n"
		623	"$w insert out $t $tag\n"
		624	"}\n"
		625	"} else {\n"
		626	"if {[$w index out]<[$w index {insert linestart}]} {\n"
		627	"$w insert out $t $tag\n"
		628	"} else {\n"
		629	"$w insert out $t\\n $tag\n"
		630	"$w mark set out {out -1 char}\n"
		631	"}\n"
		632	"}\n"
		633	"$w yview insert\n"
		634	"}\n"
		635	"proc console:Insert {w a} {\n"
		636	"$w insert insert $a\n"
		637	"$w yview insert\n"
		638	"}\n"
		639	"proc console:Left {w} {\n"
		640	"upvar #0 $w v\n"
		641	"scan [$w index insert] %d.%d row col\n"
		642	"if {$col>$v(plength)} {\n"
		643	"$w mark set insert \"insert -1c\"\n"
		644	"}\n"
		645	"}\n"
		646	"proc console:Backspace {w} {\n"
		647	"upvar #0 $w v\n"
		648	"scan [$w index insert] %d.%d row col\n"
		649	"if {$col>$v(plength)} {\n"
		650	"$w delete {insert -1c}\n"
		651	"}\n"
		652	"}\n"
		653	"proc console:EraseEOL {w} {\n"
		654	"upvar #0 $w v\n"
		655	"scan [$w index insert] %d.%d row col\n"
		656	"if {$col>=$v(plength)} {\n"
		657	"$w delete insert {insert lineend}\n"
		658	"}\n"
		659	"}\n"
		660	"proc console:Right {w} {\n"
		661	"$w mark set insert \"insert +1c\"\n"
		662	"}\n"
		663	"proc console:Delete w {\n"
		664	"$w delete insert\n"
		665	"}\n"
		666	"proc console:Home w {\n"
		667	"upvar #0 $w v\n"
		668	"scan [$w index insert] %d.%d row col\n"
		669	"$w mark set insert $row.$v(plength)\n"
		670	"}\n"
		671	"proc console:End w {\n"
		672	"$w mark set insert {insert lineend}\n"
		673	"}\n"
		674	"proc console:Enter w {\n"
		675	"upvar #0 $w v\n"
		676	"scan [$w index insert] %d.%d row col\n"
		677	"set start $row.$v(plength)\n"
		678	"set line [$w get $start \"$start lineend\"]\n"
		679	"if {$v(historycnt)>0} {\n"
		680	"set last [lindex $v(history) [expr $v(historycnt)-1]]\n"
		681	"if {[string compare $last $line]} {\n"
		682	"lappend v(history) $line\n"
		683	"incr v(historycnt)\n"
		684	"}\n"
		685	"} else {\n"
		686	"set v(history) [list $line]\n"
		687	"set v(historycnt) 1\n"
		688	"}\n"
		689	"set v(current) $v(historycnt)\n"
		690	"$w insert end \\n\n"
		691	"$w mark set out end\n"
		692	"if {$v(prior)==\"\"} {\n"
		693	"set cmd $line\n"
		694	"} else {\n"
		695	"set cmd $v(prior)\\n$line\n"
		696	"}\n"
		697	"if {[info complete $cmd]} {\n"
		698	"set rc [catch {uplevel #0 $cmd} res]\n"
		699	"if {![winfo exists $w]} return\n"
		700	"if {$rc} {\n"
		701	"$w insert end $res\\n err\n"
		702	"} elseif {[string length $res]>0} {\n"
		703	"$w insert end $res\\n ok\n"
		704	"}\n"
		705	"set v(prior) {}\n"
		706	"$w insert end $v(prompt)\n"
		707	"} else {\n"
		708	"set v(prior) $cmd\n"
		709	"regsub -all {[^ ]} $v(prompt) . x\n"
		710	"$w insert end $x\n"
		711	"}\n"
		712	"$w mark set insert end\n"
		713	"$w mark set out {insert linestart}\n"
		714	"$w yview insert\n"
		715	"}\n"
		716	"proc console:Prior w {\n"
		717	"upvar #0 $w v\n"
		718	"if {$v(current)<=0} return\n"
		719	"incr v(current) -1\n"
		720	"set line [lindex $v(history) $v(current)]\n"
		721	"console:SetLine $w $line\n"
		722	"}\n"
		723	"proc console:Next w {\n"
		724	"upvar #0 $w v\n"
		725	"if {$v(current)>=$v(historycnt)} return\n"
		726	"incr v(current) 1\n"
		727	"set line [lindex $v(history) $v(current)]\n"
		728	"console:SetLine $w $line\n"
		729	"}\n"
		730	"proc console:SetLine {w line} {\n"
		731	"upvar #0 $w v\n"
		732	"scan [$w index insert] %d.%d row col\n"
		733	"set start $row.$v(plength)\n"
		734	"$w delete $start end\n"
		735	"$w insert end $line\n"
		736	"$w mark set insert end\n"
		737	"$w yview insert\n"
		738	"}\n"
		739	"proc console:Button1 {w x y} {\n"
		740	"global tkPriv\n"
		741	"upvar #0 $w v\n"
		742	"set v(mouseMoved) 0\n"
		743	"set v(pressX) $x\n"
		744	"set p [console:nearestBoundry $w $x $y]\n"
		745	"scan [$w index insert] %d.%d ix iy\n"
		746	"scan $p %d.%d px py\n"
		747	"if {$px==$ix} {\n"
		748	"$w mark set insert $p\n"
		749	"}\n"
		750	"$w mark set anchor $p\n"
		751	"focus $w\n"
		752	"}\n"
		753	"proc console:nearestBoundry {w x y} {\n"
		754	"set p [$w index @$x,$y]\n"
		755	"set bb [$w bbox $p]\n"
		756	"if {![string compare $bb \"\"]} {return $p}\n"
		757	"if {($x-[lindex $bb 0])<([lindex $bb 2]/2)} {return $p}\n"
		758	"$w index \"$p + 1 char\"\n"
		759	"}\n"
		760	"proc console:SelectTo {w x y} {\n"
		761	"upvar #0 $w v\n"
		762	"set cur [console:nearestBoundry $w $x $y]\n"
		763	"if {[catch {$w index anchor}]} {\n"
		764	"$w mark set anchor $cur\n"
		765	"}\n"
		766	"set anchor [$w index anchor]\n"
		767	"if {[$w compare $cur != $anchor] \|\| (abs($v(pressX) - $x) >= 3)} {\n"
		768	"if {$v(mouseMoved)==0} {\n"
		769	"$w tag remove sel 0.0 end\n"
		770	"}\n"
		771	"set v(mouseMoved) 1\n"
		772	"}\n"
		773	"if {[$w compare $cur < anchor]} {\n"
		774	"set first $cur\n"
		775	"set last anchor\n"
		776	"} else {\n"
		777	"set first anchor\n"
		778	"set last $cur\n"
		779	"}\n"
		780	"if {$v(mouseMoved)} {\n"
		781	"$w tag remove sel 0.0 $first\n"
		782	"$w tag add sel $first $last\n"
		783	"$w tag remove sel $last end\n"
		784	"update idletasks\n"
		785	"}\n"
		786	"}\n"
		787	"proc console:B1Motion {w x y} {\n"
		788	"upvar #0 $w v\n"
		789	"set v(y) $y\n"
		790	"set v(x) $x\n"
		791	"console:SelectTo $w $x $y\n"
		792	"}\n"
		793	"proc console:B1Leave {w x y} {\n"
		794	"upvar #0 $w v\n"
		795	"set v(y) $y\n"
		796	"set v(x) $x\n"
		797	"console:motor $w\n"
		798	"}\n"
		799	"proc console:motor w {\n"
		800	"upvar #0 $w v\n"
		801	"if {![winfo exists $w]} return\n"
		802	"if {$v(y)>=[winfo height $w]} {\n"
		803	"$w yview scroll 1 units\n"
		804	"} elseif {$v(y)<0} {\n"
		805	"$w yview scroll -1 units\n"
		806	"} else {\n"
		807	"return\n"
		808	"}\n"
		809	"console:SelectTo $w $v(x) $v(y)\n"
		810	"set v(timer) [after 50 console:motor $w]\n"
		811	"}\n"
		812	"proc console:cancelMotor w {\n"
		813	"upvar #0 $w v\n"
		814	"catch {after cancel $v(timer)}\n"
		815	"catch {unset v(timer)}\n"
		816	"}\n"
		817	"proc console:Copy w {\n"
		818	"if {![catch {set text [$w get sel.first sel.last]}]} {\n"
		819	"clipboard clear -displayof $w\n"
		820	"clipboard append -displayof $w $text\n"
		821	"}\n"
		822	"}\n"
		823	"proc console:canCut w {\n"
		824	"set r [catch {\n"
		825	"scan [$w index sel.first] %d.%d s1x s1y\n"
		826	"scan [$w index sel.last] %d.%d s2x s2y\n"
		827	"scan [$w index insert] %d.%d ix iy\n"
		828	"}]\n"
		829	"if {$r==1} {return 0}\n"
		830	"if {$s1x==$ix && $s2x==$ix} {return 1}\n"
		831	"return 2\n"
		832	"}\n"
		833	"proc console:Cut w {\n"
		834	"if {[console:canCut $w]==1} {\n"
		835	"console:Copy $w\n"
		836	"$w delete sel.first sel.last\n"
		837	"}\n"
		838	"}\n"
		839	"proc console:Paste w {\n"
		840	"if {[console:canCut $w]==1} {\n"
		841	"$w delete sel.first sel.last\n"
		842	"}\n"
		843	"if {[catch {selection get -displayof $w -selection CLIPBOARD} topaste]} {\n"
		844	"return\n"
		845	"}\n"
		846	"set prior 0\n"
		847	"foreach line [split $topaste \\n] {\n"
		848	"if {$prior} {\n"
		849	"console:Enter $w\n"
		850	"update\n"
		851	"}\n"
		852	"set prior 1\n"
		853	"$w insert insert $line\n"
		854	"}\n"
		855	"}\n"
		856	"proc console:EnableEditMenu w {\n"
		857	"set m $w.mb.edit.m\n"
		858	"switch [console:canCut $w.t] {\n"
		859	"0 {\n"
		860	"$m entryconf Copy -state disabled\n"
		861	"$m entryconf Cut -state disabled\n"
		862	"}\n"
		863	"1 {\n"
		864	"$m entryconf Copy -state normal\n"
		865	"$m entryconf Cut -state normal\n"
		866	"}\n"
		867	"2 {\n"
		868	"$m entryconf Copy -state normal\n"
		869	"$m entryconf Cut -state disabled\n"
		870	"}\n"
		871	"}\n"
		872	"}\n"
		873	"proc console:SourceFile w {\n"
		874	"set types {\n"
		875	"{{TCL Scripts} {.tcl}}\n"
		876	"{{All Files} *}\n"
		877	"}\n"
		878	"set f [tk_getOpenFile -filetypes $types -title \"TCL Script To Source...\"]\n"
		879	"if {$f!=\"\"} {\n"
		880	"uplevel #0 source $f\n"
		881	"}\n"
		882	"}\n"
		883	"proc console:SaveFile w {\n"
		884	"set types {\n"
		885	"{{Text Files} {.txt}}\n"
		886	"{{All Files} *}\n"
		887	"}\n"
		888	"set f [tk_getSaveFile -filetypes $types -title \"Write Screen To...\"]\n"
		889	"if {$f!=\"\"} {\n"
		890	"if {[catch {open $f w} fd]} {\n"
		891	"tk_messageBox -type ok -icon error -message $fd\n"
		892	"} else {\n"
		893	"puts $fd [string trimright [$w get 1.0 end] \\n]\n"
		894	"close $fd\n"
		895	"}\n"
		896	"}\n"
		897	"}\n"
		898	"proc console:Clear w {\n"
		899	"$w delete 1.0 {insert linestart}\n"
		900	"}\n"; /* End of the console code */
		901	#endif /* ET_ENABLE_TK */
		902
		903	/*
		904	** The "printf" code that follows dates from the 1980's. It is in
		905	** the public domain. The original comments are included here for
		906	** completeness. They are slightly out-of-date.
		907	**
		908	** The following modules is an enhanced replacement for the "printf" programs
		909	** found in the standard library. The following enhancements are
		910	** supported:
		911	**
		912	** + Additional functions. The standard set of "printf" functions
		913	** includes printf, fprintf, sprintf, vprintf, vfprintf, and
		914	** vsprintf. This module adds the following:
		915	**
		916	** * snprintf -- Works like sprintf, but has an extra argument
		917	** which is the size of the buffer written to.
		918	**
		919	** * mprintf -- Similar to sprintf. Writes output to memory
		920	** obtained from malloc.
		921	**
		922	** * xprintf -- Calls a function to dispose of output.
		923	**
		924	** * nprintf -- No output, but returns the number of characters
		925	** that would have been output by printf.
		926	**
		927	** * A v- version (ex: vsnprintf) of every function is also
		928	** supplied.
		929	**
		930	** + A few extensions to the formatting notation are supported:
		931	**
		932	** * The "=" flag (similar to "-") causes the output to be
		933	** be centered in the appropriately sized field.
		934	**
		935	** * The %b field outputs an integer in binary notation.
		936	**
		937	** * The %c field now accepts a precision. The character output
		938	** is repeated by the number of times the precision specifies.
		939	**
		940	** * The %' field works like %c, but takes as its character the
		941	** next character of the format string, instead of the next
		942	** argument. For example, printf("%.78'-") prints 78 minus
		943	** signs, the same as printf("%.78c",'-').
		944	**
		945	** + When compiled using GCC on a SPARC, this version of printf is
		946	** faster than the library printf for SUN OS 4.1.
		947	**
		948	** + All functions are fully reentrant.
		949	**
		950	*/
		951	/*
		952	** Undefine COMPATIBILITY to make some slight changes in the way things
		953	** work. I think the changes are an improvement, but they are not
		954	** backwards compatible.
		955	*/
		956	/* #define COMPATIBILITY / * Compatible with SUN OS 4.1 */
		957
		958	/*
		959	** Characters that need to be escaped inside a TCL string.
		960	*/
		961	static char NeedEsc[] = {
		962	1, 1, 1, 1, 1, 1, 1, 1, 'b', 't', 'n', 1, 'f', 'r', 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
		963	1, 1, 1, 1, 1, 1, 1, 1, 0, 0, '"', 0, '$', 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
		964	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
		965	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, '[', '\\', ']', 0, 0,
		966	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
		967	0, 0, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
		968	1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
		969	1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
		970	1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
		971	1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
		972	1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
		973	};
		974
		975	/*
		976	** Conversion types fall into various categories as defined by the
		977	** following enumeration.
		978	*/
		979	enum et_type
		980	{ /* The type of the format field */
		981	etRADIX, /* Integer types. %d, %x, %o, and so forth */
		982	etFLOAT, /* Floating point. %f */
		983	etEXP, /* Exponentional notation. %e and %E */
		984	etGENERIC, /* Floating or exponential, depending on exponent. %g */
		985	etSIZE, /* Return number of characters processed so far. %n */
		986	etSTRING, /* Strings. %s */
		987	etPERCENT, /* Percent symbol. %% */
		988	etCHARX, /* Characters. %c */
		989	etERROR, /* Used to indicate no such conversion type */
		990	/* The rest are extensions, not normally found in printf() */
		991	etCHARLIT, /* Literal characters. %' */
		992	etTCLESCAPE, /* Strings with special characters escaped. %q */
		993	etMEMSTRING, /* A string which should be deleted after use. %z */
		994	etORDINAL /* 1st, 2nd, 3rd and so forth */
		995	};
		996
		997	/*
		998	** Each builtin conversion character (ex: the 'd' in "%d") is described
		999	** by an instance of the following structure
		1000	*/
		1001	typedef struct et_info
		1002	{ /* Information about each format field */
		1003	int fmttype; /* The format field code letter */
		1004	int base; /* The base for radix conversion */
		1005	char charset; / The character set for conversion */
		1006	int flag_signed; /* Is the quantity signed? */
		1007	char prefix; / Prefix on non-zero values in alt format */
		1008	enum et_type type; /* Conversion paradigm */
		1009	} et_info;
		1010
		1011	/*
		1012	** The following table is searched linearly, so it is good to put the
		1013	** most frequently used conversion types first.
		1014	*/
		1015	static et_info fmtinfo[] = {
		1016	{
		1017	'd',
		1018	10,
		1019	"0123456789",
		1020	1,
		1021	0,
		1022	etRADIX,
		1023	},
		1024	{
		1025	's',
		1026	0,
		1027	0,
		1028	0,
		1029	0,
		1030	etSTRING,
		1031	},
		1032	{
		1033	'q',
		1034	0,
		1035	0,
		1036	0,
		1037	0,
		1038	etTCLESCAPE,
		1039	},
		1040	{
		1041	'z',
		1042	0,
		1043	0,
		1044	0,
		1045	0,
		1046	etMEMSTRING,
		1047	},
		1048	{
		1049	'c',
		1050	0,
		1051	0,
		1052	0,
		1053	0,
		1054	etCHARX,
		1055	},
		1056	{
		1057	'o',
		1058	8,
		1059	"01234567",
		1060	0,
		1061	"0",
		1062	etRADIX,
		1063	},
		1064	{
		1065	'u',
		1066	10,
		1067	"0123456789",
		1068	0,
		1069	0,
		1070	etRADIX,
		1071	},
		1072	{
		1073	'x',
		1074	16,
		1075	"0123456789abcdef",
		1076	0,
		1077	"x0",
		1078	etRADIX,
		1079	},
		1080	{
		1081	'X',
		1082	16,
		1083	"0123456789ABCDEF",
		1084	0,
		1085	"X0",
		1086	etRADIX,
		1087	},
		1088	{
		1089	'r',
		1090	10,
		1091	"0123456789",
		1092	0,
		1093	0,
		1094	etORDINAL,
		1095	},
		1096	{
		1097	'f',
		1098	0,
		1099	0,
		1100	1,
		1101	0,
		1102	etFLOAT,
		1103	},
		1104	{
		1105	'e',
		1106	0,
		1107	"e",
		1108	1,
		1109	0,
		1110	etEXP,
		1111	},
		1112	{
		1113	'E',
		1114	0,
		1115	"E",
		1116	1,
		1117	0,
		1118	etEXP,
		1119	},
		1120	{
		1121	'g',
		1122	0,
		1123	"e",
		1124	1,
		1125	0,
		1126	etGENERIC,
		1127	},
		1128	{
		1129	'G',
		1130	0,
		1131	"E",
		1132	1,
		1133	0,
		1134	etGENERIC,
		1135	},
		1136	{
		1137	'i',
		1138	10,
		1139	"0123456789",
		1140	1,
		1141	0,
		1142	etRADIX,
		1143	},
		1144	{
		1145	'n',
		1146	0,
		1147	0,
		1148	0,
		1149	0,
		1150	etSIZE,
		1151	},
		1152	{
		1153	'%',
		1154	0,
		1155	0,
		1156	0,
		1157	0,
		1158	etPERCENT,
		1159	},
		1160	{
		1161	'b',
		1162	2,
		1163	"01",
		1164	0,
		1165	"b0",
		1166	etRADIX,
		1167	}, /* Binary */
		1168	{
		1169	'p',
		1170	10,
		1171	"0123456789",
		1172	0,
		1173	0,
		1174	etRADIX,
		1175	}, /* Pointers */
		1176	{
		1177	'\'',
		1178	0,
		1179	0,
		1180	0,
		1181	0,
		1182	etCHARLIT,
		1183	}, /* Literal char */
		1184	};
		1185	#define etNINFO (sizeof (fmtinfo) / sizeof (fmtinfo[0]))
		1186
		1187	/*
		1188	** If NOFLOATINGPOINT is defined, then none of the floating point
		1189	** conversions will work.
		1190	*/
		1191	#ifndef etNOFLOATINGPOINT
		1192	/*
		1193	** "val" is a double such that 0.1 <= val < 10.0
		1194	** Return the ascii code for the leading digit of *val, then
		1195	** multiply "*val" by 10.0 to renormalize.
		1196	**
		1197	** Example:
		1198	** input: *val = 3.14159
		1199	** output: *val = 1.4159 function return = '3'
		1200	**
		1201	** The counter *cnt is incremented each time. After counter exceeds
		1202	** 16 (the number of significant digits in a 64-bit float) '0' is
		1203	** always returned.
		1204	*/
		1205	static int et_getdigit (double val, int cnt)
		1206	{
		1207	int digit;
		1208	double d;
		1209	if ((*cnt)++ >= 16)
		1210	return '0';
		1211	digit = (int) *val;
		1212	d = digit;
		1213	digit += '0';
		1214	val = (val - d) * 10.0;
		1215	return digit;
		1216	}
		1217	#endif
		1218
		1219	#define etBUFSIZE 1000 /* Size of the output buffer */
		1220
		1221	/*
		1222	** The root program. All variations call this core.
		1223	**
		1224	** INPUTS:
		1225	** func This is a pointer to a function taking three arguments
		1226	** 1. A pointer to anything. Same as the "arg" parameter.
		1227	** 2. A pointer to the list of characters to be output
		1228	** (Note, this list is NOT null terminated.)
		1229	** 3. An integer number of characters to be output.
		1230	** (Note: This number might be zero.)
		1231	**
		1232	** arg This is the pointer to anything which will be passed as the
		1233	** first argument to "func". Use it for whatever you like.
		1234	**
		1235	** fmt This is the format string, as in the usual print.
		1236	**
		1237	** ap This is a pointer to a list of arguments. Same as in
		1238	** vfprint.
		1239	**
		1240	** OUTPUTS:
		1241	** The return value is the total number of characters sent to
		1242	** the function "func". Returns -1 on a error.
		1243	**
		1244	** Note that the order in which automatic variables are declared below
		1245	** seems to make a big difference in determining how fast this beast
		1246	** will run.
		1247	*/
		1248	int vxprintf (void (func) (void , char , int), void arg, const char *format, va_list ap)
		1249	{
		1250	register const char fmt; / The format string. */
		1251	register int c; /* Next character in the format string */
		1252	register char bufpt; / Pointer to the conversion buffer */
		1253	register int precision; /* Precision of the current field */
		1254	register int length; /* Length of the field */
		1255	register int idx; /* A general purpose loop counter */
		1256	int count; /* Total number of characters output */
		1257	int width; /* Width of the current field */
		1258	int flag_leftjustify; /* True if "-" flag is present */
		1259	int flag_plussign; /* True if "+" flag is present */
		1260	int flag_blanksign; /* True if " " flag is present */
		1261	int flag_alternateform; /* True if "#" flag is present */
		1262	int flag_zeropad; /* True if field width constant starts with zero */
		1263	int flag_long; /* True if "l" flag is present */
		1264	int flag_center; /* True if "=" flag is present */
		1265	unsigned long longvalue; /* Value for integer types */
		1266	double realvalue; /* Value for real types */
		1267	et_info infop; / Pointer to the appropriate info structure */
		1268	char buf[etBUFSIZE]; /* Conversion buffer */
		1269	char prefix; /* Prefix character. "+" or "-" or " " or '\0'. */
		1270	int errorflag = 0; /* True if an error is encountered */
		1271	enum et_type xtype; /* Conversion paradigm */
		1272	char zMem; / String to be freed */
		1273	char zExtra; / Extra memory used for etTCLESCAPE conversions */
		1274	static char spaces[] = " "
		1275	" "
		1276	" ";
		1277	#define etSPACESIZE (sizeof (spaces) - 1)
		1278	#ifndef etNOFLOATINGPOINT
		1279	int exp; /* exponent of real numbers */
		1280	double rounder; /* Used for rounding floating point values */
		1281	int flag_dp; /* True if decimal point should be shown */
		1282	int flag_rtz; /* True if trailing zeros should be removed */
		1283	int flag_exp; /* True to force display of the exponent */
		1284	int nsd; /* Number of significant digits returned */
		1285	#endif
		1286
		1287	fmt = format; /* Put in a register for speed */
		1288	count = length = 0;
		1289	bufpt = 0;
		1290	for (; (c = (*fmt)) != 0; ++fmt)
		1291	{
		1292	if (c != '%')
		1293	{
		1294	register int amt;
		1295	bufpt = (char *) fmt;
		1296	amt = 1;
		1297	while ((c = (*++fmt)) != '%' && c != 0)
		1298	amt++;
		1299	(*func) (arg, bufpt, amt);
		1300	count += amt;
		1301	if (c == 0)
		1302	break;
		1303	}
		1304	if ((c = (*++fmt)) == 0)
		1305	{
		1306	errorflag = 1;
		1307	(*func) (arg, "%", 1);
		1308	count++;
		1309	break;
		1310	}
		1311	/* Find out what flags are present */
		1312	flag_leftjustify = flag_plussign = flag_blanksign = flag_alternateform =
		1313	flag_zeropad = flag_center = 0;
		1314	do
		1315	{
		1316	switch (c)
		1317	{
		1318	case '-':
		1319	flag_leftjustify = 1;
		1320	c = 0;
		1321	break;
		1322	case '+':
		1323	flag_plussign = 1;
		1324	c = 0;
		1325	break;
		1326	case ' ':
		1327	flag_blanksign = 1;
		1328	c = 0;
		1329	break;
		1330	case '#':
		1331	flag_alternateform = 1;
		1332	c = 0;
		1333	break;
		1334	case '0':
		1335	flag_zeropad = 1;
		1336	c = 0;
		1337	break;
		1338	case '=':
		1339	flag_center = 1;
		1340	c = 0;
		1341	break;
		1342	default:
		1343	break;
		1344	}
		1345	} while (c == 0 && (c = (*++fmt)) != 0);
		1346	if (flag_center)
		1347	flag_leftjustify = 0;
		1348	/* Get the field width */
		1349	width = 0;
		1350	if (c == '*')
		1351	{
		1352	width = va_arg (ap, int);
		1353	if (width < 0)
		1354	{
		1355	flag_leftjustify = 1;
		1356	width = -width;
		1357	}
		1358	c = *++fmt;
		1359	}
		1360	else
		1361	{
		1362	while (isdigit (c))
		1363	{
		1364	width = width * 10 + c - '0';
		1365	c = *++fmt;
		1366	}
		1367	}
		1368	if (width > etBUFSIZE - 10)
		1369	{
		1370	width = etBUFSIZE - 10;
		1371	}
		1372	/* Get the precision */
		1373	if (c == '.')
		1374	{
		1375	precision = 0;
		1376	c = *++fmt;
		1377	if (c == '*')
		1378	{
		1379	precision = va_arg (ap, int);
		1380	#ifndef etCOMPATIBILITY
		1381	/* This is sensible, but SUN OS 4.1 doesn't do it. */
		1382	if (precision < 0)
		1383	precision = -precision;
		1384	#endif
		1385	c = *++fmt;
		1386	}
		1387	else
		1388	{
		1389	while (isdigit (c))
		1390	{
		1391	precision = precision * 10 + c - '0';
		1392	c = *++fmt;
		1393	}
		1394	}
		1395	/* Limit the precision to prevent overflowing buf[] during conversion
		1396	*/
		1397	if (precision > etBUFSIZE - 40)
		1398	precision = etBUFSIZE - 40;
		1399	}
		1400	else
		1401	{
		1402	precision = -1;
		1403	}
		1404	/* Get the conversion type modifier */
		1405	if (c == 'l')
		1406	{
		1407	flag_long = 1;
		1408	c = *++fmt;
		1409	}
		1410	else
		1411	{
		1412	flag_long = 0;
		1413	}
		1414	/* Fetch the info entry for the field */
		1415	infop = 0;
		1416	for (idx = 0; idx < etNINFO; idx++)
		1417	{
		1418	if (c == fmtinfo[idx].fmttype)
		1419	{
		1420	infop = &fmtinfo[idx];
		1421	break;
		1422	}
		1423	}
		1424	/* No info entry found. It must be an error. */
		1425	if (infop == 0)
		1426	{
		1427	xtype = etERROR;
		1428	}
		1429	else
		1430	{
		1431	xtype = infop->type;
		1432	}
		1433	zExtra = 0;
		1434
		1435	/*
		1436	** At this point, variables are initialized as follows:
		1437	**
		1438	** flag_alternateform TRUE if a '#' is present.
		1439	** flag_plussign TRUE if a '+' is present.
		1440	** flag_leftjustify TRUE if a '-' is present or if the
		1441	** field width was negative.
		1442	** flag_zeropad TRUE if the width began with 0.
		1443	** flag_long TRUE if the letter 'l' (ell) prefixed
		1444	** the conversion character.
		1445	** flag_blanksign TRUE if a ' ' is present.
		1446	** width The specified field width. This is
		1447	** always non-negative. Zero is the default.
		1448	** precision The specified precision. The default
		1449	** is -1.
		1450	** xtype The class of the conversion.
		1451	** infop Pointer to the appropriate info struct.
		1452	*/
		1453	switch (xtype)
		1454	{
		1455	case etORDINAL:
		1456	case etRADIX:
		1457	if (flag_long)
		1458	longvalue = va_arg (ap, long);
		1459	else
		1460	longvalue = va_arg (ap, int);
		1461	#ifdef etCOMPATIBILITY
		1462	/* For the format %#x, the value zero is printed "0" not "0x0".
		1463	** I think this is stupid. */
		1464	if (longvalue == 0)
		1465	flag_alternateform = 0;
		1466	#else
		1467	/* More sensible: turn off the prefix for octal (to prevent "00"),
		1468	** but leave the prefix for hex. */
		1469	if (longvalue == 0 && infop->base == 8)
		1470	flag_alternateform = 0;
		1471	#endif
		1472	if (infop->flag_signed)
		1473	{
		1474	if ((long ) &longvalue < 0)
		1475	{
		1476	longvalue = -(long ) &longvalue;
		1477	prefix = '-';
		1478	}
		1479	else if (flag_plussign)
		1480	prefix = '+';
		1481	else if (flag_blanksign)
		1482	prefix = ' ';
		1483	else
		1484	prefix = 0;
		1485	}
		1486	else
		1487	prefix = 0;
		1488	if (flag_zeropad && precision < width - (prefix != 0))
		1489	{
		1490	precision = width - (prefix != 0);
		1491	}
		1492	bufpt = &buf[etBUFSIZE];
		1493	if (xtype == etORDINAL)
		1494	{
		1495	long a, b;
		1496	a = longvalue % 10;
		1497	b = longvalue % 100;
		1498	bufpt -= 2;
		1499	if (a == 0 \|\| a > 3 \|\| (b > 10 && b < 14))
		1500	{
		1501	bufpt[0] = 't';
		1502	bufpt[1] = 'h';
		1503	}
		1504	else if (a == 1)
		1505	{
		1506	bufpt[0] = 's';
		1507	bufpt[1] = 't';
		1508	}
		1509	else if (a == 2)
		1510	{
		1511	bufpt[0] = 'n';
		1512	bufpt[1] = 'd';
		1513	}
		1514	else if (a == 3)
		1515	{
		1516	bufpt[0] = 'r';
		1517	bufpt[1] = 'd';
		1518	}
		1519	}
		1520	{
		1521	register char cset; / Use registers for speed */
		1522	register int base;
		1523	cset = infop->charset;
		1524	base = infop->base;
		1525	do
		1526	{ /* Convert to ascii */
		1527	*(--bufpt) = cset[longvalue % base];
		1528	longvalue = longvalue / base;
		1529	} while (longvalue > 0);
		1530	}
		1531	length = (long) &buf[etBUFSIZE] - (long) bufpt;
		1532	for (idx = precision - length; idx > 0; idx--)
		1533	{
		1534	(--bufpt) = '0'; / Zero pad */
		1535	}
		1536	if (prefix)
		1537	(--bufpt) = prefix; / Add sign */
		1538	if (flag_alternateform && infop->prefix)
		1539	{ /* Add "0" or "0x" */
		1540	char *pre, x;
		1541	pre = infop->prefix;
		1542	if (*bufpt != pre[0])
		1543	{
		1544	for (pre = infop->prefix; (x = (*pre)) != 0; pre++)
		1545	*(--bufpt) = x;
		1546	}
		1547	}
		1548	length = (long) &buf[etBUFSIZE] - (long) bufpt;
		1549	break;
		1550	case etFLOAT:
		1551	case etEXP:
		1552	case etGENERIC:
		1553	realvalue = va_arg (ap, double);
		1554	#ifndef etNOFLOATINGPOINT
		1555	if (precision < 0)
		1556	precision = 6; /* Set default precision */
		1557	if (precision > etBUFSIZE - 10)
		1558	precision = etBUFSIZE - 10;
		1559	if (realvalue < 0.0)
		1560	{
		1561	realvalue = -realvalue;
		1562	prefix = '-';
		1563	}
		1564	else
		1565	{
		1566	if (flag_plussign)
		1567	prefix = '+';
		1568	else if (flag_blanksign)
		1569	prefix = ' ';
		1570	else
		1571	prefix = 0;
		1572	}
		1573	if (infop->type == etGENERIC && precision > 0)
		1574	precision--;
		1575	rounder = 0.0;
		1576	#ifdef COMPATIBILITY
		1577	/* Rounding works like BSD when the constant 0.4999 is used. Wierd! */
		1578	for (idx = precision, rounder = 0.4999; idx > 0; idx--, rounder *= 0.1)
		1579	;
		1580	#else
		1581	/* It makes more sense to use 0.5 */
		1582	for (idx = precision, rounder = 0.5; idx > 0; idx--, rounder *= 0.1)
		1583	;
		1584	#endif
		1585	if (infop->type == etFLOAT)
		1586	realvalue += rounder;
		1587	/* Normalize realvalue to within 10.0 > realvalue >= 1.0 */
		1588	exp = 0;
		1589	if (realvalue > 0.0)
		1590	{
		1591	int k = 0;
		1592	while (realvalue >= 1e8 && k++ < 100)
		1593	{
		1594	realvalue *= 1e-8;
		1595	exp += 8;
		1596	}
		1597	while (realvalue >= 10.0 && k++ < 100)
		1598	{
		1599	realvalue *= 0.1;
		1600	exp++;
		1601	}
		1602	while (realvalue < 1e-8 && k++ < 100)
		1603	{
		1604	realvalue *= 1e8;
		1605	exp -= 8;
		1606	}
		1607	while (realvalue < 1.0 && k++ < 100)
		1608	{
		1609	realvalue *= 10.0;
		1610	exp--;
		1611	}
		1612	if (k >= 100)
		1613	{
		1614	bufpt = "NaN";
		1615	length = 3;
		1616	break;
		1617	}
		1618	}
		1619	bufpt = buf;
		1620	/*
		1621	** If the field type is etGENERIC, then convert to either etEXP
		1622	** or etFLOAT, as appropriate.
		1623	*/
		1624	flag_exp = xtype == etEXP;
		1625	if (xtype != etFLOAT)
		1626	{
		1627	realvalue += rounder;
		1628	if (realvalue >= 10.0)
		1629	{
		1630	realvalue *= 0.1;
		1631	exp++;
		1632	}
		1633	}
		1634	if (xtype == etGENERIC)
		1635	{
		1636	flag_rtz = !flag_alternateform;
		1637	if (exp < -4 \|\| exp > precision)
		1638	{
		1639	xtype = etEXP;
		1640	}
		1641	else
		1642	{
		1643	precision = precision - exp;
		1644	xtype = etFLOAT;
		1645	}
		1646	}
		1647	else
		1648	{
		1649	flag_rtz = 0;
		1650	}
		1651	/*
		1652	** The "exp+precision" test causes output to be of type etEXP if
		1653	** the precision is too large to fit in buf[].
		1654	*/
		1655	nsd = 0;
		1656	if (xtype == etFLOAT && exp + precision < etBUFSIZE - 30)
		1657	{
		1658	flag_dp = (precision > 0 \|\| flag_alternateform);
		1659	if (prefix)
		1660	(bufpt++) = prefix; / Sign */
		1661	if (exp < 0)
		1662	(bufpt++) = '0'; / Digits before "." */
		1663	else
		1664	for (; exp >= 0; exp--)
		1665	*(bufpt++) = et_getdigit (&realvalue, &nsd);
		1666	if (flag_dp)
		1667	(bufpt++) = '.'; / The decimal point */
		1668	for (exp++; exp < 0 && precision > 0; precision--, exp++)
		1669	{
		1670	*(bufpt++) = '0';
		1671	}
		1672	while ((precision--) > 0)
		1673	*(bufpt++) = et_getdigit (&realvalue, &nsd);
		1674	(bufpt--) = 0; / Null terminate */
		1675	if (flag_rtz && flag_dp)
		1676	{ /* Remove trailing zeros and "." */
		1677	while (bufpt >= buf && *bufpt == '0')
		1678	*(bufpt--) = 0;
		1679	if (bufpt >= buf && *bufpt == '.')
		1680	*(bufpt--) = 0;
		1681	}
		1682	bufpt++; /* point to next free slot */
		1683	}
		1684	else
		1685	{ /* etEXP or etGENERIC */
		1686	flag_dp = (precision > 0 \|\| flag_alternateform);
		1687	if (prefix)
		1688	(bufpt++) = prefix; / Sign */
		1689	(bufpt++) = et_getdigit (&realvalue, &nsd); / First digit */
		1690	if (flag_dp)
		1691	(bufpt++) = '.'; / Decimal point */
		1692	while ((precision--) > 0)
		1693	*(bufpt++) = et_getdigit (&realvalue, &nsd);
		1694	bufpt--; /* point to last digit */
		1695	if (flag_rtz && flag_dp)
		1696	{ /* Remove tail zeros */
		1697	while (bufpt >= buf && *bufpt == '0')
		1698	*(bufpt--) = 0;
		1699	if (bufpt >= buf && *bufpt == '.')
		1700	*(bufpt--) = 0;
		1701	}
		1702	bufpt++; /* point to next free slot */
		1703	if (exp \|\| flag_exp)
		1704	{
		1705	*(bufpt++) = infop->charset[0];
		1706	if (exp < 0)
		1707	{
		1708	*(bufpt++) = '-';
		1709	exp = -exp;
		1710	} /* sign of exp */
		1711	else
		1712	{
		1713	*(bufpt++) = '+';
		1714	}
		1715	if (exp >= 100)
		1716	{
		1717	*(bufpt++) =
		1718	(exp / 100) + '0'; /* 100's digit */
		1719	exp %= 100;
		1720	}
		1721	(bufpt++) = exp / 10 + '0'; / 10's digit */
		1722	(bufpt++) = exp % 10 + '0'; / 1's digit */
		1723	}
		1724	}
		1725	/* The converted number is in buf[] and zero terminated. Output it.
		1726	** Note that the number is in the usual order, not reversed as with
		1727	** integer conversions. */
		1728	length = (long) bufpt - (long) buf;
		1729	bufpt = buf;
		1730
		1731	/* Special case: Add leading zeros if the flag_zeropad flag is
		1732	** set and we are not left justified */
		1733	if (flag_zeropad && !flag_leftjustify && length < width)
		1734	{
		1735	int i;
		1736	int nPad = width - length;
		1737	for (i = width; i >= nPad; i--)
		1738	{
		1739	bufpt[i] = bufpt[i - nPad];
		1740	}
		1741	i = prefix != 0;
		1742	while (nPad--)
		1743	bufpt[i++] = '0';
		1744	length = width;
		1745	}
		1746	#endif
		1747	break;
		1748	case etSIZE:
		1749	(va_arg (ap, int )) = count;
		1750	length = width = 0;
		1751	break;
		1752	case etPERCENT:
		1753	buf[0] = '%';
		1754	bufpt = buf;
		1755	length = 1;
		1756	break;
		1757	case etCHARLIT:
		1758	case etCHARX:
		1759	c = buf[0] = (xtype == etCHARX ? va_arg (ap, int) : *++fmt);
		1760	if (precision >= 0)
		1761	{
		1762	for (idx = 1; idx < precision; idx++)
		1763	buf[idx] = c;
		1764	length = precision;
		1765	}
		1766	else
		1767	{
		1768	length = 1;
		1769	}
		1770	bufpt = buf;
		1771	break;
		1772	case etSTRING:
		1773	case etMEMSTRING:
		1774	zMem = bufpt = va_arg (ap, char *);
		1775	if (bufpt == 0)
		1776	bufpt = "(null)";
		1777	length = strlen (bufpt);
		1778	if (precision >= 0 && precision < length)
		1779	length = precision;
		1780	break;
		1781	case etTCLESCAPE:
		1782	{
		1783	int i, j, n, c, k;
		1784	char arg = va_arg (ap, char );
		1785	if (arg == 0)
		1786	arg = "(NULL)";
		1787	for (i = n = 0; (c = arg[i]) != 0; i++)
		1788	{
		1789	k = NeedEsc[c & 0xff];
		1790	if (k == 0)
		1791	{
		1792	n++;
		1793	}
		1794	else if (k == 1)
		1795	{
		1796	n += 4;
		1797	}
		1798	else
		1799	{
		1800	n += 2;
		1801	}
		1802	}
		1803	n++;
		1804	if (n > etBUFSIZE)
		1805	{
		1806	bufpt = zExtra = Tcl_Alloc (n);
		1807	}
		1808	else
		1809	{
		1810	bufpt = buf;
		1811	}
		1812	for (i = j = 0; (c = arg[i]) != 0; i++)
		1813	{
		1814	k = NeedEsc[c & 0xff];
		1815	if (k == 0)
		1816	{
		1817	bufpt[j++] = c;
		1818	}
		1819	else if (k == 1)
		1820	{
		1821	bufpt[j++] = '\\';
		1822	bufpt[j++] = ((c >> 6) & 3) + '0';
		1823	bufpt[j++] = ((c >> 3) & 7) + '0';
		1824	bufpt[j++] = (c & 7) + '0';
		1825	}
		1826	else
		1827	{
		1828	bufpt[j++] = '\\';
		1829	bufpt[j++] = k;
		1830	}
		1831	}
		1832	bufpt[j] = 0;
		1833	length = j;
		1834	if (precision >= 0 && precision < length)
		1835	length = precision;
		1836	}
		1837	break;
		1838	case etERROR:
		1839	buf[0] = '%';
		1840	buf[1] = c;
		1841	errorflag = 0;
		1842	idx = 1 + (c != 0);
		1843	(*func) (arg, "%", idx);
		1844	count += idx;
		1845	if (c == 0)
		1846	fmt--;
		1847	break;
		1848	} /* End switch over the format type */
		1849	/*
		1850	** The text of the conversion is pointed to by "bufpt" and is
		1851	** "length" characters long. The field width is "width". Do
		1852	** the output.
		1853	*/
		1854	if (!flag_leftjustify)
		1855	{
		1856	register int nspace;
		1857	nspace = width - length;
		1858	if (nspace > 0)
		1859	{
		1860	if (flag_center)
		1861	{
		1862	nspace = nspace / 2;
		1863	width -= nspace;
		1864	flag_leftjustify = 1;
		1865	}
		1866	count += nspace;
		1867	while (nspace >= etSPACESIZE)
		1868	{
		1869	(*func) (arg, spaces, etSPACESIZE);
		1870	nspace -= etSPACESIZE;
		1871	}
		1872	if (nspace > 0)
		1873	(*func) (arg, spaces, nspace);
		1874	}
		1875	}
		1876	if (length > 0)
		1877	{
		1878	(*func) (arg, bufpt, length);
		1879	count += length;
		1880	}
		1881	if (xtype == etMEMSTRING && zMem)
		1882	{
		1883	Tcl_Free (zMem);
		1884	}
		1885	if (flag_leftjustify)
		1886	{
		1887	register int nspace;
		1888	nspace = width - length;
		1889	if (nspace > 0)
		1890	{
		1891	count += nspace;
		1892	while (nspace >= etSPACESIZE)
		1893	{
		1894	(*func) (arg, spaces, etSPACESIZE);
		1895	nspace -= etSPACESIZE;
		1896	}
		1897	if (nspace > 0)
		1898	(*func) (arg, spaces, nspace);
		1899	}
		1900	}
		1901	if (zExtra)
		1902	{
		1903	Tcl_Free (zExtra);
		1904	}
		1905	} /* End for loop over the format string */
		1906	return errorflag ? -1 : count;
		1907	} /* End of function */
		1908
		1909	/*
		1910	** The following section of code handles the mprintf routine, that
		1911	** writes to memory obtained from malloc().
		1912	*/
		1913
		1914	/* This structure is used to store state information about the
		1915	** write to memory that is currently in progress.
		1916	*/
		1917	struct sgMprintf
		1918	{
		1919	char zBase; / A base allocation */
		1920	char zText; / The string collected so far */
		1921	int nChar; /* Length of the string so far */
		1922	int nAlloc; /* Amount of space allocated in zText */
		1923	};
		1924
		1925	/*
		1926	** The xprintf callback function.
		1927	**
		1928	** This routine add nNewChar characters of text in zNewText to
		1929	** the sgMprintf structure pointed to by "arg".
		1930	*/
		1931	static void mout (void arg, char zNewText, int nNewChar)
		1932	{
		1933	struct sgMprintf pM = (struct sgMprintf ) arg;
		1934	if (pM->nChar + nNewChar + 1 > pM->nAlloc)
		1935	{
		1936	pM->nAlloc = pM->nChar + nNewChar * 2 + 1;
		1937	if (pM->zText == pM->zBase)
		1938	{
		1939	pM->zText = Tcl_Alloc (pM->nAlloc);
		1940	if (pM->zText && pM->nChar)
		1941	memcpy (pM->zText, pM->zBase, pM->nChar);
		1942	}
		1943	else
		1944	{
		1945	pM->zText = Tcl_Realloc (pM->zText, pM->nAlloc);
		1946	}
		1947	}
		1948	if (pM->zText)
		1949	{
		1950	memcpy (&pM->zText[pM->nChar], zNewText, nNewChar);
		1951	pM->nChar += nNewChar;
		1952	pM->zText[pM->nChar] = 0;
		1953	}
		1954	}
		1955
		1956	/*
		1957	** mprintf() works like printf(), but allocations memory to hold the
		1958	** resulting string and returns a pointer to the allocated memory.
		1959	*/
		1960	char mprintf (const char zFormat, ...)
		1961	{
		1962	va_list ap;
		1963	struct sgMprintf sMprintf;
		1964	char *zNew;
		1965	char zBuf[200];
		1966
		1967	sMprintf.nChar = 0;
		1968	sMprintf.nAlloc = sizeof (zBuf);
		1969	sMprintf.zText = zBuf;
		1970	sMprintf.zBase = zBuf;
		1971	va_start (ap, zFormat);
		1972	vxprintf (mout, &sMprintf, zFormat, ap);
		1973	va_end (ap);
		1974	sMprintf.zText[sMprintf.nChar] = 0;
		1975	if (sMprintf.zText == sMprintf.zBase)
		1976	{
		1977	zNew = Tcl_Alloc (sMprintf.nChar + 1);
		1978	if (zNew)
		1979	strcpy (zNew, zBuf);
		1980	}
		1981	else
		1982	{
		1983	zNew = Tcl_Realloc (sMprintf.zText, sMprintf.nChar + 1);
		1984	}
		1985	return zNew;
		1986	}
		1987
		1988	/* This is the varargs version of mprintf.
		1989	*/
		1990	char vmprintf (const char zFormat, va_list ap)
		1991	{
		1992	struct sgMprintf sMprintf;
		1993	char zBuf[200];
		1994	sMprintf.nChar = 0;
		1995	sMprintf.zText = zBuf;
		1996	sMprintf.nAlloc = sizeof (zBuf);
		1997	sMprintf.zBase = zBuf;
		1998	vxprintf (mout, &sMprintf, zFormat, ap);
		1999	sMprintf.zText[sMprintf.nChar] = 0;
		2000	if (sMprintf.zText == sMprintf.zBase)
		2001	{
		2002	sMprintf.zText = Tcl_Alloc (strlen (zBuf) + 1);
		2003	if (sMprintf.zText)
		2004	strcpy (sMprintf.zText, zBuf);
		2005	}
		2006	else
		2007	{
		2008	sMprintf.zText = Tcl_Realloc (sMprintf.zText, sMprintf.nChar + 1);
		2009	}
		2010	return sMprintf.zText;
		2011	}
		2012
		2013	/*
		2014	** Add text output to a Tcl_DString.
		2015	**
		2016	** This routine is called by vxprintf(). It's job is to add
		2017	** nNewChar characters of text from zNewText to the Tcl_DString
		2018	** that "arg" is pointing to.
		2019	*/
		2020	static void dstringout (void arg, char zNewText, int nNewChar)
		2021	{
		2022	Tcl_DString str = (Tcl_DString ) arg;
		2023	Tcl_DStringAppend (str, zNewText, nNewChar);
		2024	}
		2025
		2026	/*
		2027	** Append formatted output to a DString.
		2028	*/
		2029	char Et_DStringAppendF (Tcl_DString str, const char *zFormat, ...)
		2030	{
		2031	va_list ap;
		2032	va_start (ap, zFormat);
		2033	vxprintf (dstringout, str, zFormat, ap);
		2034	va_end (ap);
		2035	return Tcl_DStringValue (str);
		2036	}
		2037
		2038	/*
		2039	** Make this variable true to trace all calls to EvalF
		2040	*/
		2041	int Et_EvalTrace = 0;
		2042
		2043	/*
		2044	** Eval the results of a string.
		2045	*/
		2046	int Et_EvalF (Tcl_Interp interp, const char zFormat, ...)
		2047	{
		2048	char *zCmd;
		2049	va_list ap;
		2050	int result;
		2051	va_start (ap, zFormat);
		2052	zCmd = vmprintf (zFormat, ap);
		2053	if (Et_EvalTrace)
		2054	printf ("%s\n", zCmd);
		2055	result = Tcl_Eval (interp, zCmd);
		2056	if (Et_EvalTrace)
		2057	printf ("%d %s\n", result, interp->result);
		2058	Tcl_Free (zCmd);
		2059	return result;
		2060	}
		2061	int Et_GlobalEvalF (Tcl_Interp interp, const char zFormat, ...)
		2062	{
		2063	char *zCmd;
		2064	va_list ap;
		2065	int result;
		2066	va_start (ap, zFormat);
		2067	zCmd = vmprintf (zFormat, ap);
		2068	if (Et_EvalTrace)
		2069	printf ("%s\n", zCmd);
		2070	result = Tcl_GlobalEval (interp, zCmd);
		2071	if (Et_EvalTrace)
		2072	printf ("%d %s\n", result, interp->result);
		2073	Tcl_Free (zCmd);
		2074	return result;
		2075	}
		2076
		2077	/*
		2078	** Set the result of an interpreter using printf-like arguments.
		2079	*/
		2080	void Et_ResultF (Tcl_Interp interp, const char zFormat, ...)
		2081	{
		2082	Tcl_DString str;
		2083	va_list ap;
		2084
		2085	Tcl_DStringInit (&str);
		2086	va_start (ap, zFormat);
		2087	vxprintf (dstringout, &str, zFormat, ap);
		2088	va_end (ap);
		2089	Tcl_DStringResult (interp, &str);
		2090	}
		2091
		2092	#if ET_HAVE_OBJ
		2093	/*
		2094	** Append text to a string object.
		2095	*/
		2096	int Et_AppendObjF (Tcl_Obj pObj, const char zFormat, ...)
		2097	{
		2098	va_list ap;
		2099	int rc;
		2100
		2101	va_start (ap, zFormat);
		2102	rc = vxprintf ((void () (void , char *, int)) Tcl_AppendToObj, pObj, zFormat, ap);
		2103	va_end (ap);
		2104	return rc;
		2105	}
		2106	#endif
		2107
		2108	#if ET_WIN32
		2109	/*
		2110	** This array translates all characters into themselves. Except
		2111	** for the \ which gets translated into /. And all upper-case
		2112	** characters are translated into lower case. This is used for
		2113	** hashing and comparing filenames, to work around the Windows
		2114	** bug of ignoring filename case and using the wrong separator
		2115	** character for directories.
		2116	**
		2117	** The array is initialized by FilenameHashInit().
		2118	**
		2119	** We also define a macro ET_TRANS() that actually does
		2120	** the character translation. ET_TRANS() is a no-op under
		2121	** unix.
		2122	*/
		2123	static char charTrans[256];
		2124	#define ET_TRANS(X) (charTrans[0xff & (int) (X)])
		2125	#else
		2126	#define ET_TRANS(X) (X)
		2127	#endif
		2128
		2129	/*
		2130	** Hash a filename. The value returned is appropriate for
		2131	** indexing into the Et_FileHashTable[] array.
		2132	*/
		2133	static int FilenameHash (char *zName)
		2134	{
		2135	int h = 0;
		2136	while (*zName)
		2137	{
		2138	h = h ^ (h << 5) ^ ET_TRANS (*(zName++));
		2139	}
		2140	if (h < 0)
		2141	h = -h;
		2142	return h % (sizeof (Et_FileHashTable) / sizeof (Et_FileHashTable[0]));
		2143	}
		2144
		2145	/*
		2146	** Compare two filenames. Return 0 if they are the same and
		2147	** non-zero if they are different.
		2148	*/
		2149	static int FilenameCmp (char z1, char z2)
		2150	{
		2151	int diff;
		2152	while ((diff = ET_TRANS (z1) - ET_TRANS (z2)) == 0 && *z1 != 0)
		2153	{
		2154	z1++;
		2155	z2++;
		2156	}
		2157	return diff;
		2158	}
		2159
		2160	/*
		2161	** Initialize the file hash table
		2162	*/
		2163	static void FilenameHashInit (void)
		2164	{
		2165	int i;
		2166	#if ET_WIN32
		2167	for (i = 0; i < sizeof (charTrans); i++)
		2168	{
		2169	charTrans[i] = i;
		2170	}
		2171	for (i = 'A'; i <= 'Z'; i++)
		2172	{
		2173	charTrans[i] = i + 'a' - 'A';
		2174	}
		2175	charTrans['\\'] = '/';
		2176	#endif
		2177	for (i = 0; i < sizeof (Et_FileSet) / sizeof (Et_FileSet[0]) - 1; i++)
		2178	{
		2179	struct EtFile *p;
		2180	int h;
		2181	p = &Et_FileSet[i];
		2182	h = FilenameHash (p->zName);
		2183	p->pNext = Et_FileHashTable[h];
		2184	Et_FileHashTable[h] = p;
		2185	}
		2186	}
		2187
		2188	/*
		2189	** Locate the text of a built-in file given its name.
		2190	** Return 0 if not found. Return this size of the file (not
		2191	** counting the null-terminator) in *pSize if pSize!=NULL.
		2192	**
		2193	** If deshroud==1 and the file is shrouded, then descramble
		2194	** the text.
		2195	*/
		2196	static char FindBuiltinFile (char zName, int deshroud, int *pSize)
		2197	{
		2198	int h;
		2199	struct EtFile *p;
		2200
		2201	h = FilenameHash (zName);
		2202	p = Et_FileHashTable[h];
		2203	while (p && FilenameCmp (p->zName, zName) != 0)
		2204	{
		2205	p = p->pNext;
		2206	}
		2207	#if ET_SHROUD_KEY > 0
		2208	if (p && p->shrouded && deshroud)
		2209	{
		2210	char *z;
		2211	int xor = ET_SHROUD_KEY;
		2212	for (z = p->zData; *z; z++)
		2213	{
		2214	if (*z >= 0x20)
		2215	{
		2216	*z ^= xor;
		2217	xor = (xor+1) & 0x1f;
		2218	}
		2219	}
		2220	p->shrouded = 0;
		2221	}
		2222	#endif
		2223	if (p && pSize)
		2224	{
		2225	*pSize = p->nData;
		2226	}
		2227	return p ? p->zData : 0;
		2228	}
		2229
		2230	/*
		2231	** Add a new file to the list of built-in files.
		2232	**
		2233	** This routine makes a copy of zFilename. But it does NOT make
		2234	** a copy of zData. It just holds a pointer to zData and uses
		2235	** that for all file access. So after calling this routine,
		2236	** you should never change zData!
		2237	*/
		2238	void Et_NewBuiltinFile (
		2239	char zFilename, / Name of the new file */
		2240	char zData, / Data for the new file */
		2241	int nData /* Number of bytes in the new file */
		2242	)
		2243	{
		2244	int h;
		2245	struct EtFile *p;
		2246
		2247	p = (struct EtFile *) Tcl_Alloc (sizeof (struct EtFile) + strlen (zFilename) + 1);
		2248	if (p == 0)
		2249	return;
		2250	p->zName = (char *) &p[1];
		2251	strcpy (p->zName, zFilename);
		2252	p->zData = zData;
		2253	p->nData = nData;
		2254	p->shrouded = 0;
		2255	h = FilenameHash (zFilename);
		2256	p->pNext = Et_FileHashTable[h];
		2257	Et_FileHashTable[h] = p;
		2258	}
		2259
		2260	/*
		2261	** A TCL interface to the Et_NewBuiltinFile function. For Tcl8.0
		2262	** and later, we make this an Obj command so that it can deal with
		2263	** binary data.
		2264	*/
		2265	#if ET_HAVE_OBJ
		2266	static int Et_NewBuiltinFileCmd (ET_OBJARGS)
		2267	{
		2268	char zData, zNew;
		2269	int nData;
		2270	if (objc != 3)
		2271	{
		2272	Tcl_WrongNumArgs (interp, 1, objv, "filename data");
		2273	return TCL_ERROR;
		2274	}
		2275	zData = (char *) Tcl_GetByteArrayFromObj (objv[2], &nData);
		2276	zNew = Tcl_Alloc (nData + 1);
		2277	if (zNew)
		2278	{
		2279	memcpy (zNew, zData, nData);
		2280	zNew[nData] = 0;
		2281	Et_NewBuiltinFile (Tcl_GetStringFromObj (objv[1], 0), zNew, nData);
		2282	}
		2283	return TCL_OK;
		2284	}
		2285	#else
		2286	static int Et_NewBuiltinFileCmd (ET_TCLARGS)
		2287	{
		2288	char *zData;
		2289	int nData;
		2290	if (argc != 3)
		2291	{
		2292	Et_ResultF (interp, "wrong # args: should be \"%s FILENAME DATA\"", argv[0]);
		2293	return TCL_ERROR;
		2294	}
		2295	nData = strlen (argv[2]) + 1;
		2296	zData = Tcl_Alloc (nData);
		2297	if (zData)
		2298	{
		2299	strcpy (zData, argv[2]);
		2300	Et_NewBuiltinFile (argv[1], zData, nData);
		2301	}
		2302	return TCL_OK;
		2303	}
		2304	#endif
		2305
		2306	/*
		2307	** The following section implements the InsertProc functionality. The
		2308	** new InsertProc feature of Tcl8.0.3 and later allows us to overload
		2309	** the usual system call commands for file I/O and replace them with
		2310	** commands that operate on the built-in files.
		2311	*/
		2312	#ifdef ET_HAVE_INSERTPROC
		2313
		2314	/*
		2315	** Each open channel to a built-in file is an instance of the
		2316	** following structure.
		2317	*/
		2318	typedef struct Et_FileStruct
		2319	{
		2320	char zData; / All of the data */
		2321	int nData; /* Bytes of data, not counting the null terminator */
		2322	int cursor; /* How much of the data has been read so far */
		2323	} Et_FileStruct;
		2324
		2325	/*
		2326	** Close a previously opened built-in file.
		2327	*/
		2328	static int Et_FileClose (ClientData instanceData, Tcl_Interp *interp)
		2329	{
		2330	Et_FileStruct p = (Et_FileStruct ) instanceData;
		2331	Tcl_Free ((char *) p);
		2332	return 0;
		2333	}
		2334
		2335	/*
		2336	** Read from a built-in file.
		2337	*/
		2338	static int Et_FileInput (
		2339	ClientData instanceData, /* The file structure */
		2340	char buf, / Write the data read here */
		2341	int bufSize, /* Read this much data */
		2342	int pErrorCode / Write the error code here */
		2343	)
		2344	{
		2345	Et_FileStruct p = (Et_FileStruct ) instanceData;
		2346	*pErrorCode = 0;
		2347	if (p->cursor + bufSize > p->nData)
		2348	{
		2349	bufSize = p->nData - p->cursor;
		2350	}
		2351	memcpy (buf, &p->zData[p->cursor], bufSize);
		2352	p->cursor += bufSize;
		2353	return bufSize;
		2354	}
		2355
		2356	/*
		2357	** Writes to a built-in file always return EOF.
		2358	*/
		2359	static int Et_FileOutput (
		2360	ClientData instanceData, /* The file structure */
		2361	char buf, / Read the data from here */
		2362	int toWrite, /* Write this much data */
		2363	int pErrorCode / Write the error code here */
		2364	)
		2365	{
		2366	*pErrorCode = 0;
		2367	return 0;
		2368	}
		2369
		2370	/*
		2371	** Move the cursor around within the built-in file.
		2372	*/
		2373	static int Et_FileSeek (
		2374	ClientData instanceData, /* The file structure */
		2375	long offset, /* Offset to seek to */
		2376	int mode, /* One of SEEK_CUR, SEEK_SET or SEEK_END */
		2377	int pErrorCode / Write the error code here */
		2378	)
		2379	{
		2380	Et_FileStruct p = (Et_FileStruct ) instanceData;
		2381	switch (mode)
		2382	{
		2383	case SEEK_CUR:
		2384	offset += p->cursor;
		2385	break;
		2386	case SEEK_END:
		2387	offset += p->nData;
		2388	break;
		2389	default:
		2390	break;
		2391	}
		2392	if (offset < 0)
		2393	offset = 0;
		2394	if (offset > p->nData)
		2395	offset = p->nData;
		2396	p->cursor = offset;
		2397	return offset;
		2398	}
		2399
		2400	/*
		2401	** The Watch method is a no-op
		2402	*/
		2403	static void Et_FileWatch (ClientData instanceData, int mask)
		2404	{
		2405	}
		2406
		2407	/*
		2408	** The Handle method always returns an error.
		2409	*/
		2410	static int Et_FileHandle (ClientData notUsed, int dir, ClientData *handlePtr)
		2411	{
		2412	return TCL_ERROR;
		2413	}
		2414
		2415	/*
		2416	** This is the channel type that will access the built-in files.
		2417	*/
		2418	static Tcl_ChannelType builtinChannelType = {
		2419	"builtin", /* Type name. */
		2420	NULL, /* Always non-blocking.*/
		2421	Et_FileClose, /* Close proc. */
		2422	Et_FileInput, /* Input proc. */
		2423	Et_FileOutput, /* Output proc. */
		2424	Et_FileSeek, /* Seek proc. */
		2425	NULL, /* Set option proc. */
		2426	NULL, /* Get option proc. */
		2427	Et_FileWatch, /* Watch for events on console. */
		2428	Et_FileHandle, /* Get a handle from the device. */
		2429	};
		2430
		2431	/*
		2432	** This routine attempts to do an open of a built-in file.
		2433	*/
		2434	static Tcl_Channel Et_FileOpen (
		2435	Tcl_Interp interp, / The TCL interpreter doing the open */
		2436	char zFilename, / Name of the file to open */
		2437	char modeString, / Mode string for the open (ignored) */
		2438	int permissions /* Permissions for a newly created file (ignored) */
		2439	)
		2440	{
		2441	char *zData;
		2442	Et_FileStruct *p;
		2443	int nData;
		2444	char zName[50];
		2445	Tcl_Channel chan;
		2446	static int count = 1;
		2447
		2448	zData = FindBuiltinFile (zFilename, 1, &nData);
		2449	if (zData == 0)
		2450	return NULL;
		2451	p = (Et_FileStruct *) Tcl_Alloc (sizeof (Et_FileStruct));
		2452	if (p == 0)
		2453	return NULL;
		2454	p->zData = zData;
		2455	p->nData = nData;
		2456	p->cursor = 0;
		2457	sprintf (zName, "etbi_%x_%x", ((int) Et_FileOpen) >> 12, count++);
		2458	chan = Tcl_CreateChannel (&builtinChannelType, zName, (ClientData) p, TCL_READABLE);
		2459	return chan;
		2460	}
		2461
		2462	/*
		2463	** This routine does a stat() system call for a built-in file.
		2464	*/
		2465	static int Et_FileStat (char path, struct stat buf)
		2466	{
		2467	char *zData;
		2468	int nData;
		2469
		2470	zData = FindBuiltinFile (path, 0, &nData);
		2471	if (zData == 0)
		2472	{
		2473	return -1;
		2474	}
		2475	memset (buf, 0, sizeof (*buf));
		2476	buf->st_mode = 0400;
		2477	buf->st_size = nData;
		2478	return 0;
		2479	}
		2480
		2481	/*
		2482	** This routien does an access() system call for a built-in file.
		2483	*/
		2484	static int Et_FileAccess (char *path, int mode)
		2485	{
		2486	char *zData;
		2487
		2488	if (mode & 3)
		2489	{
		2490	return -1;
		2491	}
		2492	zData = FindBuiltinFile (path, 0, 0);
		2493	if (zData == 0)
		2494	{
		2495	return -1;
		2496	}
		2497	return 0;
		2498	}
		2499	#endif /* ET_HAVE_INSERTPROC */
		2500
		2501	/*
		2502	** An overloaded version of "source". First check for the file
		2503	** is one of the built-ins. If it isn't a built-in, then check the
		2504	** disk. But if ET_STANDALONE is set (which corresponds to the
		2505	** "Strict" option in the user interface) then never check the disk.
		2506	** This gives us a quick way to check for the common error of
		2507	** sourcing a file that exists on the development by mistake,
		2508	** and only discovering the mistake when you move the program
		2509	** to your customer's machine.
		2510	*/
		2511	static int Et_Source (ET_TCLARGS)
		2512	{
		2513	char *z;
		2514
		2515	if (argc != 2)
		2516	{
		2517	Et_ResultF (interp, "wrong # args: should be \"%s FILENAME\"", argv[0]);
		2518	return TCL_ERROR;
		2519	}
		2520	z = FindBuiltinFile (argv[1], 1, 0);
		2521	if (z)
		2522	{
		2523	int rc;
		2524	rc = Tcl_Eval (interp, z);
		2525	if (rc == TCL_ERROR)
		2526	{
		2527	char msg[200];
		2528	sprintf (
		2529	msg,
		2530	"\n (file \"%.150s\" line %d)",
		2531	argv[1],
		2532	interp->errorLine);
		2533	Tcl_AddErrorInfo (interp, msg);
		2534	}
		2535	else
		2536	{
		2537	rc = TCL_OK;
		2538	}
		2539	return rc;
		2540	}
		2541	#if ET_STANDALONE
		2542	Et_ResultF (interp, "no such file: \"%s\"", argv[1]);
		2543	return TCL_ERROR;
		2544	#else
		2545	return Tcl_EvalFile (interp, argv[1]);
		2546	#endif
		2547	}
		2548
		2549	#ifndef ET_HAVE_INSERTPROC
		2550	/*
		2551	** An overloaded version of "file exists". First check for the file
		2552	** in the file table, then go to disk.
		2553	**
		2554	** We only overload "file exists" if we don't have InsertProc()
		2555	** procedures. If we do have InsertProc() procedures, they will
		2556	** handle this more efficiently.
		2557	*/
		2558	static int Et_FileExists (ET_TCLARGS)
		2559	{
		2560	int i, rc;
		2561	Tcl_DString str;
		2562	if (argc == 3 && strncmp (argv[1], "exis", 4) == 0)
		2563	{
		2564	if (FindBuiltinFile (argv[2], 0, 0) != 0)
		2565	{
		2566	interp->result = "1";
		2567	return TCL_OK;
		2568	}
		2569	}
		2570	Tcl_DStringInit (&str);
		2571	Tcl_DStringAppendElement (&str, "Et_FileCmd");
		2572	for (i = 1; i < argc; i++)
		2573	{
		2574	Tcl_DStringAppendElement (&str, argv[i]);
		2575	}
		2576	rc = Tcl_Eval (interp, Tcl_DStringValue (&str));
		2577	Tcl_DStringFree (&str);
		2578	return rc;
		2579	}
		2580	#endif
		2581
		2582	/*
		2583	** This is the main Tcl interpreter. It's a global variable so it
		2584	** can be accessed easily from C code.
		2585	*/
		2586	Tcl_Interp *Et_Interp = 0;
		2587
		2588	#if ET_WIN32
		2589	/*
		2590	** Implement the Et_MessageBox command on Windows platforms. We
		2591	** use the MessageBox() function from the Win32 API so that the
		2592	** error message will be displayed as a dialog box. Writing to
		2593	** standard error doesn't do anything on windows.
		2594	*/
		2595	int Et_MessageBox (ET_TCLARGS)
		2596	{
		2597	char *zMsg = "(Empty Message)";
		2598	char *zTitle = "Message...";
		2599
		2600	if (argc > 1)
		2601	{
		2602	zTitle = argv[1];
		2603	}
		2604	if (argc > 2)
		2605	{
		2606	zMsg = argv[2];
		2607	}
		2608	MessageBox (0, zMsg, zTitle, MB_ICONSTOP \| MB_OK);
		2609	return TCL_OK;
		2610	}
		2611	#endif
		2612
		2613	/*
		2614	** A default implementation for "bgerror"
		2615	*/
		2616	static char zBgerror[] = "proc Et_Bgerror err {\n"
		2617	" global errorInfo tk_library\n"
		2618	" if {[info exists errorInfo]} {\n"
		2619	" set ei $errorInfo\n"
		2620	" } else {\n"
		2621	" set ei {}\n"
		2622	" }\n"
		2623	" if {[catch {bgerror $err}]==0} return\n"
		2624	" if {[string length $ei]>0} {\n"
		2625	" set err $ei\n"
		2626	" }\n"
		2627	" if {[catch {Et_MessageBox {Error} $err}]} {\n"
		2628	" puts stderr $err\n"
		2629	" }\n"
		2630	" exit\n"
		2631	"}\n";
		2632
		2633	/*
		2634	** Do the initialization.
		2635	**
		2636	** This routine is called after the interpreter is created, but
		2637	** before Et_PreInit() or Et_AppInit() have been run.
		2638	*/
		2639	static int Et_DoInit (Tcl_Interp *interp)
		2640	{
		2641	int i;
		2642	extern int Et_PreInit (Tcl_Interp *);
		2643	extern int Et_AppInit (Tcl_Interp *);
		2644
		2645	/* Insert our alternative stat(), access() and open() procedures
		2646	** so that any attempt to work with a file will check our built-in
		2647	** scripts first.
		2648	*/
		2649	#ifdef ET_HAVE_INSERTPROC
		2650	TclStatInsertProc (Et_FileStat);
		2651	TclAccessInsertProc (Et_FileAccess);
		2652	TclOpenFileChannelInsertProc (Et_FileOpen);
		2653	#endif
		2654
		2655	/* Initialize the hash-table for built-in scripts
		2656	*/
		2657	FilenameHashInit ();
		2658
		2659	/* The Et_NewBuiltFile command is inserted for use by FreeWrap
		2660	** and similar tools.
		2661	*/
		2662	#if ET_HAVE_OBJ
		2663	Tcl_CreateObjCommand (interp, "Et_NewBuiltinFile", Et_NewBuiltinFileCmd, 0, 0);
		2664	#else
		2665	Tcl_CreateCommand (interp, "Et_NewBuiltinFile", Et_NewBuiltinFileCmd, 0, 0);
		2666	#endif
		2667
		2668	/* Overload the "file" and "source" commands
		2669	*/
		2670	#ifndef ET_HAVE_INSERTPROC
		2671	{
		2672	static char zRename[] = "rename file Et_FileCmd";
		2673	Tcl_Eval (interp, zRename);
		2674	Tcl_CreateCommand (interp, "file", Et_FileExists, 0, 0);
		2675	}
		2676	#endif
		2677	Tcl_CreateCommand (interp, "source", Et_Source, 0, 0);
		2678
		2679	Et_Interp = interp;
		2680	#ifdef ET_TCL_LIBRARY
		2681	Tcl_SetVar (interp, "tcl_library", ET_TCL_LIBRARY, TCL_GLOBAL_ONLY);
		2682	Tcl_SetVar (interp, "tcl_libPath", ET_TCL_LIBRARY, TCL_GLOBAL_ONLY);
		2683	Tcl_SetVar2 (interp, "env", "TCL_LIBRARY", ET_TCL_LIBRARY, TCL_GLOBAL_ONLY);
		2684	#endif
		2685	#ifdef ET_TK_LIBRARY
		2686	Tcl_SetVar (interp, "tk_library", ET_TK_LIBRARY, TCL_GLOBAL_ONLY);
		2687	Tcl_SetVar2 (interp, "env", "TK_LIBRARY", ET_TK_LIBRARY, TCL_GLOBAL_ONLY);
		2688	#endif
		2689	#if ET_WIN32
		2690	Tcl_CreateCommand (interp, "Et_MessageBox", Et_MessageBox, 0, 0);
		2691	#endif
		2692	Tcl_Eval (interp, zBgerror);
		2693	#if ET_HAVE_PREINIT
		2694	if (Et_PreInit (interp) == TCL_ERROR)
		2695	{
		2696	goto initerr;
		2697	}
		2698	#endif
		2699	if (Tcl_Init (interp) == TCL_ERROR)
		2700	{
		2701	goto initerr;
		2702	}
		2703	Et_GlobalEvalF (interp, "set dir $tcl_library;source $dir/tclIndex;unset dir");
		2704	#if ET_ENABLE_TK
		2705	if (Tk_Init (interp) == TCL_ERROR)
		2706	{
		2707	goto initerr;
		2708	}
		2709	Tcl_StaticPackage (interp, "Tk", Tk_Init, 0);
		2710	Et_GlobalEvalF (interp, "set dir $tk_library;source $dir/tclIndex;unset dir");
		2711	#endif
		2712	/* Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY); */
		2713	for (i = 0; i < sizeof (Et_CmdSet) / sizeof (Et_CmdSet[0]) - 1; i++)
		2714	{
		2715	Tcl_CreateCommand (interp, Et_CmdSet[i].zName, Et_CmdSet[i].xProc, 0, 0);
		2716	}
		2717	#if ET_ENABLE_OBJ
		2718	for (i = 0; i < sizeof (Et_ObjSet) / sizeof (Et_ObjSet[0]) - 1; i++)
		2719	{
		2720	Tcl_CreateObjCommand (interp, Et_ObjSet[i].zName, Et_ObjSet[i].xProc, 0, 0);
		2721	}
		2722	#endif
		2723	Tcl_LinkVar (interp, "Et_EvalTrace", (char *) &Et_EvalTrace, TCL_LINK_BOOLEAN);
		2724	Tcl_SetVar (interp, "et_version", ET_VERSION, TCL_GLOBAL_ONLY);
		2725	#if ET_HAVE_APPINIT
		2726	if (Et_AppInit (interp) == TCL_ERROR)
		2727	{
		2728	goto initerr;
		2729	}
		2730	#endif
		2731	#if ET_ENABLE_TK && !ET_EXTENSION
		2732	Et_NewBuiltinFile ("builtin:/console.tcl", zEtConsole, sizeof (zEtConsole));
		2733	#if ET_CONSOLE
		2734	Tcl_Eval (
		2735	interp,
		2736	"source builtin:/console.tcl\n"
		2737	"console:create {.@console} {% } {Tcl/Tk Console}\n");
		2738	#endif
		2739	#endif
		2740	#ifdef ET_MAIN_SCRIPT
		2741	if (Et_EvalF (interp, "source \"%q\"", ET_MAIN_SCRIPT) != TCL_OK)
		2742	{
		2743	goto initerr;
		2744	}
		2745	#endif
		2746	return TCL_OK;
		2747
		2748	initerr:
		2749	Et_EvalF (interp, "Et_Bgerror \"%q\"", interp->result);
		2750	return TCL_ERROR;
		2751	}
		2752
		2753	#if ET_READ_STDIN == 0 \|\| ET_AUTO_FORK != 0
		2754	/*
		2755	** Initialize everything.
		2756	*/
		2757	static int Et_Local_Init (int argc, char **argv)
		2758	{
		2759	Tcl_Interp *interp;
		2760	char *args;
		2761	char buf[100];
		2762	#if !ET_HAVE_CUSTOM_MAINLOOP
		2763	static char zWaitForever[] =
		2764	#if ET_ENABLE_TK
		2765	"bind . <Destroy> {if {![winfo exists .]} exit}\n"
		2766	#endif
		2767	"while 1 {vwait forever}";
		2768	#endif
		2769
		2770	Tcl_FindExecutable (argv[0]);
		2771	interp = Tcl_CreateInterp ();
		2772	args = Tcl_Merge (argc - 1, argv + 1);
		2773	Tcl_SetVar (interp, "argv", args, TCL_GLOBAL_ONLY);
		2774	ckfree (args);
		2775	sprintf (buf, "%d", argc - 1);
		2776	Tcl_SetVar (interp, "argc", buf, TCL_GLOBAL_ONLY);
		2777	Tcl_SetVar (interp, "argv0", argv[0], TCL_GLOBAL_ONLY);
		2778	Tcl_SetVar (interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
		2779	Et_DoInit (interp);
		2780	#if ET_HAVE_CUSTOM_MAINLOOP
		2781	Et_CustomMainLoop (interp);
		2782	#else
		2783	Tcl_Eval (interp, zWaitForever);
		2784	#endif
		2785	return 0;
		2786	}
		2787	#endif
		2788
		2789	/*
		2790	** This routine is called to do the complete initialization.
		2791	*/
		2792	int Et_Init (int argc, char **argv)
		2793	{
		2794	#ifdef ET_TCL_LIBRARY
		2795	putenv ("TCL_LIBRARY=" ET_TCL_LIBRARY);
		2796	#endif
		2797	#ifdef ET_TK_LIBRARY
		2798	putenv ("TK_LIBRARY=" ET_TK_LIBRARY);
		2799	#endif
		2800	#if ET_CONSOLE \|\| !ET_READ_STDIN
		2801	Et_Local_Init (argc, argv);
		2802	#else
		2803	#if ET_ENABLE_TK
		2804	Tk_Main (argc, argv, Et_DoInit);
		2805	#else
		2806	Tcl_Main (argc, argv, Et_DoInit);
		2807	#endif
		2808	#endif
		2809	return 0;
		2810	}
		2811
		2812	#if !ET_HAVE_MAIN && !ET_EXTENSION
		2813	/*
		2814	** Main routine for UNIX programs. If the user has supplied
		2815	** their own main() routine in a C module, then the ET_HAVE_MAIN
		2816	** macro will be set to 1 and this code will be skipped.
		2817	*/
		2818	int main (int argc, char **argv)
		2819	{
		2820	#if ET_AUTO_FORK
		2821	int rc = fork ();
		2822	if (rc < 0)
		2823	{
		2824	perror ("can't fork");
		2825	exit (1);
		2826	}
		2827	if (rc > 0)
		2828	return 0;
		2829	close (0);
		2830	open ("/dev/null", O_RDONLY);
		2831	close (1);
		2832	open ("/dev/null", O_WRONLY);
		2833	#endif
		2834	return Et_Init (argc, argv) != TCL_OK;
		2835	}
		2836	#endif
		2837
		2838	#if ET_EXTENSION
		2839	/*
		2840	** If the -extension flag is used, then generate code that will be
		2841	** turned into a loadable shared library or DLL, not a standalone
		2842	** executable.
		2843	*/
		2844	int ET_EXTENSION_NAME (Tcl_Interp *interp)
		2845	{
		2846	int i;
		2847	#ifndef ET_HAVE_INSERTPROC
		2848	Tcl_AppendResult (
		2849	interp,
		2850	"mktclapp can only generate extensions for Tcl/Tk version "
		2851	"8.0.3 and later. This is version " TCL_MAJOR_VERSION "." TCL_MINOR_VERSION
		2852	"." TCL_RELEASE_SERIAL,
		2853	0);
		2854	return TCL_ERROR;
		2855	#endif
		2856	#ifdef ET_HAVE_INSERTPROC
		2857	#ifdef USE_TCL_STUBS
		2858	if (Tcl_InitStubs (interp, "8.0", 0) == 0)
		2859	{
		2860	return TCL_ERROR;
		2861	}
		2862	if (Tk_InitStubs (interp, "8.0", 0) == 0)
		2863	{
		2864	return TCL_ERROR;
		2865	}
		2866	#endif
		2867	Et_Interp = interp;
		2868	TclStatInsertProc (Et_FileStat);
		2869	TclAccessInsertProc (Et_FileAccess);
		2870	TclOpenFileChannelInsertProc (Et_FileOpen);
		2871	FilenameHashInit ();
		2872	for (i = 0; i < sizeof (Et_CmdSet) / sizeof (Et_CmdSet[0]) - 1; i++)
		2873	{
		2874	Tcl_CreateCommand (interp, Et_CmdSet[i].zName, Et_CmdSet[i].xProc, 0, 0);
		2875	}
		2876	#if ET_ENABLE_OBJ
		2877	for (i = 0; i < sizeof (Et_ObjSet) / sizeof (Et_ObjSet[0]) - 1; i++)
		2878	{
		2879	Tcl_CreateObjCommand (interp, Et_ObjSet[i].zName, Et_ObjSet[i].xProc, 0, 0);
		2880	}
		2881	#endif
		2882	Tcl_LinkVar (interp, "Et_EvalTrace", (char *) &Et_EvalTrace, TCL_LINK_BOOLEAN);
		2883	Tcl_SetVar (interp, "et_version", ET_VERSION, TCL_GLOBAL_ONLY);
		2884	#if ET_HAVE_APPINIT
		2885	if (Et_AppInit (interp) == TCL_ERROR)
		2886	{
		2887	return TCL_ERROR;
		2888	}
		2889	#endif
		2890	#ifdef ET_MAIN_SCRIPT
		2891	if (Et_EvalF (interp, "source \"%q\"", ET_MAIN_SCRIPT) != TCL_OK)
		2892	{
		2893	return TCL_ERROR;
		2894	}
		2895	#endif
		2896	return TCL_OK;
		2897	#endif /* ET_HAVE_INSERTPROC */
		2898	}
		2899	int ET_SAFE_EXTENSION_NAME (Tcl_Interp *interp)
		2900	{
		2901	return ET_EXTENSION_NAME (interp);
		2902	}
		2903	#endif

Subversion Repositories Vertical

(root)/branches/metal/vertcl_src/vertcl_main.c – Rev 2