/* This code is automatically generated by "mktclapp" version 3.9 */
/* DO NOT EDIT */
#include <tcl.h>
#define INTERFACE 1
#if INTERFACE
#define ET_TCLARGS ClientData clientData,Tcl_Interp*interp,int argc,char**argv
#define ET_OBJARGS ClientData clientData,Tcl_Interp*interp,int objc,Tcl_Obj*CONST objv[]
#endif
#define ET_ENABLE_OBJ 0
#define ET_ENABLE_TK 1
#define ET_AUTO_FORK 0
#define ET_STANDALONE 0
#define ET_N_BUILTIN_SCRIPT 2
#define ET_VERSION "3.9"
#define ET_HAVE_APPINIT 0
#define ET_HAVE_PREINIT 0
#define ET_HAVE_MAIN 1
#define ET_HAVE_CUSTOM_MAINLOOP 0
#define ET_TCL_LIBRARY "C:/cygwin/usr/share/tcl8.0"
#define ET_TK_LIBRARY "C:/cygwin/usr/share/tk8.0"
#define ET_MAIN_SCRIPT "C:/cygwin/home/vertical/scripts/trial.tcl"
#define ET_EXTENSION 0
#define ET_SHROUD_KEY 0
#define ET_READ_STDIN 1
#define ET_CONSOLE 0
extern int ET_COMMAND_vertical(ET_TCLARGS);
extern int ET_COMMAND_wossat(ET_TCLARGS);
static struct {
char *zName;
int (*xProc)(ET_TCLARGS);
} Et_CmdSet[] = {
{ "vertical", ET_COMMAND_vertical },
{ "wossat", ET_COMMAND_wossat },
{0, 0}};
static char Et_zFile0[] =
"# Tcl autoload index file, version 2.0\n"
"# This file is generated by the \"auto_mkindex\" command\n"
"# and sourced to set up indexing information for one or\n"
"# more commands. Typically each line is a command that\n"
"# sets an element in the auto_index array, where the\n"
"# element name is the name of a command and the value is\n"
"# a script that loads the command.\n"
"\n"
"set auto_index(history) [list source [file join $dir history.tcl]]\n"
"set auto_index(tclLdAout) [list source [file join $dir ldAout.tcl]]\n"
"set auto_index(parray) [list source [file join $dir parray.tcl]]\n"
"set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]]\n"
"set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]]\n"
"set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]]\n"
"set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]]\n"
"set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]]\n"
"set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]]\n"
;
static char Et_zFile1[] =
"# Tcl autoload index file, version 2.0\n"
"# This file is generated by the \"auto_mkindex\" command\n"
"# and sourced to set up indexing information for one or\n"
"# more commands. Typically each line is a command that\n"
"# sets an element in the auto_index array, where the\n"
"# element name is the name of a command and the value is\n"
"# a script that loads the command.\n"
"\n"
"set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkCheckRadioEnter) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkCheckRadioDown) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonInvoke) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkCheckRadioInvoke) [list source [file join $dir button.tcl]]\n"
"set auto_index(tk_dialog) [list source [file join $dir dialog.tcl]]\n"
"set auto_index(tkEntryClosestGap) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryButton1) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryMouseSelect) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryPaste) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryAutoScan) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryKeySelect) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryInsert) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryBackspace) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntrySeeInsert) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntrySetCursor) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryTranspose) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryPreviousWord) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkListboxBeginSelect) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxMotion) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxBeginExtend) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxBeginToggle) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxAutoScan) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxUpDown) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxExtendUpDown) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxDataExtend) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxCancel) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxSelectAll) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkMbEnter) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMbLeave) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMbPost) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuUnpost) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMbMotion) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMbButtonUp) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuMotion) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuButtonDown) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuLeave) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuInvoke) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuEscape) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuUpArrow) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuDownArrow) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuLeftArrow) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuRightArrow) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuNextMenu) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuNextEntry) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuFind) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkTraverseToMenu) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkFirstMenu) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkTraverseWithinMenu) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuFirstEntry) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuFindName) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkPostOverPoint) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkSaveGrabInfo) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkRestoreOldGrab) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tk_menuSetFocus) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkGenerateMenuSelect) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tk_popup) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkScrollButtonDown) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollButtonUp) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollSelect) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollStartDrag) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollDrag) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollEndDrag) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollByUnits) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollByPages) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollToPos) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollTopBottom) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollButton2Down) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkTextClosestGap) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextButton1) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextSelectTo) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextKeyExtend) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextPaste) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextAutoScan) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextSetCursor) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextKeySelect) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextResetAnchor) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextInsert) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextUpDownLine) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextPrevPara) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextNextPara) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextScrollPages) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextTranspose) [list source [file join $dir text.tcl]]\n"
"set auto_index(tk_textCopy) [list source [file join $dir text.tcl]]\n"
"set auto_index(tk_textCut) [list source [file join $dir text.tcl]]\n"
"set auto_index(tk_textPaste) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextNextPos) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextPrevPos) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkScreenChanged) [list source [file join $dir tk.tcl]]\n"
"set auto_index(tkEventMotifBindings) [list source [file join $dir tk.tcl]]\n"
"set auto_index(tkCancelRepeat) [list source [file join $dir tk.tcl]]\n"
"set auto_index(tkTabToWindow) [list source [file join $dir tk.tcl]]\n"
"set auto_index(bgerror) [list source [file join $dir bgerror.tcl]]\n"
"set auto_index(tkScaleActivate) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleButtonDown) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleDrag) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleEndDrag) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleIncrement) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleControlPress) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleButton2Down) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tk_optionMenu) [list source [file join $dir optMenu.tcl]]\n"
"set auto_index(tkTearOffMenu) [list source [file join $dir tearoff.tcl]]\n"
"set auto_index(tkMenuDup) [list source [file join $dir tearoff.tcl]]\n"
"set auto_index(tk_menuBar) [list source [file join $dir obsolete.tcl]]\n"
"set auto_index(tk_bindForTraversal) [list source [file join $dir obsolete.tcl]]\n"
"set auto_index(tk_focusNext) [list source [file join $dir focus.tcl]]\n"
"set auto_index(tk_focusPrev) [list source [file join $dir focus.tcl]]\n"
"set auto_index(tkFocusOK) [list source [file join $dir focus.tcl]]\n"
"set auto_index(tk_focusFollowsMouse) [list source [file join $dir focus.tcl]]\n"
"set auto_index(tkConsoleInit) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleSource) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleInvoke) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleHistory) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsolePrompt) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleBind) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleInsert) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleOutput) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleExit) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleAbout) [list source [file join $dir console.tcl]]\n"
"set auto_index(tk_setPalette) [list source [file join $dir palette.tcl]]\n"
"set auto_index(tkRecolorTree) [list source [file join $dir palette.tcl]]\n"
"set auto_index(tkDarken) [list source [file join $dir palette.tcl]]\n"
"set auto_index(tk_bisque) [list source [file join $dir palette.tcl]]\n"
"set auto_index(tkColorDialog) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_InitValues) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_Config) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_BuildDialog) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_SetRGBValue) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_XToRgb) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_RgbToX) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_DrawColorScale) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_CreateSelector) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_RedrawFinalColor) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_RedrawColorBars) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_StartMove) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_MoveSelector) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_ReleaseMouse) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_ResizeColorBars) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_HandleSelEntry) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_HandleRGBEntry) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_EnterColorBar) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_LeaveColorBar) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_OkCmd) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_CancelCmd) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tclParseConfigSpec) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tclListValidFlags) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tclSortNoCase) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tclVerifyInteger) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_Create) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_BindIn) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_BindOut) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_Destroy) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_In) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_Out) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFDGetFileTypes) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(::safe::loadTk) [list source [file join $dir safetk.tcl]]\n"
"set auto_index(::safe::TkInit) [list source [file join $dir safetk.tcl]]\n"
"set auto_index(::safe::allowTk) [list source [file join $dir safetk.tcl]]\n"
"set auto_index(::safe::tkTopLevel) [list source [file join $dir safetk.tcl]]\n"
"set auto_index(tkMessageBox) [list source [file join $dir msgbox.tcl]]\n"
"set auto_index(tkIconList) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Config) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Create) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_AutoScan) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_DeleteAll) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Add) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Arrange) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Invoke) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_See) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_SelectAtXY) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Select) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Unselect) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Get) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Btn1) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Motion1) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Double1) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_ReturnKey) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Leave1) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_FocusIn) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_UpDown) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_LeftRight) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_KeyPress) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Goto) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Reset) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_Config) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_Create) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_UpdateWhenIdle) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_Update) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_SetPathSilently) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_SetPath) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_SetFilter) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialogResolveFile) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_EntFocusIn) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_EntFocusOut) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_ActivateEnt) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_InvokeBtn) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_UpDirCmd) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_JoinFile) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_OkCmd) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_CancelCmd) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_ListBrowse) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_ListInvoke) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_Done) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkMotifFDialog) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_Config) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_Create) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_MakeSList) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_BrowseDList) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_ActivateDList) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_BrowseFList) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_ActivateFList) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_ActivateFEnt) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_InterpFilter) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_ActivateSEnt) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_OkCmd) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_FilterCmd) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_CancelCmd) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_Update) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_LoadFiles) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkListBoxKeyAccel_Set) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkListBoxKeyAccel_Unset) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkListBoxKeyAccel_Key) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkListBoxKeyAccel_Goto) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkListBoxKeyAccel_Reset) [list source [file join $dir xmfbox.tcl]]\n"
;
struct EtFile {
char *zName;
char *zData;
int nData;
int shrouded;
struct EtFile *pNext;
};
static struct EtFile Et_FileSet[] = {
{ "C:/cygwin/usr/share/tcl8.0/tclIndex", Et_zFile0, sizeof(Et_zFile0)-1, 0, 0 },
{ "C:/cygwin/usr/share/tk8.0/tclIndex", Et_zFile1, sizeof(Et_zFile1)-1, 0, 0 },
{0, 0}};
static struct EtFile *Et_FileHashTable[71];
/* The following copyright notice applies to code generated by
** "mktclapp". The "mktclapp" program itself is covered by the
** GNU Public License.
**
** Copyright (c) 1998 D. Richard Hipp
**
** The author hereby grants permission to use, copy, modify, distribute,
** and license this software and its documentation for any purpose, provided
** that existing copyright notices are retained in all copies and that this
** notice is included verbatim in any distributions. No written agreement,
** license, or royalty fee is required for any of the authorized uses.
** Modifications to this software may be copyrighted by their authors
** and need not follow the licensing terms described here, provided that
** the new terms are clearly indicated on the first page of each file where
** they apply.
**
** In no event shall the author or the distributors be liable to any party
** for direct, indirect, special, incidental, or consequential damages
** arising out of the use of this software, its documentation, or any
** derivatives thereof, even if the author has been advised of the
** possibility of such damage. The author and distributors specifically
** disclaim any warranties, including but not limited to the implied
** warranties of merchantability, fitness for a particular purpose, and
** non-infringment. This software is provided at no fee on an
** "as is" basis. The author and/or distritutors have no obligation
** to provide maintenance, support, updates, enhancements and/or
** modifications.
**
** GOVERNMENT USE: If you are acquiring this software on behalf of the
** U.S. government, the Government shall have only "Restricted Rights"
** in the software and related documentation as defined in the Federal
** Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
** are acquiring the software on behalf of the Department of Defense, the
** software shall be classified as "Commercial Computer Software" and the
** Government shall have only "Restricted Rights" as defined in Clause
** 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
** author grants the U.S. Government and others acting in its behalf
** permission to use and distribute the software in accordance with the
** terms specified in this license.
*/
#include <ctype.h>
#include <string.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
/* Include either the Tcl or the Tk header file. Use the "Internal"
** version of the header file if and only if we are generating an
** extension that is linking against the Stub library.
** Many installations do not have the internal header files
** available, so using the internal headers only when absolutely
** necessary will help to reduce compilation problems.
*/
#if ET_EXTENSION && defined(TCL_USE_STUBS)
# if ET_ENABLE_TK
# include <tkInt.h>
# else
# include <tclInt.h>
# endif
#else
# if ET_ENABLE_TK
# include <tk.h>
# else
# include <tcl.h>
# endif
#endif
/*
** ET_WIN32 is true if we are running Tk under windows. The
** <tcl.h> module will define __WIN32__ for us if we are compiling
** for windows.
*/
#if defined(__WIN32__) && ET_ENABLE_TK
# define ET_WIN32 1
# include <windows.h>
#else
# define ET_WIN32 0
#endif
/*
** Always disable ET_AUTO_FORK under windows. Windows doesn't
** fork well.
*/
#if defined(__WIN32__)
# undef ET_AUTO_FORK
# define ET_AUTO_FORK 0
#endif
/*
** Omit <unistd.h> under windows. But we need it for Unix.
*/
#if !defined(__WIN32__)
# include <unistd.h>
#endif
/*
** The Tcl*InsertProc functions allow the system calls "stat",
** "access" and "open" to be overloaded. This in turns allows us
** to substituted compiled-in strings for files in the filesystem.
** But the Tcl*InsertProc functions are only available in Tcl8.0.3
** and later.
**
** Define the ET_HAVE_INSERTPROC macro if and only if we are dealing
** with Tcl8.0.3 or later.
*/
#if TCL_MAJOR_VERSION==8 && (TCL_MINOR_VERSION>0 || TCL_RELEASE_SERIAL>=3)
# define ET_HAVE_INSERTPROC
#endif
/*
** If we are using the Tcl*InsertProc() functions, we should provide
** prototypes for them. But the prototypes are in the tclInt.h include
** file, which we don't want to require the user to have on hand. So
** we provide our own prototypes here.
**
** Note that if TCL_USE_STUBS is defined, then the tclInt.h is required
** anyway, so these prototypes are not included if TCL_USE_STUBS is
** defined.
*/
#if defined(ET_HAVE_INSERTPROC) && !defined(TCL_USE_STUBS)
#ifdef __cplusplus
extern "C" int TclStatInsertProc(int (*)(char*, struct stat *));
extern "C" int TclAccessInsertProc(int (*)(char*, int));
extern "C" int TclOpenFileChannelInsertProc(Tcl_Channel (*)(Tcl_Interp*,char*,
char*,int));
#else
extern int TclStatInsertProc(int (*)(char*, struct stat *));
extern int TclAccessInsertProc(int (*)(char*, int));
extern int TclOpenFileChannelInsertProc(Tcl_Channel (*)(Tcl_Interp*,char*,
char*,int));
#endif
#endif
/*
** Don't allow Win32 applications to read from stdin. Nor
** programs that automatically go into the background. Force
** the use of a console in these cases.
*/
#if (ET_WIN32 || ET_AUTO_FORK) && ET_READ_STDIN
# undef ET_READ_STDIN
# undef ET_CONSOLE
# define ET_READ_STDIN 0
# define ET_CONSOLE 1
#endif
/*
** The console won't work without Tk.
*/
#if ET_ENABLE_TK==0 && ET_CONSOLE
# undef ET_CONSOLE
# define ET_CONSOLE 0
# undef ET_READ_STDIN
# define ET_READ_STDIN 1
#endif
/*
** Set ET_HAVE_OBJ to true if we are able to link against the
** new Tcl_Obj interface. This is only the case for Tcl version
** 8.0 and later.
*/
#if ET_ENABLE_OBJ || TCL_MAJOR_VERSION>=8
# define ET_HAVE_OBJ 1
#else
# define ET_HAVE_OBJ 0
#endif
/*
** The Tcl_GetByteArrayFromObj() only appears in Tcl version 8.1
** and later. Substitute Tcl_GetStringFromObj() in Tcl version 8.0.X
*/
#if ET_HAVE_OBJ && TCL_MINOR_VERSION==0
# define Tcl_GetByteArrayFromObj Tcl_GetStringFromObj
#endif
/*
** Tcl code to implement the console.
**
** This code is written and tested separately, then run through
** "mktclapp -stringify" and then pasted in here.
*/
#if ET_ENABLE_TK && !ET_EXTENSION
static char zEtConsole[] =
"proc console:create {w prompt title} {\n"
"upvar #0 $w.t v\n"
"if {[winfo exists $w]} {destroy $w}\n"
"catch {unset v}\n"
"toplevel $w\n"
"wm title $w $title\n"
"wm iconname $w $title\n"
"frame $w.mb -bd 2 -relief raised\n"
"pack $w.mb -side top -fill x\n"
"menubutton $w.mb.file -text File -menu $w.mb.file.m\n"
"menubutton $w.mb.edit -text Edit -menu $w.mb.edit.m\n"
"pack $w.mb.file $w.mb.edit -side left -padx 8 -pady 1\n"
"set m [menu $w.mb.file.m]\n"
"$m add command -label {Source...} -command \"console:SourceFile $w.t\"\n"
"$m add command -label {Save As...} -command \"console:SaveFile $w.t\"\n"
"$m add separator\n"
"$m add command -label {Close} -command \"destroy $w\"\n"
"$m add command -label {Exit} -command exit\n"
"set m [menu $w.mb.edit.m]\n"
"$m add command -label Cut -command \"console:Cut $w.t\"\n"
"$m add command -label Copy -command \"console:Copy $w.t\"\n"
"$m add command -label Paste -command \"console:Paste $w.t\"\n"
"$m add command -label {Clear Screen} -command \"console:Clear $w.t\"\n"
"catch {$m config -postcommand \"console:EnableEditMenu $w\"}\n"
"scrollbar $w.sb -orient vertical -command \"$w.t yview\"\n"
"pack $w.sb -side right -fill y\n"
"text $w.t -font fixed -yscrollcommand \"$w.sb set\"\n"
"pack $w.t -side right -fill both -expand 1\n"
"bindtags $w.t Console\n"
"set v(text) $w.t\n"
"set v(history) 0\n"
"set v(historycnt) 0\n"
"set v(current) -1\n"
"set v(prompt) $prompt\n"
"set v(prior) {}\n"
"set v(plength) [string length $v(prompt)]\n"
"set v(x) 0\n"
"set v(y) 0\n"
"$w.t mark set insert end\n"
"$w.t tag config ok -foreground blue\n"
"$w.t tag config err -foreground red\n"
"$w.t insert end $v(prompt)\n"
"$w.t mark set out 1.0\n"
"catch {rename puts console:oldputs$w}\n"
"proc puts args [format {\n"
"if {![winfo exists %s]} {\n"
"rename puts {}\n"
"rename console:oldputs%s puts\n"
"return [uplevel #0 puts $args]\n"
"}\n"
"switch -glob -- \"[llength $args] $args\" {\n"
"{1 *} {\n"
"set msg [lindex $args 0]\\n\n"
"set tag ok\n"
"}\n"
"{2 stdout *} {\n"
"set msg [lindex $args 1]\\n\n"
"set tag ok\n"
"}\n"
"{2 stderr *} {\n"
"set msg [lindex $args 1]\\n\n"
"set tag err\n"
"}\n"
"{2 -nonewline *} {\n"
"set msg [lindex $args 1]\n"
"set tag ok\n"
"}\n"
"{3 -nonewline stdout *} {\n"
"set msg [lindex $args 2]\n"
"set tag ok\n"
"}\n"
"{3 -nonewline stderr *} {\n"
"set msg [lindex $args 2]\n"
"set tag err\n"
"}\n"
"default {\n"
"uplevel #0 console:oldputs%s $args\n"
"return\n"
"}\n"
"}\n"
"console:Puts %s $msg $tag\n"
"} $w $w $w $w.t]\n"
"after idle \"focus $w.t\"\n"
"}\n"
"bind Console <1> {console:Button1 %W %x %y}\n"
"bind Console <B1-Motion> {console:B1Motion %W %x %y}\n"
"bind Console <B1-Leave> {console:B1Leave %W %x %y}\n"
"bind Console <B1-Enter> {console:cancelMotor %W}\n"
"bind Console <ButtonRelease-1> {console:cancelMotor %W}\n"
"bind Console <KeyPress> {console:Insert %W %A}\n"
"bind Console <Left> {console:Left %W}\n"
"bind Console <Control-b> {console:Left %W}\n"
"bind Console <Right> {console:Right %W}\n"
"bind Console <Control-f> {console:Right %W}\n"
"bind Console <BackSpace> {console:Backspace %W}\n"
"bind Console <Control-h> {console:Backspace %W}\n"
"bind Console <Delete> {console:Delete %W}\n"
"bind Console <Control-d> {console:Delete %W}\n"
"bind Console <Home> {console:Home %W}\n"
"bind Console <Control-a> {console:Home %W}\n"
"bind Console <End> {console:End %W}\n"
"bind Console <Control-e> {console:End %W}\n"
"bind Console <Return> {console:Enter %W}\n"
"bind Console <KP_Enter> {console:Enter %W}\n"
"bind Console <Up> {console:Prior %W}\n"
"bind Console <Control-p> {console:Prior %W}\n"
"bind Console <Down> {console:Next %W}\n"
"bind Console <Control-n> {console:Next %W}\n"
"bind Console <Control-k> {console:EraseEOL %W}\n"
"bind Console <<Cut>> {console:Cut %W}\n"
"bind Console <<Copy>> {console:Copy %W}\n"
"bind Console <<Paste>> {console:Paste %W}\n"
"bind Console <<Clear>> {console:Clear %W}\n"
"proc console:Puts {w t tag} {\n"
"set nc [string length $t]\n"
"set endc [string index $t [expr $nc-1]]\n"
"if {$endc==\"\\n\"} {\n"
"if {[$w index out]<[$w index {insert linestart}]} {\n"
"$w insert out [string range $t 0 [expr $nc-2]] $tag\n"
"$w mark set out {out linestart +1 lines}\n"
"} else {\n"
"$w insert out $t $tag\n"
"}\n"
"} else {\n"
"if {[$w index out]<[$w index {insert linestart}]} {\n"
"$w insert out $t $tag\n"
"} else {\n"
"$w insert out $t\\n $tag\n"
"$w mark set out {out -1 char}\n"
"}\n"
"}\n"
"$w yview insert\n"
"}\n"
"proc console:Insert {w a} {\n"
"$w insert insert $a\n"
"$w yview insert\n"
"}\n"
"proc console:Left {w} {\n"
"upvar #0 $w v\n"
"scan [$w index insert] %d.%d row col\n"
"if {$col>$v(plength)} {\n"
"$w mark set insert \"insert -1c\"\n"
"}\n"
"}\n"
"proc console:Backspace {w} {\n"
"upvar #0 $w v\n"
"scan [$w index insert] %d.%d row col\n"
"if {$col>$v(plength)} {\n"
"$w delete {insert -1c}\n"
"}\n"
"}\n"
"proc console:EraseEOL {w} {\n"
"upvar #0 $w v\n"
"scan [$w index insert] %d.%d row col\n"
"if {$col>=$v(plength)} {\n"
"$w delete insert {insert lineend}\n"
"}\n"
"}\n"
"proc console:Right {w} {\n"
"$w mark set insert \"insert +1c\"\n"
"}\n"
"proc console:Delete w {\n"
"$w delete insert\n"
"}\n"
"proc console:Home w {\n"
"upvar #0 $w v\n"
"scan [$w index insert] %d.%d row col\n"
"$w mark set insert $row.$v(plength)\n"
"}\n"
"proc console:End w {\n"
"$w mark set insert {insert lineend}\n"
"}\n"
"proc console:Enter w {\n"
"upvar #0 $w v\n"
"scan [$w index insert] %d.%d row col\n"
"set start $row.$v(plength)\n"
"set line [$w get $start \"$start lineend\"]\n"
"if {$v(historycnt)>0} {\n"
"set last [lindex $v(history) [expr $v(historycnt)-1]]\n"
"if {[string compare $last $line]} {\n"
"lappend v(history) $line\n"
"incr v(historycnt)\n"
"}\n"
"} else {\n"
"set v(history) [list $line]\n"
"set v(historycnt) 1\n"
"}\n"
"set v(current) $v(historycnt)\n"
"$w insert end \\n\n"
"$w mark set out end\n"
"if {$v(prior)==\"\"} {\n"
"set cmd $line\n"
"} else {\n"
"set cmd $v(prior)\\n$line\n"
"}\n"
"if {[info complete $cmd]} {\n"
"set rc [catch {uplevel #0 $cmd} res]\n"
"if {![winfo exists $w]} return\n"
"if {$rc} {\n"
"$w insert end $res\\n err\n"
"} elseif {[string length $res]>0} {\n"
"$w insert end $res\\n ok\n"
"}\n"
"set v(prior) {}\n"
"$w insert end $v(prompt)\n"
"} else {\n"
"set v(prior) $cmd\n"
"regsub -all {[^ ]} $v(prompt) . x\n"
"$w insert end $x\n"
"}\n"
"$w mark set insert end\n"
"$w mark set out {insert linestart}\n"
"$w yview insert\n"
"}\n"
"proc console:Prior w {\n"
"upvar #0 $w v\n"
"if {$v(current)<=0} return\n"
"incr v(current) -1\n"
"set line [lindex $v(history) $v(current)]\n"
"console:SetLine $w $line\n"
"}\n"
"proc console:Next w {\n"
"upvar #0 $w v\n"
"if {$v(current)>=$v(historycnt)} return\n"
"incr v(current) 1\n"
"set line [lindex $v(history) $v(current)]\n"
"console:SetLine $w $line\n"
"}\n"
"proc console:SetLine {w line} {\n"
"upvar #0 $w v\n"
"scan [$w index insert] %d.%d row col\n"
"set start $row.$v(plength)\n"
"$w delete $start end\n"
"$w insert end $line\n"
"$w mark set insert end\n"
"$w yview insert\n"
"}\n"
"proc console:Button1 {w x y} {\n"
"global tkPriv\n"
"upvar #0 $w v\n"
"set v(mouseMoved) 0\n"
"set v(pressX) $x\n"
"set p [console:nearestBoundry $w $x $y]\n"
"scan [$w index insert] %d.%d ix iy\n"
"scan $p %d.%d px py\n"
"if {$px==$ix} {\n"
"$w mark set insert $p\n"
"}\n"
"$w mark set anchor $p\n"
"focus $w\n"
"}\n"
"proc console:nearestBoundry {w x y} {\n"
"set p [$w index @$x,$y]\n"
"set bb [$w bbox $p]\n"
"if {![string compare $bb \"\"]} {return $p}\n"
"if {($x-[lindex $bb 0])<([lindex $bb 2]/2)} {return $p}\n"
"$w index \"$p + 1 char\"\n"
"}\n"
"proc console:SelectTo {w x y} {\n"
"upvar #0 $w v\n"
"set cur [console:nearestBoundry $w $x $y]\n"
"if {[catch {$w index anchor}]} {\n"
"$w mark set anchor $cur\n"
"}\n"
"set anchor [$w index anchor]\n"
"if {[$w compare $cur != $anchor] || (abs($v(pressX) - $x) >= 3)} {\n"
"if {$v(mouseMoved)==0} {\n"
"$w tag remove sel 0.0 end\n"
"}\n"
"set v(mouseMoved) 1\n"
"}\n"
"if {[$w compare $cur < anchor]} {\n"
"set first $cur\n"
"set last anchor\n"
"} else {\n"
"set first anchor\n"
"set last $cur\n"
"}\n"
"if {$v(mouseMoved)} {\n"
"$w tag remove sel 0.0 $first\n"
"$w tag add sel $first $last\n"
"$w tag remove sel $last end\n"
"update idletasks\n"
"}\n"
"}\n"
"proc console:B1Motion {w x y} {\n"
"upvar #0 $w v\n"
"set v(y) $y\n"
"set v(x) $x\n"
"console:SelectTo $w $x $y\n"
"}\n"
"proc console:B1Leave {w x y} {\n"
"upvar #0 $w v\n"
"set v(y) $y\n"
"set v(x) $x\n"
"console:motor $w\n"
"}\n"
"proc console:motor w {\n"
"upvar #0 $w v\n"
"if {![winfo exists $w]} return\n"
"if {$v(y)>=[winfo height $w]} {\n"
"$w yview scroll 1 units\n"
"} elseif {$v(y)<0} {\n"
"$w yview scroll -1 units\n"
"} else {\n"
"return\n"
"}\n"
"console:SelectTo $w $v(x) $v(y)\n"
"set v(timer) [after 50 console:motor $w]\n"
"}\n"
"proc console:cancelMotor w {\n"
"upvar #0 $w v\n"
"catch {after cancel $v(timer)}\n"
"catch {unset v(timer)}\n"
"}\n"
"proc console:Copy w {\n"
"if {![catch {set text [$w get sel.first sel.last]}]} {\n"
"clipboard clear -displayof $w\n"
"clipboard append -displayof $w $text\n"
"}\n"
"}\n"
"proc console:canCut w {\n"
"set r [catch {\n"
"scan [$w index sel.first] %d.%d s1x s1y\n"
"scan [$w index sel.last] %d.%d s2x s2y\n"
"scan [$w index insert] %d.%d ix iy\n"
"}]\n"
"if {$r==1} {return 0}\n"
"if {$s1x==$ix && $s2x==$ix} {return 1}\n"
"return 2\n"
"}\n"
"proc console:Cut w {\n"
"if {[console:canCut $w]==1} {\n"
"console:Copy $w\n"
"$w delete sel.first sel.last\n"
"}\n"
"}\n"
"proc console:Paste w {\n"
"if {[console:canCut $w]==1} {\n"
"$w delete sel.first sel.last\n"
"}\n"
"if {[catch {selection get -displayof $w -selection CLIPBOARD} topaste]} {\n"
"return\n"
"}\n"
"set prior 0\n"
"foreach line [split $topaste \\n] {\n"
"if {$prior} {\n"
"console:Enter $w\n"
"update\n"
"}\n"
"set prior 1\n"
"$w insert insert $line\n"
"}\n"
"}\n"
"proc console:EnableEditMenu w {\n"
"set m $w.mb.edit.m\n"
"switch [console:canCut $w.t] {\n"
"0 {\n"
"$m entryconf Copy -state disabled\n"
"$m entryconf Cut -state disabled\n"
"}\n"
"1 {\n"
"$m entryconf Copy -state normal\n"
"$m entryconf Cut -state normal\n"
"}\n"
"2 {\n"
"$m entryconf Copy -state normal\n"
"$m entryconf Cut -state disabled\n"
"}\n"
"}\n"
"}\n"
"proc console:SourceFile w {\n"
"set types {\n"
"{{TCL Scripts} {.tcl}}\n"
"{{All Files} *}\n"
"}\n"
"set f [tk_getOpenFile -filetypes $types -title \"TCL Script To Source...\"]\n"
"if {$f!=\"\"} {\n"
"uplevel #0 source $f\n"
"}\n"
"}\n"
"proc console:SaveFile w {\n"
"set types {\n"
"{{Text Files} {.txt}}\n"
"{{All Files} *}\n"
"}\n"
"set f [tk_getSaveFile -filetypes $types -title \"Write Screen To...\"]\n"
"if {$f!=\"\"} {\n"
"if {[catch {open $f w} fd]} {\n"
"tk_messageBox -type ok -icon error -message $fd\n"
"} else {\n"
"puts $fd [string trimright [$w get 1.0 end] \\n]\n"
"close $fd\n"
"}\n"
"}\n"
"}\n"
"proc console:Clear w {\n"
"$w delete 1.0 {insert linestart}\n"
"}\n"
; /* End of the console code */
#endif /* ET_ENABLE_TK */
/*
** The "printf" code that follows dates from the 1980's. It is in
** the public domain. The original comments are included here for
** completeness. They are slightly out-of-date.
**
** The following modules is an enhanced replacement for the "printf" programs
** found in the standard library. The following enhancements are
** supported:
**
** + Additional functions. The standard set of "printf" functions
** includes printf, fprintf, sprintf, vprintf, vfprintf, and
** vsprintf. This module adds the following:
**
** * snprintf -- Works like sprintf, but has an extra argument
** which is the size of the buffer written to.
**
** * mprintf -- Similar to sprintf. Writes output to memory
** obtained from malloc.
**
** * xprintf -- Calls a function to dispose of output.
**
** * nprintf -- No output, but returns the number of characters
** that would have been output by printf.
**
** * A v- version (ex: vsnprintf) of every function is also
** supplied.
**
** + A few extensions to the formatting notation are supported:
**
** * The "=" flag (similar to "-") causes the output to be
** be centered in the appropriately sized field.
**
** * The %b field outputs an integer in binary notation.
**
** * The %c field now accepts a precision. The character output
** is repeated by the number of times the precision specifies.
**
** * The %' field works like %c, but takes as its character the
** next character of the format string, instead of the next
** argument. For example, printf("%.78'-") prints 78 minus
** signs, the same as printf("%.78c",'-').
**
** + When compiled using GCC on a SPARC, this version of printf is
** faster than the library printf for SUN OS 4.1.
**
** + All functions are fully reentrant.
**
*/
/*
** Undefine COMPATIBILITY to make some slight changes in the way things
** work. I think the changes are an improvement, but they are not
** backwards compatible.
*/
/* #define COMPATIBILITY / * Compatible with SUN OS 4.1 */
/*
** Characters that need to be escaped inside a TCL string.
*/
static char NeedEsc[] = {
1, 1, 1, 1, 1, 1, 1, 1, 'b', 't', 'n', 1, 'f', 'r', 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
0, 0, '"', 0, '$', 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, '[','\\', ']', 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
};
/*
** Conversion types fall into various categories as defined by the
** following enumeration.
*/
enum et_type { /* The type of the format field */
etRADIX, /* Integer types. %d, %x, %o, and so forth */
etFLOAT, /* Floating point. %f */
etEXP, /* Exponentional notation. %e and %E */
etGENERIC, /* Floating or exponential, depending on exponent. %g */
etSIZE, /* Return number of characters processed so far. %n */
etSTRING, /* Strings. %s */
etPERCENT, /* Percent symbol. %% */
etCHARX, /* Characters. %c */
etERROR, /* Used to indicate no such conversion type */
/* The rest are extensions, not normally found in printf() */
etCHARLIT, /* Literal characters. %' */
etTCLESCAPE, /* Strings with special characters escaped. %q */
etMEMSTRING, /* A string which should be deleted after use. %z */
etORDINAL /* 1st, 2nd, 3rd and so forth */
};
/*
** Each builtin conversion character (ex: the 'd' in "%d") is described
** by an instance of the following structure
*/
typedef struct et_info { /* Information about each format field */
int fmttype; /* The format field code letter */
int base; /* The base for radix conversion */
char *charset; /* The character set for conversion */
int flag_signed; /* Is the quantity signed? */
char *prefix; /* Prefix on non-zero values in alt format */
enum et_type type; /* Conversion paradigm */
} et_info;
/*
** The following table is searched linearly, so it is good to put the
** most frequently used conversion types first.
*/
static et_info fmtinfo[] = {
{ 'd', 10, "0123456789", 1, 0, etRADIX, },
{ 's', 0, 0, 0, 0, etSTRING, },
{ 'q', 0, 0, 0, 0, etTCLESCAPE, },
{ 'z', 0, 0, 0, 0, etMEMSTRING, },
{ 'c', 0, 0, 0, 0, etCHARX, },
{ 'o', 8, "01234567", 0, "0", etRADIX, },
{ 'u', 10, "0123456789", 0, 0, etRADIX, },
{ 'x', 16, "0123456789abcdef", 0, "x0", etRADIX, },
{ 'X', 16, "0123456789ABCDEF", 0, "X0", etRADIX, },
{ 'r', 10, "0123456789", 0, 0, etORDINAL, },
{ 'f', 0, 0, 1, 0, etFLOAT, },
{ 'e', 0, "e", 1, 0, etEXP, },
{ 'E', 0, "E", 1, 0, etEXP, },
{ 'g', 0, "e", 1, 0, etGENERIC, },
{ 'G', 0, "E", 1, 0, etGENERIC, },
{ 'i', 10, "0123456789", 1, 0, etRADIX, },
{ 'n', 0, 0, 0, 0, etSIZE, },
{ '%', 0, 0, 0, 0, etPERCENT, },
{ 'b', 2, "01", 0, "b0", etRADIX, }, /* Binary */
{ 'p', 10, "0123456789", 0, 0, etRADIX, }, /* Pointers */
{ '\'', 0, 0, 0, 0, etCHARLIT, }, /* Literal char */
};
#define etNINFO (sizeof(fmtinfo)/sizeof(fmtinfo[0]))
/*
** If NOFLOATINGPOINT is defined, then none of the floating point
** conversions will work.
*/
#ifndef etNOFLOATINGPOINT
/*
** "*val" is a double such that 0.1 <= *val < 10.0
** Return the ascii code for the leading digit of *val, then
** multiply "*val" by 10.0 to renormalize.
**
** Example:
** input: *val = 3.14159
** output: *val = 1.4159 function return = '3'
**
** The counter *cnt is incremented each time. After counter exceeds
** 16 (the number of significant digits in a 64-bit float) '0' is
** always returned.
*/
static int et_getdigit(double *val, int *cnt){
int digit;
double d;
if( (*cnt)++ >= 16 ) return '0';
digit = (int)*val;
d = digit;
digit += '0';
*val = (*val - d)*10.0;
return digit;
}
#endif
#define etBUFSIZE 1000 /* Size of the output buffer */
/*
** The root program. All variations call this core.
**
** INPUTS:
** func This is a pointer to a function taking three arguments
** 1. A pointer to anything. Same as the "arg" parameter.
** 2. A pointer to the list of characters to be output
** (Note, this list is NOT null terminated.)
** 3. An integer number of characters to be output.
** (Note: This number might be zero.)
**
** arg This is the pointer to anything which will be passed as the
** first argument to "func". Use it for whatever you like.
**
** fmt This is the format string, as in the usual print.
**
** ap This is a pointer to a list of arguments. Same as in
** vfprint.
**
** OUTPUTS:
** The return value is the total number of characters sent to
** the function "func". Returns -1 on a error.
**
** Note that the order in which automatic variables are declared below
** seems to make a big difference in determining how fast this beast
** will run.
*/
int vxprintf(
void (*func)(void*,char*,int),
void *arg,
const char *format,
va_list ap
){
register const char *fmt; /* The format string. */
register int c; /* Next character in the format string */
register char *bufpt; /* Pointer to the conversion buffer */
register int precision; /* Precision of the current field */
register int length; /* Length of the field */
register int idx; /* A general purpose loop counter */
int count; /* Total number of characters output */
int width; /* Width of the current field */
int flag_leftjustify; /* True if "-" flag is present */
int flag_plussign; /* True if "+" flag is present */
int flag_blanksign; /* True if " " flag is present */
int flag_alternateform; /* True if "#" flag is present */
int flag_zeropad; /* True if field width constant starts with zero */
int flag_long; /* True if "l" flag is present */
int flag_center; /* True if "=" flag is present */
unsigned long longvalue; /* Value for integer types */
double realvalue; /* Value for real types */
et_info *infop; /* Pointer to the appropriate info structure */
char buf[etBUFSIZE]; /* Conversion buffer */
char prefix; /* Prefix character. "+" or "-" or " " or '\0'. */
int errorflag = 0; /* True if an error is encountered */
enum et_type xtype; /* Conversion paradigm */
char *zMem; /* String to be freed */
char *zExtra; /* Extra memory used for etTCLESCAPE conversions */
static char spaces[] = " "
" ";
#define etSPACESIZE (sizeof(spaces)-1)
#ifndef etNOFLOATINGPOINT
int exp; /* exponent of real numbers */ double rounder; /* Used for rounding floating point values */
int flag_dp; /* True if decimal point should be shown */
int flag_rtz; /* True if trailing zeros should be removed */
int flag_exp; /* True to force display of the exponent */
int nsd; /* Number of significant digits returned */
#endif
fmt = format; /* Put in a register for speed */
count = length = 0;
bufpt = 0;
for(; (c=(*fmt))!=0; ++fmt){
if( c!='%' ){
register int amt;
bufpt = (char *)fmt;
amt = 1;
while( (c=(*++fmt))!='%' && c!=0 ) amt++;
(*func)(arg,bufpt,amt);
count += amt;
if( c==0 ) break;
}
if( (c=(*++fmt))==0 ){
errorflag = 1;
(*func)(arg,"%",1);
count++;
break;
}
/* Find out what flags are present */
flag_leftjustify = flag_plussign = flag_blanksign =
flag_alternateform = flag_zeropad = flag_center = 0;
do{
switch( c ){
case '-': flag_leftjustify = 1; c = 0; break;
case '+': flag_plussign = 1; c = 0; break;
case ' ': flag_blanksign = 1; c = 0; break;
case '#': flag_alternateform = 1; c = 0; break;
case '0': flag_zeropad = 1; c = 0; break;
case '=': flag_center = 1; c = 0; break;
default: break;
}
}while( c==0 && (c=(*++fmt))!=0 );
if( flag_center ) flag_leftjustify = 0;
/* Get the field width */
width = 0;
if( c=='*' ){
if( width<0 ){
flag_leftjustify = 1;
width = -width;
}
c = *++fmt;
}else{
width = width*10 + c - '0';
c = *++fmt;
}
}
if( width > etBUFSIZE-10 ){
width = etBUFSIZE-10;
}
/* Get the precision */
if( c=='.' ){
precision = 0;
c = *++fmt;
if( c=='*' ){
#ifndef etCOMPATIBILITY
/* This is sensible, but SUN OS 4.1 doesn't do it. */
if( precision<0 ) precision = -precision;
#endif
c = *++fmt;
}else{
precision = precision*10 + c - '0';
c = *++fmt;
}
}
/* Limit the precision to prevent overflowing buf[] during conversion */
if( precision>etBUFSIZE-40 ) precision = etBUFSIZE-40;
}else{
precision = -1;
}
/* Get the conversion type modifier */
if( c=='l' ){
flag_long = 1;
c = *++fmt;
}else{
flag_long = 0;
}
/* Fetch the info entry for the field */
infop = 0;
for(idx=0; idx<etNINFO; idx++){
if( c==fmtinfo[idx].fmttype ){
infop = &fmtinfo[idx];
break;
}
}
/* No info entry found. It must be an error. */
if( infop==0 ){
xtype = etERROR;
}else{
xtype = infop->type;
}
zExtra = 0;
/*
** At this point, variables are initialized as follows:
**
** flag_alternateform TRUE if a '#' is present.
** flag_plussign TRUE if a '+' is present.
** flag_leftjustify TRUE if a '-' is present or if the
** field width was negative.
** flag_zeropad TRUE if the width began with 0.
** flag_long TRUE if the letter 'l' (ell) prefixed
** the conversion character.
** flag_blanksign TRUE if a ' ' is present.
** width The specified field width. This is
** always non-negative. Zero is the default.
** precision The specified precision. The default
** is -1.
** xtype The class of the conversion.
** infop Pointer to the appropriate info struct.
*/
switch( xtype ){
case etORDINAL:
case etRADIX:
if( flag_long
) longvalue
= va_arg(ap
,long); else longvalue
= va_arg(ap
,int); #ifdef etCOMPATIBILITY
/* For the format %#x, the value zero is printed "0" not "0x0".
** I think this is stupid. */
if( longvalue==0 ) flag_alternateform = 0;
#else
/* More sensible: turn off the prefix for octal (to prevent "00"),
** but leave the prefix for hex. */
if( longvalue==0 && infop->base==8 ) flag_alternateform = 0;
#endif
if( infop->flag_signed ){
if( *(long*)&longvalue<0 ){
longvalue = -*(long*)&longvalue;
prefix = '-';
}else if( flag_plussign ) prefix = '+';
else if( flag_blanksign ) prefix = ' ';
else prefix = 0;
}else prefix = 0;
if( flag_zeropad && precision<width-(prefix!=0) ){
precision = width-(prefix!=0);
}
bufpt = &buf[etBUFSIZE];
if( xtype==etORDINAL ){
long a,b;
a = longvalue%10;
b = longvalue%100;
bufpt -= 2;
if( a==0 || a>3 || (b>10 && b<14) ){
bufpt[0] = 't';
bufpt[1] = 'h';
}else if( a==1 ){
bufpt[0] = 's';
bufpt[1] = 't';
}else if( a==2 ){
bufpt[0] = 'n';
bufpt[1] = 'd';
}else if( a==3 ){
bufpt[0] = 'r';
bufpt[1] = 'd';
}
}
{
register char *cset; /* Use registers for speed */
register int base;
cset = infop->charset;
base = infop->base;
do{ /* Convert to ascii */
*(--bufpt) = cset[longvalue%base];
longvalue = longvalue/base;
}while( longvalue>0 );
}
length = (long)&buf[etBUFSIZE]-(long)bufpt;
for(idx=precision-length; idx>0; idx--){
*(--bufpt) = '0'; /* Zero pad */
}
if( prefix ) *(--bufpt) = prefix; /* Add sign */
if( flag_alternateform && infop->prefix ){ /* Add "0" or "0x" */
char *pre, x;
pre = infop->prefix;
if( *bufpt!=pre[0] ){
for(pre=infop->prefix; (x=(*pre))!=0; pre++) *(--bufpt) = x;
}
}
length = (long)&buf[etBUFSIZE]-(long)bufpt;
break;
case etFLOAT:
case etEXP:
case etGENERIC:
realvalue
= va_arg(ap
,double);#ifndef etNOFLOATINGPOINT
if( precision<0 ) precision = 6; /* Set default precision */
if( precision>etBUFSIZE-10 ) precision = etBUFSIZE-10;
if( realvalue<0.0 ){
realvalue = -realvalue;
prefix = '-';
}else{
if( flag_plussign ) prefix = '+';
else if( flag_blanksign ) prefix = ' ';
else prefix = 0;
}
if( infop->type==etGENERIC && precision>0 ) precision--;
rounder = 0.0;
#ifdef COMPATIBILITY
/* Rounding works like BSD when the constant 0.4999 is used. Wierd! */
for(idx=precision, rounder=0.4999; idx>0; idx--, rounder*=0.1);
#else
/* It makes more sense to use 0.5 */
for(idx=precision, rounder=0.5; idx>0; idx--, rounder*=0.1);
#endif
if( infop->type==etFLOAT ) realvalue += rounder;
/* Normalize realvalue to within 10.0 > realvalue >= 1.0 */
if( realvalue>0.0 ){
int k = 0;
while( realvalue
>=1e8 && k
++<100 ){ realvalue
*= 1e-8; exp+=8; } while( realvalue
>=10.0 && k
++<100 ){ realvalue
*= 0.1; exp++; } while( realvalue<1e-8 && k++<100 ){ realvalue *= 1e8; exp-=8; }
while( realvalue<1.0 && k++<100 ){ realvalue *= 10.0; exp--; }
if( k>=100 ){
bufpt = "NaN";
length = 3;
break;
}
}
bufpt = buf;
/*
** If the field type is etGENERIC, then convert to either etEXP
** or etFLOAT, as appropriate.
*/
flag_exp = xtype==etEXP;
if( xtype!=etFLOAT ){
realvalue += rounder;
if( realvalue
>=10.0 ){ realvalue
*= 0.1; exp++; } }
if( xtype==etGENERIC ){
flag_rtz = !flag_alternateform;
if( exp<-4 || exp>precision ){
xtype = etEXP;
}else{
precision
= precision
- exp; xtype = etFLOAT;
}
}else{
flag_rtz = 0;
}
/*
** The "exp+precision" test causes output to be of type etEXP if
** the precision is too large to fit in buf[].
*/
nsd = 0;
if( xtype
==etFLOAT
&& exp+precision
<etBUFSIZE
-30 ){ flag_dp = (precision>0 || flag_alternateform);
if( prefix ) *(bufpt++) = prefix; /* Sign */
if( exp<0 ) *(bufpt++) = '0'; /* Digits before "." */
else for(; exp>=0; exp--) *(bufpt++) = et_getdigit(&realvalue,&nsd);
if( flag_dp ) *(bufpt++) = '.'; /* The decimal point */
for(exp++; exp
<0 && precision
>0; precision
--, exp++){ *(bufpt++) = '0';
}
while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd);
*(bufpt--) = 0; /* Null terminate */
if( flag_rtz && flag_dp ){ /* Remove trailing zeros and "." */
while( bufpt>=buf && *bufpt=='0' ) *(bufpt--) = 0;
if( bufpt>=buf && *bufpt=='.' ) *(bufpt--) = 0;
}
bufpt++; /* point to next free slot */
}else{ /* etEXP or etGENERIC */
flag_dp = (precision>0 || flag_alternateform);
if( prefix ) *(bufpt++) = prefix; /* Sign */
*(bufpt++) = et_getdigit(&realvalue,&nsd); /* First digit */
if( flag_dp ) *(bufpt++) = '.'; /* Decimal point */
while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd);
bufpt--; /* point to last digit */
if( flag_rtz && flag_dp ){ /* Remove tail zeros */
while( bufpt>=buf && *bufpt=='0' ) *(bufpt--) = 0;
if( bufpt>=buf && *bufpt=='.' ) *(bufpt--) = 0;
}
bufpt++; /* point to next free slot */
*(bufpt++) = infop->charset[0];
if( exp
<0 ){ *(bufpt
++) = '-'; exp = -exp; } /* sign of exp */ else { *(bufpt++) = '+'; }
if( exp>=100 ){
*(bufpt
++) = (exp/100)+'0'; /* 100's digit */ }
*(bufpt
++) = exp/10+'0'; /* 10's digit */ *(bufpt++) = exp%10+'0'; /* 1's digit */
}
}
/* The converted number is in buf[] and zero terminated. Output it.
** Note that the number is in the usual order, not reversed as with
** integer conversions. */
length = (long)bufpt-(long)buf;
bufpt = buf;
/* Special case: Add leading zeros if the flag_zeropad flag is
** set and we are not left justified */
if( flag_zeropad && !flag_leftjustify && length < width){
int i;
int nPad = width - length;
for(i=width; i>=nPad; i--){
bufpt[i] = bufpt[i-nPad];
}
i = prefix!=0;
while( nPad-- ) bufpt[i++] = '0';
length = width;
}
#endif
break;
case etSIZE:
length = width = 0;
break;
case etPERCENT:
buf[0] = '%';
bufpt = buf;
length = 1;
break;
case etCHARLIT:
case etCHARX:
c
= buf
[0] = (xtype
==etCHARX
? va_arg(ap
,int) : *++fmt
); if( precision>=0 ){
for(idx=1; idx<precision; idx++) buf[idx] = c;
length = precision;
}else{
length =1;
}
bufpt = buf;
break;
case etSTRING:
case etMEMSTRING:
zMem
= bufpt
= va_arg(ap
,char*); if( bufpt==0 ) bufpt = "(null)";
if( precision>=0 && precision<length ) length = precision;
break;
case etTCLESCAPE:
{
int i, j, n, c, k;
if( arg==0 ) arg = "(NULL)";
for(i=n=0; (c=arg[i])!=0; i++){
k = NeedEsc[c&0xff];
if( k==0 ){
n++;
}else if( k==1 ){
n+=4;
}else{
n+=2;
}
}
n++;
if( n>etBUFSIZE ){
bufpt = zExtra = Tcl_Alloc( n );
}else{
bufpt = buf;
}
for(i=j=0; (c=arg[i])!=0; i++){
k = NeedEsc[c&0xff];
if( k==0 ){
bufpt[j++] = c;
}else if( k==1 ){
bufpt[j++] = '\\';
bufpt[j++] = ((c>>6) & 3) + '0';
bufpt[j++] = ((c>>3) & 7) + '0';
bufpt[j++] = (c & 7) + '0';
}else{
bufpt[j++] = '\\';
bufpt[j++] = k;
}
}
bufpt[j] = 0;
length = j;
if( precision>=0 && precision<length ) length = precision;
}
break;
case etERROR:
buf[0] = '%';
buf[1] = c;
errorflag = 0;
idx = 1+(c!=0);
(*func)(arg,"%",idx);
count += idx;
if( c==0 ) fmt--;
break;
}/* End switch over the format type */
/*
** The text of the conversion is pointed to by "bufpt" and is
** "length" characters long. The field width is "width". Do
** the output.
*/
if( !flag_leftjustify ){
register int nspace;
nspace = width-length;
if( nspace>0 ){
if( flag_center ){
nspace = nspace/2;
width -= nspace;
flag_leftjustify = 1;
}
count += nspace;
while( nspace>=etSPACESIZE ){
(*func)(arg,spaces,etSPACESIZE);
nspace -= etSPACESIZE;
}
if( nspace>0 ) (*func)(arg,spaces,nspace);
}
}
if( length>0 ){
(*func)(arg,bufpt,length);
count += length;
}
if( xtype==etMEMSTRING && zMem ){
Tcl_Free(zMem);
}
if( flag_leftjustify ){
register int nspace;
nspace = width-length;
if( nspace>0 ){
count += nspace;
while( nspace>=etSPACESIZE ){
(*func)(arg,spaces,etSPACESIZE);
nspace -= etSPACESIZE;
}
if( nspace>0 ) (*func)(arg,spaces,nspace);
}
}
if( zExtra ){
Tcl_Free(zExtra);
}
}/* End for loop over the format string */
return errorflag ? -1 : count;
} /* End of function */
/*
** The following section of code handles the mprintf routine, that
** writes to memory obtained from malloc().
*/
/* This structure is used to store state information about the
** write to memory that is currently in progress.
*/
struct sgMprintf {
char *zBase; /* A base allocation */
char *zText; /* The string collected so far */
int nChar; /* Length of the string so far */
int nAlloc; /* Amount of space allocated in zText */
};
/*
** The xprintf callback function.
**
** This routine add nNewChar characters of text in zNewText to
** the sgMprintf structure pointed to by "arg".
*/
static void mout(void *arg, char *zNewText, int nNewChar){
struct sgMprintf *pM = (struct sgMprintf*)arg;
if( pM->nChar + nNewChar + 1 > pM->nAlloc ){
pM->nAlloc = pM->nChar + nNewChar*2 + 1;
if( pM->zText==pM->zBase ){
pM->zText = Tcl_Alloc(pM->nAlloc);
if( pM
->zText
&& pM
->nChar
) memcpy(pM
->zText
,pM
->zBase
,pM
->nChar
); }else{
pM->zText = Tcl_Realloc(pM->zText, pM->nAlloc);
}
}
if( pM->zText ){
memcpy(&pM
->zText
[pM
->nChar
], zNewText
, nNewChar
); pM->nChar += nNewChar;
pM->zText[pM->nChar] = 0;
}
}
/*
** mprintf() works like printf(), but allocations memory to hold the
** resulting string and returns a pointer to the allocated memory.
*/
char *mprintf(const char *zFormat, ...){
va_list ap;
struct sgMprintf sMprintf;
char *zNew;
char zBuf[200];
sMprintf.nChar = 0;
sMprintf.nAlloc = sizeof(zBuf);
sMprintf.zText = zBuf;
sMprintf.zBase = zBuf;
vxprintf(mout,&sMprintf,zFormat,ap);
sMprintf.zText[sMprintf.nChar] = 0;
if( sMprintf.zText==sMprintf.zBase ){
zNew = Tcl_Alloc( sMprintf.nChar+1 );
}else{
zNew = Tcl_Realloc(sMprintf.zText,sMprintf.nChar+1);
}
return zNew;
}
/* This is the varargs version of mprintf.
*/
char *vmprintf(const char *zFormat, va_list ap){
struct sgMprintf sMprintf;
char zBuf[200];
sMprintf.nChar = 0;
sMprintf.zText = zBuf;
sMprintf.nAlloc = sizeof(zBuf);
sMprintf.zBase = zBuf;
vxprintf(mout,&sMprintf,zFormat,ap);
sMprintf.zText[sMprintf.nChar] = 0;
if( sMprintf.zText==sMprintf.zBase ){
sMprintf.
zText = Tcl_Alloc
( strlen(zBuf
)+1 ); if( sMprintf.
zText ) strcpy(sMprintf.
zText,zBuf
); }else{
sMprintf.zText = Tcl_Realloc(sMprintf.zText,sMprintf.nChar+1);
}
return sMprintf.zText;
}
/*
** Add text output to a Tcl_DString.
**
** This routine is called by vxprintf(). It's job is to add
** nNewChar characters of text from zNewText to the Tcl_DString
** that "arg" is pointing to.
*/
static void dstringout(void *arg, char *zNewText, int nNewChar){
Tcl_DString *str = (Tcl_DString*)arg;
Tcl_DStringAppend(str,zNewText,nNewChar);
}
/*
** Append formatted output to a DString.
*/
char *Et_DStringAppendF(Tcl_DString *str, const char *zFormat, ...){
va_list ap;
vxprintf(dstringout,str,zFormat,ap);
return Tcl_DStringValue(str);
}
/*
** Make this variable true to trace all calls to EvalF
*/
int Et_EvalTrace = 0;
/*
** Eval the results of a string.
*/
int Et_EvalF(Tcl_Interp *interp, const char *zFormat, ...){
char *zCmd;
va_list ap;
int result;
zCmd = vmprintf(zFormat,ap);
if( Et_EvalTrace
) printf("%s\n",zCmd
); result = Tcl_Eval(interp,zCmd);
if( Et_EvalTrace
) printf("%d %s\n",result
,interp
->result
); Tcl_Free(zCmd);
return result;
}
int Et_GlobalEvalF(Tcl_Interp *interp, const char *zFormat, ...){
char *zCmd;
va_list ap;
int result;
zCmd = vmprintf(zFormat,ap);
if( Et_EvalTrace
) printf("%s\n",zCmd
); result = Tcl_GlobalEval(interp,zCmd);
if( Et_EvalTrace
) printf("%d %s\n",result
,interp
->result
); Tcl_Free(zCmd);
return result;
}
/*
** Set the result of an interpreter using printf-like arguments.
*/
void Et_ResultF(Tcl_Interp *interp, const char *zFormat, ...){
Tcl_DString str;
va_list ap;
Tcl_DStringInit(&str);
vxprintf(dstringout,&str,zFormat,ap);
Tcl_DStringResult(interp,&str);
}
#if ET_HAVE_OBJ
/*
** Append text to a string object.
*/
int Et_AppendObjF(Tcl_Obj *pObj, const char *zFormat, ...){
va_list ap;
int rc;
rc = vxprintf((void(*)(void*,char*,int))Tcl_AppendToObj, pObj, zFormat, ap);
return rc;
}
#endif
#if ET_WIN32
/*
** This array translates all characters into themselves. Except
** for the \ which gets translated into /. And all upper-case
** characters are translated into lower case. This is used for
** hashing and comparing filenames, to work around the Windows
** bug of ignoring filename case and using the wrong separator
** character for directories.
**
** The array is initialized by FilenameHashInit().
**
** We also define a macro ET_TRANS() that actually does
** the character translation. ET_TRANS() is a no-op under
** unix.
*/
static char charTrans[256];
#define ET_TRANS(X) (charTrans[0xff&(int)(X)])
#else
#define ET_TRANS(X) (X)
#endif
/*
** Hash a filename. The value returned is appropriate for
** indexing into the Et_FileHashTable[] array.
*/
static int FilenameHash(char *zName){
int h = 0;
while( *zName ){
h = h ^ (h<<5) ^ ET_TRANS(*(zName++));
}
if( h<0 ) h = -h;
return h % (sizeof(Et_FileHashTable)/sizeof(Et_FileHashTable[0]));
}
/*
** Compare two filenames. Return 0 if they are the same and
** non-zero if they are different.
*/
static int FilenameCmp(char *z1, char *z2){
int diff;
while( (diff = ET_TRANS(*z1)-ET_TRANS(*z2))==0 && *z1!=0){
z1++;
z2++;
}
return diff;
}
/*
** Initialize the file hash table
*/
static void FilenameHashInit(void){
int i;
#if ET_WIN32
for(i=0; i<sizeof(charTrans); i++){
charTrans[i] = i;
}
for(i='A'; i<='Z'; i++){
charTrans[i] = i + 'a' - 'A';
}
charTrans['\\'] = '/';
#endif
for(i=0; i<sizeof(Et_FileSet)/sizeof(Et_FileSet[0]) - 1; i++){
struct EtFile *p;
int h;
p = &Et_FileSet[i];
h = FilenameHash(p->zName);
p->pNext = Et_FileHashTable[h];
Et_FileHashTable[h] = p;
}
}
/*
** Locate the text of a built-in file given its name.
** Return 0 if not found. Return this size of the file (not
** counting the null-terminator) in *pSize if pSize!=NULL.
**
** If deshroud==1 and the file is shrouded, then descramble
** the text.
*/
static char *FindBuiltinFile(char *zName, int deshroud, int *pSize){
int h;
struct EtFile *p;
h = FilenameHash(zName);
p = Et_FileHashTable[h];
while( p && FilenameCmp(p->zName,zName)!=0 ){ p = p->pNext; }
#if ET_SHROUD_KEY>0
if( p && p->shrouded && deshroud ){
char *z;
int xor = ET_SHROUD_KEY;
for(z=p->zData; *z; z++){
if( *z>=0x20 ){ *z ^= xor; xor = (xor+1)&0x1f; }
}
p->shrouded = 0;
}
#endif
if( p && pSize ){
*pSize = p->nData;
}
return p ? p->zData : 0;
}
/*
** Add a new file to the list of built-in files.
**
** This routine makes a copy of zFilename. But it does NOT make
** a copy of zData. It just holds a pointer to zData and uses
** that for all file access. So after calling this routine,
** you should never change zData!
*/
void Et_NewBuiltinFile(
char *zFilename, /* Name of the new file */
char *zData, /* Data for the new file */
int nData /* Number of bytes in the new file */
){
int h;
struct EtFile *p;
p
= (struct EtFile
*)Tcl_Alloc
( sizeof(struct EtFile
) + strlen(zFilename
) + 1); if( p==0 ) return;
p->zName = (char*)&p[1];
p->zData = zData;
p->nData = nData;
p->shrouded = 0;
h = FilenameHash(zFilename);
p->pNext = Et_FileHashTable[h];
Et_FileHashTable[h] = p;
}
/*
** A TCL interface to the Et_NewBuiltinFile function. For Tcl8.0
** and later, we make this an Obj command so that it can deal with
** binary data.
*/
#if ET_HAVE_OBJ
static int Et_NewBuiltinFileCmd(ET_OBJARGS){
char *zData, *zNew;
int nData;
if( objc!=3 ){
Tcl_WrongNumArgs(interp, 1, objv, "filename data");
return TCL_ERROR;
}
zData = (char*)Tcl_GetByteArrayFromObj(objv[2], &nData);
zNew = Tcl_Alloc( nData + 1 );
if( zNew ){
zNew[nData] = 0;
Et_NewBuiltinFile(Tcl_GetStringFromObj(objv[1], 0), zNew, nData);
}
return TCL_OK;
}
#else
static int Et_NewBuiltinFileCmd(ET_TCLARGS){
char *zData;
int nData;
if( argc!=3 ){
Et_ResultF(interp,"wrong # args: should be \"%s FILENAME DATA\"", argv[0]);
return TCL_ERROR;
}
zData = Tcl_Alloc( nData );
if( zData ){
Et_NewBuiltinFile(argv[1], zData, nData);
}
return TCL_OK;
}
#endif
/*
** The following section implements the InsertProc functionality. The
** new InsertProc feature of Tcl8.0.3 and later allows us to overload
** the usual system call commands for file I/O and replace them with
** commands that operate on the built-in files.
*/
#ifdef ET_HAVE_INSERTPROC
/*
** Each open channel to a built-in file is an instance of the
** following structure.
*/
typedef struct Et_FileStruct {
char *zData; /* All of the data */
int nData; /* Bytes of data, not counting the null terminator */
int cursor; /* How much of the data has been read so far */
} Et_FileStruct;
/*
** Close a previously opened built-in file.
*/
static int Et_FileClose(ClientData instanceData, Tcl_Interp *interp){
Et_FileStruct *p = (Et_FileStruct*)instanceData;
Tcl_Free((char*)p);
return 0;
}
/*
** Read from a built-in file.
*/
static int Et_FileInput(
ClientData instanceData, /* The file structure */
char *buf, /* Write the data read here */
int bufSize, /* Read this much data */
int *pErrorCode /* Write the error code here */
){
Et_FileStruct *p = (Et_FileStruct*)instanceData;
*pErrorCode = 0;
if( p->cursor+bufSize>p->nData ){
bufSize = p->nData - p->cursor;
}
memcpy(buf
, &p
->zData
[p
->cursor
], bufSize
); p->cursor += bufSize;
return bufSize;
}
/*
** Writes to a built-in file always return EOF.
*/
static int Et_FileOutput(
ClientData instanceData, /* The file structure */
char *buf, /* Read the data from here */
int toWrite, /* Write this much data */
int *pErrorCode /* Write the error code here */
){
*pErrorCode = 0;
return 0;
}
/*
** Move the cursor around within the built-in file.
*/
static int Et_FileSeek(
ClientData instanceData, /* The file structure */
long offset, /* Offset to seek to */
int mode, /* One of SEEK_CUR, SEEK_SET or SEEK_END */
int *pErrorCode /* Write the error code here */
){
Et_FileStruct *p = (Et_FileStruct*)instanceData;
switch( mode ){
case SEEK_CUR: offset += p->cursor; break;
case SEEK_END: offset += p->nData; break;
default: break;
}
if( offset<0 ) offset = 0;
if( offset>p->nData ) offset = p->nData;
p->cursor = offset;
return offset;
}
/*
** The Watch method is a no-op
*/
static void Et_FileWatch(ClientData instanceData, int mask){
}
/*
** The Handle method always returns an error.
*/
static int Et_FileHandle(ClientData notUsed, int dir, ClientData *handlePtr){
return TCL_ERROR;
}
/*
** This is the channel type that will access the built-in files.
*/
static Tcl_ChannelType builtinChannelType = {
"builtin", /* Type name. */
NULL, /* Always non-blocking.*/
Et_FileClose, /* Close proc. */
Et_FileInput, /* Input proc. */
Et_FileOutput, /* Output proc. */
Et_FileSeek, /* Seek proc. */
NULL, /* Set option proc. */
NULL, /* Get option proc. */
Et_FileWatch, /* Watch for events on console. */
Et_FileHandle, /* Get a handle from the device. */
};
/*
** This routine attempts to do an open of a built-in file.
*/
static Tcl_Channel Et_FileOpen(
Tcl_Interp *interp, /* The TCL interpreter doing the open */
char *zFilename, /* Name of the file to open */
char *modeString, /* Mode string for the open (ignored) */
int permissions /* Permissions for a newly created file (ignored) */
){
char *zData;
Et_FileStruct *p;
int nData;
char zName[50];
Tcl_Channel chan;
static int count = 1;
zData = FindBuiltinFile(zFilename, 1, &nData);
if( zData==0 ) return NULL;
p = (Et_FileStruct*)Tcl_Alloc( sizeof(Et_FileStruct) );
if( p==0 ) return NULL;
p->zData = zData;
p->nData = nData;
p->cursor = 0;
sprintf(zName
,"etbi_%x_%x",((int)Et_FileOpen
)>>12,count
++); chan = Tcl_CreateChannel(&builtinChannelType, zName,
(ClientData)p, TCL_READABLE);
return chan;
}
/*
** This routine does a stat() system call for a built-in file.
*/
static int Et_FileStat(char *path, struct stat *buf){
char *zData;
int nData;
zData = FindBuiltinFile(path, 0, &nData);
if( zData==0 ){
return -1;
}
buf->st_mode = 0400;
buf->st_size = nData;
return 0;
}
/*
** This routien does an access() system call for a built-in file.
*/
static int Et_FileAccess(char *path, int mode){
char *zData;
if( mode & 3 ){
return -1;
}
zData = FindBuiltinFile(path, 0, 0);
if( zData==0 ){
return -1;
}
return 0;
}
#endif /* ET_HAVE_INSERTPROC */
/*
** An overloaded version of "source". First check for the file
** is one of the built-ins. If it isn't a built-in, then check the
** disk. But if ET_STANDALONE is set (which corresponds to the
** "Strict" option in the user interface) then never check the disk.
** This gives us a quick way to check for the common error of
** sourcing a file that exists on the development by mistake,
** and only discovering the mistake when you move the program
** to your customer's machine.
*/
static int Et_Source(ET_TCLARGS){
char *z;
if( argc!=2 ){
Et_ResultF(interp,"wrong # args: should be \"%s FILENAME\"", argv[0]);
return TCL_ERROR;
}
z = FindBuiltinFile(argv[1], 1, 0);
if( z ){
int rc;
rc = Tcl_Eval(interp,z);
if (rc == TCL_ERROR) {
char msg[200];
sprintf(msg
, "\n (file \"%.150s\" line %d)", argv
[1], interp->errorLine);
Tcl_AddErrorInfo(interp, msg);
} else {
rc = TCL_OK;
}
return rc;
}
#if ET_STANDALONE
Et_ResultF(interp,"no such file: \"%s\"", argv[1]);
return TCL_ERROR;
#else
return Tcl_EvalFile(interp,argv[1]);
#endif
}
#ifndef ET_HAVE_INSERTPROC
/*
** An overloaded version of "file exists". First check for the file
** in the file table, then go to disk.
**
** We only overload "file exists" if we don't have InsertProc()
** procedures. If we do have InsertProc() procedures, they will
** handle this more efficiently.
*/
static int Et_FileExists(ET_TCLARGS){
int i, rc;
Tcl_DString str;
if( argc
==3 && strncmp(argv
[1],"exis",4)==0 ){ if( FindBuiltinFile(argv[2], 0, 0)!=0 ){
interp->result = "1";
return TCL_OK;
}
}
Tcl_DStringInit(&str);
Tcl_DStringAppendElement(&str,"Et_FileCmd");
for(i=1; i<argc; i++){
Tcl_DStringAppendElement(&str, argv[i]);
}
rc = Tcl_Eval(interp, Tcl_DStringValue(&str));
Tcl_DStringFree(&str);
return rc;
}
#endif
/*
** This is the main Tcl interpreter. It's a global variable so it
** can be accessed easily from C code.
*/
Tcl_Interp *Et_Interp = 0;
#if ET_WIN32
/*
** Implement the Et_MessageBox command on Windows platforms. We
** use the MessageBox() function from the Win32 API so that the
** error message will be displayed as a dialog box. Writing to
** standard error doesn't do anything on windows.
*/
int Et_MessageBox(ET_TCLARGS){
char *zMsg = "(Empty Message)";
char *zTitle = "Message...";
if( argc>1 ){
zTitle = argv[1];
}
if( argc>2 ){
zMsg = argv[2];
}
MessageBox(0, zMsg, zTitle, MB_ICONSTOP | MB_OK);
return TCL_OK;
}
#endif
/*
** A default implementation for "bgerror"
*/
static char zBgerror[] =
"proc Et_Bgerror err {\n"
" global errorInfo tk_library\n"
" if {[info exists errorInfo]} {\n"
" set ei $errorInfo\n"
" } else {\n"
" set ei {}\n"
" }\n"
" if {[catch {bgerror $err}]==0} return\n"
" if {[string length $ei]>0} {\n"
" set err $ei\n"
" }\n"
" if {[catch {Et_MessageBox {Error} $err}]} {\n"
" puts stderr $err\n"
" }\n"
" exit\n"
"}\n"
;
/*
** Do the initialization.
**
** This routine is called after the interpreter is created, but
** before Et_PreInit() or Et_AppInit() have been run.
*/
static int Et_DoInit(Tcl_Interp *interp){
int i;
extern int Et_PreInit(Tcl_Interp*);
extern int Et_AppInit(Tcl_Interp*);
/* Insert our alternative stat(), access() and open() procedures
** so that any attempt to work with a file will check our built-in
** scripts first.
*/
#ifdef ET_HAVE_INSERTPROC
TclStatInsertProc(Et_FileStat);
TclAccessInsertProc(Et_FileAccess);
TclOpenFileChannelInsertProc(Et_FileOpen);
#endif
/* Initialize the hash-table for built-in scripts
*/
FilenameHashInit();
/* The Et_NewBuiltFile command is inserted for use by FreeWrap
** and similar tools.
*/
#if ET_HAVE_OBJ
Tcl_CreateObjCommand(interp,"Et_NewBuiltinFile",Et_NewBuiltinFileCmd,0,0);
#else
Tcl_CreateCommand(interp,"Et_NewBuiltinFile",Et_NewBuiltinFileCmd,0,0);
#endif
/* Overload the "file" and "source" commands
*/
#ifndef ET_HAVE_INSERTPROC
{
static char zRename[] = "rename file Et_FileCmd";
Tcl_Eval(interp,zRename);
Tcl_CreateCommand(interp,"file",Et_FileExists,0,0);
}
#endif
Tcl_CreateCommand(interp,"source",Et_Source,0,0);
Et_Interp = interp;
#ifdef ET_TCL_LIBRARY
Tcl_SetVar(interp,"tcl_library",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);
Tcl_SetVar(interp,"tcl_libPath",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);
Tcl_SetVar2(interp,"env","TCL_LIBRARY",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);
#endif
#ifdef ET_TK_LIBRARY
Tcl_SetVar(interp,"tk_library",ET_TK_LIBRARY,TCL_GLOBAL_ONLY);
Tcl_SetVar2(interp,"env","TK_LIBRARY",ET_TK_LIBRARY,TCL_GLOBAL_ONLY);
#endif
#if ET_WIN32
Tcl_CreateCommand(interp,"Et_MessageBox",Et_MessageBox, 0, 0);
#endif
Tcl_Eval(interp,zBgerror);
#if ET_HAVE_PREINIT
if( Et_PreInit(interp) == TCL_ERROR ){
goto initerr;
}
#endif
if( Tcl_Init(interp) == TCL_ERROR ){
goto initerr;
}
Et_GlobalEvalF(interp,"set dir $tcl_library;source $dir/tclIndex;unset dir");
#if ET_ENABLE_TK
if( Tk_Init(interp) == TCL_ERROR ){
goto initerr;
}
Tcl_StaticPackage(interp,"Tk", Tk_Init, 0);
Et_GlobalEvalF(interp,"set dir $tk_library;source $dir/tclIndex;unset dir");
#endif
/* Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY); */
for(i=0; i<sizeof(Et_CmdSet)/sizeof(Et_CmdSet[0]) - 1; i++){
Tcl_CreateCommand(interp, Et_CmdSet[i].zName, Et_CmdSet[i].xProc, 0, 0);
}
#if ET_ENABLE_OBJ
for(i=0; i<sizeof(Et_ObjSet)/sizeof(Et_ObjSet[0]) - 1; i++){
Tcl_CreateObjCommand(interp, Et_ObjSet[i].zName, Et_ObjSet[i].xProc, 0, 0);
}
#endif
Tcl_LinkVar(interp,"Et_EvalTrace",(char*)&Et_EvalTrace,TCL_LINK_BOOLEAN);
Tcl_SetVar(interp,"et_version",ET_VERSION,TCL_GLOBAL_ONLY);
#if ET_HAVE_APPINIT
if( Et_AppInit(interp) == TCL_ERROR ){
goto initerr;
}
#endif
#if ET_ENABLE_TK && !ET_EXTENSION
Et_NewBuiltinFile("builtin:/console.tcl", zEtConsole, sizeof(zEtConsole));
#if ET_CONSOLE
Tcl_Eval(interp,
"source builtin:/console.tcl\n"
"console:create {.@console} {% } {Tcl/Tk Console}\n"
);
#endif
#endif
#ifdef ET_MAIN_SCRIPT
if( Et_EvalF(interp,"source \"%q\"", ET_MAIN_SCRIPT)!=TCL_OK ){
goto initerr;
}
#endif
return TCL_OK;
initerr:
Et_EvalF(interp,"Et_Bgerror \"%q\"", interp->result);
return TCL_ERROR;
}
#if ET_READ_STDIN==0 || ET_AUTO_FORK!=0
/*
** Initialize everything.
*/
static int Et_Local_Init(int argc, char **argv){
Tcl_Interp *interp;
char *args;
char buf[100];
#if !ET_HAVE_CUSTOM_MAINLOOP
static char zWaitForever[] =
#if ET_ENABLE_TK
"bind . <Destroy> {if {![winfo exists .]} exit}\n"
#endif
"while 1 {vwait forever}";
#endif
Tcl_FindExecutable(argv[0]);
interp = Tcl_CreateInterp();
args = Tcl_Merge(argc-1, argv+1);
Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
ckfree(args);
Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "argv0", argv[0], TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
Et_DoInit(interp);
#if ET_HAVE_CUSTOM_MAINLOOP
Et_CustomMainLoop(interp);
#else
Tcl_Eval(interp,zWaitForever);
#endif
return 0;
}
#endif
/*
** This routine is called to do the complete initialization.
*/
int Et_Init(int argc, char **argv){
#ifdef ET_TCL_LIBRARY
putenv("TCL_LIBRARY=" ET_TCL_LIBRARY);
#endif
#ifdef ET_TK_LIBRARY
putenv("TK_LIBRARY=" ET_TK_LIBRARY);
#endif
#if ET_CONSOLE || !ET_READ_STDIN
Et_Local_Init(argc, argv);
#else
# if ET_ENABLE_TK
Tk_Main(argc,argv,Et_DoInit);
# else
Tcl_Main(argc, argv, Et_DoInit);
# endif
#endif
return 0;
}
#if !ET_HAVE_MAIN && !ET_EXTENSION
/*
** Main routine for UNIX programs. If the user has supplied
** their own main() routine in a C module, then the ET_HAVE_MAIN
** macro will be set to 1 and this code will be skipped.
*/
int main(int argc, char **argv){
#if ET_AUTO_FORK
int rc = fork();
if( rc<0 ){
}
if( rc>0 ) return 0;
close(0);
open("/dev/null",O_RDONLY);
close(1);
open("/dev/null",O_WRONLY);
#endif
return Et_Init(argc,argv)!=TCL_OK;
}
#endif
#if ET_EXTENSION
/*
** If the -extension flag is used, then generate code that will be
** turned into a loadable shared library or DLL, not a standalone
** executable.
*/
int ET_EXTENSION_NAME(Tcl_Interp *interp){
int i;
#ifndef ET_HAVE_INSERTPROC
Tcl_AppendResult(interp,
"mktclapp can only generate extensions for Tcl/Tk version "
"8.0.3 and later. This is version "
TCL_MAJOR_VERSION "." TCL_MINOR_VERSION "." TCL_RELEASE_SERIAL, 0);
return TCL_ERROR;
#endif
#ifdef ET_HAVE_INSERTPROC
#ifdef USE_TCL_STUBS
if( Tcl_InitStubs(interp,"8.0",0)==0 ){
return TCL_ERROR;
}
if( Tk_InitStubs(interp,"8.0",0)==0 ){
return TCL_ERROR;
}
#endif
Et_Interp = interp;
TclStatInsertProc(Et_FileStat);
TclAccessInsertProc(Et_FileAccess);
TclOpenFileChannelInsertProc(Et_FileOpen);
FilenameHashInit();
for(i=0; i<sizeof(Et_CmdSet)/sizeof(Et_CmdSet[0]) - 1; i++){
Tcl_CreateCommand(interp, Et_CmdSet[i].zName, Et_CmdSet[i].xProc, 0, 0);
}
#if ET_ENABLE_OBJ
for(i=0; i<sizeof(Et_ObjSet)/sizeof(Et_ObjSet[0]) - 1; i++){
Tcl_CreateObjCommand(interp, Et_ObjSet[i].zName, Et_ObjSet[i].xProc, 0, 0);
}
#endif
Tcl_LinkVar(interp,"Et_EvalTrace",(char*)&Et_EvalTrace,TCL_LINK_BOOLEAN);
Tcl_SetVar(interp,"et_version",ET_VERSION,TCL_GLOBAL_ONLY);
#if ET_HAVE_APPINIT
if( Et_AppInit(interp) == TCL_ERROR ){
return TCL_ERROR;
}
#endif
#ifdef ET_MAIN_SCRIPT
if( Et_EvalF(interp,"source \"%q\"", ET_MAIN_SCRIPT)!=TCL_OK ){
return TCL_ERROR;
}
#endif
return TCL_OK;
#endif /* ET_HAVE_INSERTPROC */
}
int ET_SAFE_EXTENSION_NAME(Tcl_Interp *interp){
return ET_EXTENSION_NAME(interp);
}
#endif