Subversion Repositories Vertical

Rev

Blame | Last modification | View Log | Download | RSS feed

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