Subversion Repositories Vertical

Rev

Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed

  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
  2904.