home *** CD-ROM | disk | FTP | other *** search
/ Serving the Web / ServingTheWeb1995.disc1of1.iso / linux / slacksrce / tcl / tcl+tk+t / tclx7.3bl / tclx7 / tclX7.3b / src / tclXlib.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-07-16  |  39.5 KB  |  1,326 lines
  1. /*
  2.  * tclXlib.c --
  3.  *
  4.  * Tcl commands to load libraries of Tcl code.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1991-1994 Karl Lehenbauer and Mark Diekhans.
  7.  *
  8.  * Permission to use, copy, modify, and distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11.  * Mark Diekhans make no representations about the suitability of this
  12.  * software for any purpose.  It is provided "as is" without express or
  13.  * implied warranty.
  14.  *-----------------------------------------------------------------------------
  15.  * $Id: tclXlib.c,v 4.0 1994/07/16 05:27:17 markd Rel $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. /*-----------------------------------------------------------------------------
  20.  * The Extended Tcl library code is a super set of the standard Tcl libaries.
  21.  * 
  22.  * The following data structures are kept as Tcl variables so they can be
  23.  * accessed from Tcl:
  24.  *
  25.  *   o auto_path - The directory path to search for libraries.
  26.  *   o auto_oldpath - The previous value of auto_path.  Use to check if 
  27.  *     the path needs to be searched again. Maybe unset to force searching
  28.  *     of auto_path.
  29.  *   o auto_index - An array indexed by command name and contains code to
  30.  *     execute to make the command available.  Normally contains either:
  31.  *       "source file"
  32.  *       "auto_pkg_load package"
  33.  *   o auto_pkg_index - Indexed by package name.
  34.  *  
  35.  *-----------------------------------------------------------------------------
  36.  */
  37. #include "tclExtdInt.h"
  38.  
  39. /*
  40.  * Names of Tcl variables that are used.
  41.  */
  42. static char *AUTO_INDEX     = "auto_index";
  43. static char *AUTO_PATH      = "auto_path";
  44. static char *AUTO_OLDPATH   = "auto_oldpath";
  45. static char *AUTO_PKG_INDEX = "auto_pkg_index";
  46.  
  47. /*
  48.  * Command to pass to Tcl_GlobalEval to load the file loadouster.tcl.
  49.  * This is a global rather than a local so it will work with K&R compilers.
  50.  * Its writable so it works with gcc.
  51.  */
  52. static char loadOusterCmd [] = "source [info library]/loadouster.tcl";
  53.  
  54.  
  55. /*
  56.  * Per-interpreter structure used for managing the library.
  57.  */
  58. typedef struct libInfo_t {
  59.     Tcl_HashTable inProgressTbl;     /* List of cmds being loaded.       */
  60.     int           doingIdxSearch;    /* Loading indexes on a path now.   */
  61. } libInfo_t;
  62.  
  63. /*
  64.  * Prototypes of internal functions.
  65.  */
  66. static int
  67. GlobalEvalFile _ANSI_ARGS_((Tcl_Interp *interp,
  68.                             char       *file));
  69.  
  70. static int
  71. EvalFilePart _ANSI_ARGS_((Tcl_Interp  *interp,
  72.                           char        *fileName,
  73.                           long         offset,
  74.                           unsigned     length));
  75.  
  76. static char *
  77. MakeAbsFile _ANSI_ARGS_((Tcl_Interp  *interp,
  78.                          char        *fileName,
  79.                          Tcl_DString *absNamePtr));
  80.  
  81. static int
  82. SetPackageIndexEntry _ANSI_ARGS_((Tcl_Interp *interp,
  83.                                   char       *packageName,
  84.                                   char       *fileName,
  85.                                   char       *offset,
  86.                                   char       *length));
  87.  
  88. static int
  89. GetPackageIndexEntry _ANSI_ARGS_((Tcl_Interp *interp,
  90.                                   char       *packageName,
  91.                                   char      **fileNamePtr,
  92.                                   long       *offsetPtr,
  93.                                   unsigned   *lengthPtr));
  94.  
  95. static int
  96. SetProcIndexEntry _ANSI_ARGS_((Tcl_Interp *interp,
  97.                                char       *procName,
  98.                                char       *package));
  99.  
  100. static void
  101. AddLibIndexErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
  102.                                   char       *indexName));
  103.  
  104. static int
  105. ProcessIndexFile _ANSI_ARGS_((Tcl_Interp *interp,
  106.                               char       *tlibFilePath,
  107.                               char       *tndxFilePath));
  108.  
  109. static int
  110. BuildPackageIndex  _ANSI_ARGS_((Tcl_Interp *interp,
  111.                                 char       *tlibFilePath));
  112.  
  113. static int
  114. LoadPackageIndex _ANSI_ARGS_((Tcl_Interp *interp,
  115.                               char       *tlibFilePath));
  116.  
  117. static int
  118. LoadOusterIndex _ANSI_ARGS_((Tcl_Interp *interp,
  119.                              char       *indexFilePath));
  120.  
  121. static int
  122. LoadDirIndexes _ANSI_ARGS_((Tcl_Interp  *interp,
  123.                             char        *dirName));
  124.  
  125. static int
  126. LoadPackageIndexes _ANSI_ARGS_((Tcl_Interp  *interp,
  127.                                 libInfo_t   *infoPtr,
  128.                                 char        *path));
  129.  
  130. static int
  131. AddInProgress _ANSI_ARGS_((Tcl_Interp  *interp,
  132.                            libInfo_t   *infoPtr,
  133.                            char        *command));
  134.  
  135. static void
  136. RemoveInProgress _ANSI_ARGS_((Tcl_Interp  *interp,
  137.                               libInfo_t   *infoPtr,
  138.                               char        *command));
  139.  
  140. static int
  141. LoadAutoPath _ANSI_ARGS_((Tcl_Interp  *interp,
  142.                           libInfo_t   *infoPtr));
  143.  
  144. static int
  145. LoadCommand _ANSI_ARGS_((Tcl_Interp  *interp,
  146.                          char        *command));
  147.  
  148. static void
  149. TclLibCleanUp _ANSI_ARGS_((ClientData  clientData,
  150.                            Tcl_Interp *interp));
  151.  
  152. /*
  153.  *-----------------------------------------------------------------------------
  154.  * GlobalEvalFile --
  155.  *
  156.  *  Evaluate a file at global level in an interpreter.
  157.  *-----------------------------------------------------------------------------
  158.  */
  159. static int
  160. GlobalEvalFile(interp, file)
  161.     Tcl_Interp *interp;
  162.     char       *file;
  163. {
  164.     register Interp *iPtr = (Interp *) interp;
  165.     int result;
  166.     CallFrame *savedVarFramePtr;
  167.  
  168.     savedVarFramePtr = iPtr->varFramePtr;
  169.     iPtr->varFramePtr = NULL;
  170.     result = Tcl_EvalFile (interp, file);
  171.     iPtr->varFramePtr = savedVarFramePtr;
  172.     return result;
  173. }
  174.  
  175. /*
  176.  *-----------------------------------------------------------------------------
  177.  * EvalFilePart --
  178.  *
  179.  *   Read in a byte range of a file and evaulate it.
  180.  *
  181.  * Parameters:
  182.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  183.  *   o fileName (I) - The file to evaulate.
  184.  *   o offset (I) - Byte offset into the file of the area to evaluate
  185.  *   o length (I) - Number of bytes to evaulate..
  186.  *-----------------------------------------------------------------------------
  187.  */
  188. static int
  189. EvalFilePart (interp, fileName, offset, length)
  190.     Tcl_Interp  *interp;
  191.     char        *fileName;
  192.     long         offset;
  193.     unsigned     length;
  194. {
  195.     Interp       *iPtr = (Interp *) interp;
  196.     int           fileNum, result;
  197.     struct stat   statBuf;
  198.     char         *oldScriptFile, *cmdBuffer, *buf;
  199.     Tcl_DString   tildeBuf;
  200.  
  201.     Tcl_DStringInit (&tildeBuf);
  202.     
  203.     if (fileName [0] == '~') {
  204.         if ((fileName = Tcl_TildeSubst (interp, fileName, &tildeBuf)) == NULL)
  205.             return TCL_ERROR;
  206.     }
  207.  
  208.     fileNum = open (fileName, O_RDONLY, 0);
  209.     if (fileNum < 0) {
  210.         Tcl_AppendResult (interp, "open failed on: ", fileName, ": ",
  211.                           Tcl_PosixError (interp), (char *) NULL);
  212.         return TCL_ERROR;
  213.     }
  214.  
  215.     if (fstat (fileNum, &statBuf) == -1)
  216.         goto accessError;
  217.  
  218.     if ((statBuf.st_size < offset + length) || (offset < 0)) {
  219.         Tcl_AppendResult (interp, "range to eval outside of file bounds \"",
  220.                           fileName, "\"", (char *) NULL);
  221.         goto errorExit;
  222.     }
  223.     if (lseek (fileNum, offset, 0) < 0)
  224.         goto accessError;
  225.  
  226.     cmdBuffer = ckalloc (length + 1);
  227.     if (read (fileNum, cmdBuffer, length) != length)
  228.         goto accessError;
  229.  
  230.     cmdBuffer [length] = '\0';
  231.  
  232.     if (close (fileNum) != 0)
  233.         goto accessError;
  234.     fileNum = -1;
  235.  
  236.     oldScriptFile = iPtr->scriptFile;
  237.     iPtr->scriptFile = fileName;
  238.  
  239.     result = Tcl_GlobalEval (interp, cmdBuffer);
  240.  
  241.     iPtr->scriptFile = oldScriptFile;
  242.     ckfree (cmdBuffer);
  243.                          
  244.     if (result != TCL_ERROR) {
  245.         Tcl_DStringFree (&tildeBuf);
  246.         return TCL_OK;
  247.     }
  248.  
  249.     /*
  250.      * An error occured in the command, record information telling where it
  251.      * came from.
  252.      */
  253.     buf = ckalloc (sizeof (fileName) + 64);
  254.     sprintf (buf, "\n    (file \"%s\" line %d)", fileName,
  255.              interp->errorLine);
  256.     Tcl_AddErrorInfo (interp, buf);
  257.     ckfree (buf);
  258.     goto errorExit;
  259.  
  260.     /*
  261.      * Errors accessing the file once its opened are handled here.
  262.      */
  263.   accessError:
  264.     Tcl_AppendResult (interp, "error accessing: ", fileName, ": ",
  265.                       Tcl_PosixError (interp), (char *) NULL);
  266.  
  267.   errorExit:
  268.     if (fileNum > 0)
  269.         close (fileNum);
  270.     Tcl_DStringFree (&tildeBuf);
  271.     return TCL_ERROR;
  272. }
  273.  
  274. /*
  275.  *-----------------------------------------------------------------------------
  276.  * MakeAbsFile --
  277.  *
  278.  * Convert a file name to an absolute path.  This handles tilde substitution
  279.  * and preappend the current directory name if the path is relative.
  280.  *
  281.  * Parameters
  282.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  283.  *   o fileName (I) - File name (should not start with a "/").
  284.  *   o absNamePtr (O) - The name is returned in this dynamic string.
  285.  * Returns:
  286.  *   A pointer to the file name in the dynamic string or NULL if an error
  287.  * occured.
  288.  *-----------------------------------------------------------------------------
  289.  */
  290. static char *
  291. MakeAbsFile (interp, fileName, absNamePtr)
  292.     Tcl_Interp  *interp;
  293.     char        *fileName;
  294.     Tcl_DString *absNamePtr;
  295. {
  296.     char  curDir [MAXPATHLEN+1];
  297.  
  298.     Tcl_DStringFree (absNamePtr);
  299.  
  300.     /*
  301.      * If its already absolute, just copy the name.
  302.      */
  303.     if (fileName [0] == '/') {
  304.         Tcl_DStringAppend (absNamePtr, fileName, -1);
  305.         return Tcl_DStringValue (absNamePtr);
  306.     }
  307.  
  308.     /*
  309.      * If it starts with a tilde, the substitution will make it
  310.      * absolute.
  311.      */
  312.     if (fileName [0] == '~') {
  313.         if (Tcl_TildeSubst (interp, fileName, absNamePtr) == NULL)
  314.             return NULL;
  315.         return Tcl_DStringValue (absNamePtr);
  316.     }
  317.  
  318.     /*
  319.      * Otherwise its relative to the current directory, get the directory
  320.      * and go from here.
  321.      */
  322. #ifdef HAVE_GETCWD
  323.     if (getcwd (curDir, MAXPATHLEN) == NULL) {
  324.         Tcl_AppendResult (interp, "error getting working directory name: ",
  325.                           Tcl_PosixError (interp), (char *) NULL);
  326.     }
  327. #else
  328.     if (getwd (curDir) == NULL) {
  329.         Tcl_AppendResult (interp, "error getting working directory name: ",
  330.                           curDir, (char *) NULL);
  331.     }
  332. #endif
  333.     Tcl_DStringAppend (absNamePtr, curDir,   -1);
  334.     Tcl_DStringAppend (absNamePtr, "/",      -1);
  335.     Tcl_DStringAppend (absNamePtr, fileName, -1);
  336.  
  337.     return Tcl_DStringValue (absNamePtr);
  338. }
  339.  
  340. /*
  341.  *-----------------------------------------------------------------------------
  342.  * SetPackageIndexEntry --
  343.  *
  344.  * Set a package entry in the auto_pkg_index array in the form:
  345.  *
  346.  *     auto_pkg_index($packageName) [list $filename $offset $length]
  347.  *
  348.  * Duplicate package entries are overwritten.
  349.  *
  350.  * Parameters
  351.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  352.  *   o packageName (I) - Package name.
  353.  *   o fileName (I) - Absolute file name of the file containing the package.
  354.  *   o offset (I) - String containing the numeric start of the package.
  355.  *   o length (I) - String containing the numeric length of the package.
  356.  * Returns:
  357.  *   TCL_OK or TCL_ERROR.
  358.  *-----------------------------------------------------------------------------
  359.  */
  360. static int
  361. SetPackageIndexEntry (interp, packageName, fileName, offset, length)
  362.      Tcl_Interp *interp;
  363.      char       *packageName;
  364.      char       *fileName;
  365.      char       *offset;
  366.      char       *length;
  367. {
  368.     char *pkgDataArgv [3], *dataStr, *setResult;
  369.  
  370.     /*
  371.      * Build up the list of values to save.
  372.      */
  373.     pkgDataArgv [0] = fileName;
  374.     pkgDataArgv [1] = offset;
  375.     pkgDataArgv [2] = length;
  376.     dataStr = Tcl_Merge (3, pkgDataArgv);
  377.  
  378.     setResult = Tcl_SetVar2 (interp, AUTO_PKG_INDEX, packageName, dataStr,
  379.                              TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
  380.     ckfree (dataStr);
  381.  
  382.     return (setResult == NULL) ? TCL_ERROR : TCL_OK;
  383. }
  384.  
  385. /*
  386.  *-----------------------------------------------------------------------------
  387.  * GetPackageIndexEntry --
  388.  *
  389.  * Get a package entry from the auto_pkg_index array.
  390.  *
  391.  * Parameters
  392.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  393.  *   o packageName (I) - Package name to find.
  394.  *   o fileNamePtr (O) - The file name for the library file is returned here.
  395.  *     This should be freed by the caller.
  396.  *   o offsetPtr (O) - Start of the package in the library.
  397.  *   o lengthPtr (O) - Length of the package in the library.
  398.  * Returns:
  399.  *   TCL_OK or TCL_ERROR.
  400.  *-----------------------------------------------------------------------------
  401.  */
  402. static int
  403. GetPackageIndexEntry (interp, packageName, fileNamePtr, offsetPtr, lengthPtr)
  404.      Tcl_Interp *interp;
  405.      char       *packageName;
  406.      char      **fileNamePtr;
  407.      long       *offsetPtr;
  408.      unsigned   *lengthPtr;
  409. {
  410.     int   pkgDataArgc, idx;
  411.     char *dataStr, **pkgDataArgv = NULL;
  412.     char *srcPtr, *destPtr;
  413.  
  414.     /*
  415.      * Look up the package entry in the array.
  416.      */
  417.     dataStr = Tcl_GetVar2 (interp, AUTO_PKG_INDEX, packageName,
  418.                            TCL_GLOBAL_ONLY);
  419.     if (dataStr == NULL) {
  420.         Tcl_AppendResult (interp, "entry not found in \"auto_pkg_index \"",
  421.                           "for package \"", packageName, "\"", (char *) NULL);
  422.         return TCL_ERROR;
  423.     }
  424.  
  425.     /*
  426.      * Extract the data from the array entry.  The file name will be copied
  427.      * to the top of the memory area returned by Tcl_SplitList after the
  428.      * other fields have been accessed.  Copied in a way allowing for overlap.
  429.      */
  430.     if (Tcl_SplitList (interp, dataStr, &pkgDataArgc, &pkgDataArgv) != TCL_OK)
  431.         goto invalidEntry;
  432.     if (pkgDataArgc != 3)
  433.         goto invalidEntry;
  434.  
  435.     if (!Tcl_StrToLong (pkgDataArgv [1], 0, offsetPtr))
  436.         goto invalidEntry;
  437.     if (!Tcl_StrToUnsigned (pkgDataArgv [2], 0, lengthPtr))
  438.         goto invalidEntry;
  439.  
  440.     *fileNamePtr = destPtr = (char *) pkgDataArgv;
  441.     srcPtr = pkgDataArgv [0];
  442.  
  443.     while (*srcPtr != '\0') {
  444.         *destPtr++ = *srcPtr++;
  445.     }
  446.     *destPtr = '\0';
  447.  
  448.     return TCL_OK;
  449.     
  450.     /*
  451.      * Exit point when an invalid entry is found.
  452.      */
  453.   invalidEntry:
  454.     if (pkgDataArgv != NULL)
  455.         ckfree ((char *) pkgDataArgv);
  456.     Tcl_ResetResult (interp);
  457.     Tcl_AppendResult (interp, "invalid entry in \"auto_pkg_index \"",
  458.                       "for package \"", packageName, "\"", (char *) NULL);
  459.     return TCL_ERROR;
  460. }
  461.  
  462. /*
  463.  *-----------------------------------------------------------------------------
  464.  * SetProcIndexEntry --
  465.  *
  466.  * Set the proc entry in the auto_index array.  These entry contains a command
  467.  * to make the proc available from a package.
  468.  *
  469.  * Parameters
  470.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  471.  *   o procName (I) - The Tcl proc name.
  472.  *   o package (I) - Pacakge containing the proc.
  473.  * Returns:
  474.  *   TCL_OK or TCL_ERROR.
  475.  *-----------------------------------------------------------------------------
  476.  */
  477. static int
  478. SetProcIndexEntry (interp, procName, package)
  479.     Tcl_Interp *interp;
  480.     char       *procName;
  481.     char       *package;
  482. {
  483.     Tcl_DString  command;
  484.     char        *result;
  485.  
  486.     Tcl_DStringInit (&command);
  487.     Tcl_DStringAppend (&command, "auto_load_pkg {", -1);
  488.     Tcl_DStringAppend (&command, package, -1);
  489.     Tcl_DStringAppend (&command, "}", -1);
  490.  
  491.     result = Tcl_SetVar2 (interp, AUTO_INDEX, procName, command.string,
  492.                           TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
  493.  
  494.     Tcl_DStringFree (&command);
  495.  
  496.     return (result == NULL) ? TCL_ERROR : TCL_OK;
  497. }
  498.  
  499. /*
  500.  *-----------------------------------------------------------------------------
  501.  * AddLibIndexErrorInfo --
  502.  *
  503.  * Add information to the error info stack about index that just failed.
  504.  * This is generic for both tclIndex and .tlib indexs
  505.  *
  506.  * Parameters
  507.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  508.  *   o indexName (I) - The name of the index.
  509.  *-----------------------------------------------------------------------------
  510.  */
  511. static void
  512. AddLibIndexErrorInfo (interp, indexName)
  513.     Tcl_Interp *interp;
  514.     char       *indexName;
  515. {
  516.     char *msg;
  517.  
  518.     msg = ckalloc (strlen (indexName) + 60);
  519.     strcpy (msg, "\n    while loading Tcl library index \"");
  520.     strcat (msg, indexName);
  521.     strcat (msg, "\"");
  522.     Tcl_AddErrorInfo (interp, msg);
  523.     ckfree (msg);
  524. }
  525.  
  526.  
  527. /*
  528.  *-----------------------------------------------------------------------------
  529.  * ProcessIndexFile --
  530.  *
  531.  * Open and process a package library index file (.tndx).  Creates entries
  532.  * in the auto_index and auto_pkg_index arrays.  Existing entries are over
  533.  * written.
  534.  *
  535.  * Parameters
  536.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  537.  *   o tlibFilePath (I) - Absolute path name to the library file.
  538.  *   o tndxFilePath (I) - Absolute path name to the library file index.
  539.  * Returns:
  540.  *   TCL_OK or TCL_ERROR.
  541.  *-----------------------------------------------------------------------------
  542.  */
  543. static int
  544. ProcessIndexFile (interp, tlibFilePath, tndxFilePath)
  545.      Tcl_Interp *interp;
  546.      char       *tlibFilePath;
  547.      char       *tndxFilePath;
  548. {
  549.     FILE        *indexFilePtr = NULL;
  550.     Tcl_DString  lineBuffer;
  551.     int          lineArgc, idx, result, status;
  552.     char       **lineArgv = NULL;
  553.  
  554.     Tcl_DStringInit (&lineBuffer);
  555.  
  556.     indexFilePtr = fopen (tndxFilePath, "r");
  557.     if (indexFilePtr == NULL)
  558.         goto fileError;
  559.     
  560.     while (TRUE) {
  561.         Tcl_DStringFree (&lineBuffer);
  562.         status = Tcl_DStringGets (indexFilePtr, &lineBuffer);
  563.         if (status == TCL_BREAK)
  564.             goto reachedEOF;
  565.         if (status == TCL_ERROR)
  566.             goto fileError;
  567.  
  568.         if ((Tcl_SplitList (interp, lineBuffer.string, &lineArgc,
  569.                             &lineArgv) != TCL_OK) || (lineArgc < 4))
  570.             goto formatError;
  571.         
  572.         /*
  573.          * lineArgv [0] is the package name.
  574.          * lineArgv [1] is the package offset in the library.
  575.          * lineArgv [2] is the package length in the library.
  576.          * lineArgv [3-n] are the entry procedures for the package.
  577.          */
  578.         result = SetPackageIndexEntry (interp, lineArgv [0], tlibFilePath,
  579.                                        lineArgv [1], lineArgv [2]);
  580.         if (result == TCL_ERROR)
  581.             goto errorExit;
  582.  
  583.         /*
  584.          * If the package is not duplicated, add the commands to load
  585.          * the procedures.
  586.          */
  587.         if (result != TCL_CONTINUE) {
  588.             for (idx = 3; idx < lineArgc; idx++) {
  589.                 if (SetProcIndexEntry (interp, lineArgv [idx],
  590.                                        lineArgv [0]) != TCL_OK)
  591.                     goto errorExit;
  592.             }
  593.         }
  594.         ckfree ((char *) lineArgv);
  595.         lineArgv = NULL;
  596.     }
  597.  
  598.   reachedEOF:
  599.     fclose (indexFilePtr);
  600.     Tcl_DStringFree (&lineBuffer);
  601.  
  602.     return TCL_OK;
  603.  
  604.     /*
  605.      * Handle format error in library input line.
  606.      */
  607.   formatError:
  608.     Tcl_ResetResult (interp);
  609.     Tcl_AppendResult (interp, "format error in library index \"",
  610.                       tndxFilePath, "\" (", lineBuffer.string, ")",
  611.                       (char *) NULL);
  612.     goto errorExit;
  613.  
  614.  
  615.   fileError:
  616.     Tcl_AppendResult (interp, "error accessing package index file \"",
  617.                       tndxFilePath, "\": ", Tcl_PosixError (interp),
  618.                       (char *) NULL);
  619.     goto errorExit;
  620.  
  621.     /*
  622.      * Error exit here, releasing resources and closing the file.
  623.      */
  624.   errorExit:
  625.     if (lineArgv != NULL)
  626.         ckfree ((char *) lineArgv);
  627.     Tcl_DStringFree (&lineBuffer);
  628.     if (indexFilePtr != NULL)
  629.         fclose (indexFilePtr);
  630.     return TCL_ERROR;
  631. }
  632.  
  633. /*
  634.  *-----------------------------------------------------------------------------
  635.  * BuildPackageIndex --
  636.  *
  637.  * Call the "buildpackageindex" Tcl procedure to rebuild a package index.
  638.  * This is found with the [info library] command.
  639.  *
  640.  * Parameters
  641.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  642.  *   o tlibFilePath (I) - Absolute path name to the library file.
  643.  * Returns:
  644.  *   TCL_OK or TCL_ERROR.
  645.  *
  646.  * ????Change name to auto something.
  647.  *-----------------------------------------------------------------------------
  648.  */
  649. static int
  650. BuildPackageIndex (interp, tlibFilePath)
  651.      Tcl_Interp *interp;
  652.      char       *tlibFilePath;
  653. {
  654.     Tcl_DString  command;
  655.     int          result;
  656.  
  657.     Tcl_DStringInit (&command);
  658.  
  659.     Tcl_DStringAppend (&command, "source [info library]/buildidx.tcl;", -1);
  660.     Tcl_DStringAppend (&command, "buildpackageindex ", -1);
  661.     Tcl_DStringAppend (&command, tlibFilePath, -1);
  662.  
  663.     result = Tcl_GlobalEval (interp, command.string);
  664.  
  665.     Tcl_DStringFree (&command);
  666.  
  667.     if (result == TCL_ERROR)
  668.         return TCL_ERROR;
  669.     Tcl_ResetResult (interp);
  670.     return result;
  671. }
  672.  
  673. /*
  674.  *-----------------------------------------------------------------------------
  675.  * LoadPackageIndex --
  676.  *
  677.  * Load a package .tndx file.  Rebuild .tlib if non-existant or out of
  678.  * date.
  679.  *
  680.  * Parameters
  681.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  682.  *   o tlibFilePath (I) - Absolute path name to the library file.
  683.  * Returns:
  684.  *   TCL_OK or TCL_ERROR.
  685.  *-----------------------------------------------------------------------------
  686.  */
  687. static int
  688. LoadPackageIndex (interp, tlibFilePath)
  689.     Tcl_Interp *interp;
  690.     char       *tlibFilePath;
  691. {
  692.     Tcl_DString  tndxFilePath;
  693.     struct stat  tlibStat;
  694.     struct stat  tndxStat;
  695.  
  696.     Tcl_DStringInit (&tndxFilePath);
  697.  
  698.     Tcl_DStringAppend (&tndxFilePath, tlibFilePath, -1);
  699.     tndxFilePath.string [tndxFilePath.length - 3] = 'n';
  700.     tndxFilePath.string [tndxFilePath.length - 2] = 'd';
  701.     tndxFilePath.string [tndxFilePath.length - 1] = 'x';
  702.  
  703.     /*
  704.      * Get library's modification time.  If the file can't be accessed, set
  705.      * time so the library does not get built.  Other code will report the
  706.      * error.
  707.      */
  708.     if (stat (tlibFilePath, &tlibStat) < 0)
  709.         tlibStat.st_mtime = MAXINT;
  710.  
  711.     /*
  712.      * Get the time for the index.  If the file does not exists or is
  713.      * out of date, rebuild it.
  714.      */
  715.     if ((stat (tndxFilePath.string, &tndxStat) < 0) ||
  716.         (tndxStat.st_mtime < tlibStat.st_mtime)) {
  717.         if (BuildPackageIndex (interp, tlibFilePath) != TCL_OK)
  718.             goto errorExit;
  719.     }
  720.  
  721.     if (ProcessIndexFile (interp, tlibFilePath, tndxFilePath.string) != TCL_OK)
  722.         goto errorExit;
  723.     Tcl_DStringFree (&tndxFilePath);
  724.     return TCL_OK;
  725.  
  726.   errorExit:
  727.     AddLibIndexErrorInfo (interp, tndxFilePath.string);
  728.     Tcl_DStringFree (&tndxFilePath);
  729.  
  730.     return TCL_ERROR;
  731. }
  732.  
  733. /*
  734.  *-----------------------------------------------------------------------------
  735.  * LoadOusterIndex --
  736.  *
  737.  * Load a standard Tcl index (tclIndex).  A special proc is used so that the
  738.  * "dir" variable can be set.
  739.  *
  740.  * Parameters
  741.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  742.  *   o indexFilePath (I) - Absolute path name to the tclIndex file.
  743.  * Returns:
  744.  *   TCL_OK or TCL_ERROR.
  745.  * Notes:
  746.  *   The real work of loading an index is done by a procedure that is defined
  747.  * in a seperate file.  Its not possible to put this file in the standard
  748.  * tcl.tlib as a tclIndex might get loaded before the tcl.tndx file is found
  749.  * on the search path.  The function sources [info library]/loadouster.tcl
  750.  * if it has not been loaded before.
  751.  *-----------------------------------------------------------------------------
  752.  */
  753. static int
  754. LoadOusterIndex (interp, indexFilePath)
  755.      Tcl_Interp *interp;
  756.      char       *indexFilePath;
  757. {
  758.     Tcl_DString  command;
  759.     Tcl_CmdInfo  loadCmdInfo;
  760.     
  761.     Tcl_DStringInit (&command);
  762.  
  763.     /*
  764.      * Check if "auto_load_ouster_index" is defined, if its not, source
  765.      * the file that defines it.
  766.      */
  767.     if (!Tcl_GetCommandInfo (interp,
  768.                              "auto_load_ouster_index",
  769.                              &loadCmdInfo)) {
  770.         if (Tcl_GlobalEval (interp, loadOusterCmd) == TCL_ERROR)
  771.             goto errorExit;
  772.     }
  773.  
  774.     /*
  775.      * Now, actually do the load.
  776.      */
  777.     Tcl_DStringAppendElement (&command, "auto_load_ouster_index");
  778.     Tcl_DStringAppendElement (&command, indexFilePath);
  779.  
  780.     if (Tcl_GlobalEval (interp, command.string) == TCL_ERROR)
  781.         goto errorExit;
  782.  
  783.     Tcl_DStringFree (&command);
  784.     Tcl_ResetResult (interp);
  785.     return TCL_OK;
  786.  
  787.   errorExit:
  788.     AddLibIndexErrorInfo (interp, indexFilePath);
  789.     Tcl_DStringFree (&command);
  790.     return TCL_ERROR;
  791. }
  792.  
  793. /*
  794.  *-----------------------------------------------------------------------------
  795.  * LoadDirIndexes --
  796.  *
  797.  *     Load the indexes for all package library (.tlib) or a Ousterhout
  798.  *  "tclIndex" file in a directory.  Nonexistent or unreadable directories
  799.  *  are skipped.
  800.  *
  801.  * Parameters
  802.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  803.  *   o dirName (I) - The absolute path name of the directory to search for
  804.  *     libraries.
  805.  *-----------------------------------------------------------------------------
  806.  */
  807. static int
  808. LoadDirIndexes (interp, dirName)
  809.     Tcl_Interp  *interp;
  810.     char        *dirName;
  811. {
  812.     DIR           *dirPtr;
  813.     struct dirent *entryPtr;
  814.     int            dirNameLen, nameLen;
  815.     Tcl_DString    filePath;
  816.  
  817.     dirPtr = opendir (dirName);
  818.     if (dirPtr == NULL)
  819.         return TCL_OK;   /* Skip directory */
  820.  
  821.     Tcl_DStringInit (&filePath);
  822.     Tcl_DStringAppend (&filePath, dirName, -1);
  823.     Tcl_DStringAppend (&filePath, "/",     -1);
  824.  
  825.     dirNameLen = strlen (dirName) + 1;  /* Include `/' */
  826.  
  827.     while (TRUE) {
  828.         entryPtr = readdir (dirPtr);
  829.         if (entryPtr == NULL)
  830.             break;
  831.         nameLen = strlen (entryPtr->d_name);
  832.  
  833.         if ((nameLen > 5) && 
  834.             ((STREQU (entryPtr->d_name + nameLen - 5, ".tlib")) ||
  835.              (STREQU (entryPtr->d_name, "tclIndex")))) {
  836.  
  837.             /*
  838.              * Append the file name on to the directory.
  839.              */
  840.             Tcl_DStringTrunc (&filePath, dirNameLen);
  841.             Tcl_DStringAppend (&filePath, entryPtr->d_name, -1);
  842.  
  843.             /*
  844.              * Skip index it can't be accessed.
  845.              */
  846.             if (access (filePath.string, R_OK) < 0)
  847.                 continue;
  848.  
  849.             /*
  850.              * Process the index according to its type.
  851.              */
  852.             if (entryPtr->d_name [nameLen - 5] == '.') {
  853.                 if (LoadPackageIndex (interp, filePath.string) != TCL_OK)
  854.                     goto errorExit;
  855.             } else {
  856.                 if (LoadOusterIndex (interp, filePath.string) != TCL_OK)
  857.                     goto errorExit;
  858.             }
  859.         }
  860.     }
  861.  
  862.     Tcl_DStringFree (&filePath);
  863.     closedir (dirPtr);
  864.     return TCL_OK;
  865.  
  866.   errorExit:
  867.     Tcl_DStringFree (&filePath);
  868.     closedir (dirPtr);
  869.     return TCL_ERROR;
  870. }
  871.  
  872. /*
  873.  *-----------------------------------------------------------------------------
  874.  * LoadPackageIndexes --
  875.  *
  876.  * Loads the all indexes for all package libraries (.tlib) or a Ousterhout
  877.  * "tclIndex" files found in all directories in the path.  The path is search
  878.  * backwards so that index entries first in the path will override those 
  879.  * later on in the path.
  880.  *-----------------------------------------------------------------------------
  881.  */
  882. static int
  883. LoadPackageIndexes (interp, infoPtr, path)
  884.     Tcl_Interp  *interp;
  885.     libInfo_t   *infoPtr;
  886.     char        *path;
  887. {
  888.     char        *dirName;
  889.     Tcl_DString  dirNameBuf;
  890.     int          idx, pathArgc, result = TCL_OK;
  891.     char       **pathArgv;
  892.  
  893.     Tcl_DStringInit (&dirNameBuf);
  894.  
  895.     if (infoPtr->doingIdxSearch) {
  896.         Tcl_AppendResult (interp, "recursive load of indexes ",
  897.                           "(probable invalid command while loading index)",
  898.                           (char *) NULL);
  899.         return TCL_ERROR;
  900.     }
  901.     infoPtr->doingIdxSearch = TRUE;
  902.  
  903.     if (Tcl_SplitList (interp, path, &pathArgc, &pathArgv) != TCL_OK) {
  904.         infoPtr->doingIdxSearch = FALSE;
  905.         return TCL_ERROR;
  906.     }
  907.  
  908.     for (idx = pathArgc - 1; idx >= 0; idx--) {
  909.         /*
  910.          * Get the absolute dir name.  if the conversion fails (most likely
  911.          * invalid "~") or the directory can't be read, skip it.
  912.          */
  913.         dirName = MakeAbsFile (interp, pathArgv [idx], &dirNameBuf);
  914.         if (dirName == NULL)
  915.             continue;
  916.         
  917.         if (access (dirName, X_OK) == 0)
  918.             result = LoadDirIndexes (interp, dirName);
  919.         else
  920.             result = TCL_OK;
  921.  
  922.         Tcl_DStringFree (&dirNameBuf);
  923.         if (result != TCL_OK)
  924.             break;
  925.     }
  926.  
  927.     ckfree ((char *) pathArgv);
  928.     infoPtr->doingIdxSearch = FALSE;
  929.     return result;
  930. }
  931.  
  932. /*
  933.  *-----------------------------------------------------------------------------
  934.  * Tcl_Auto_load_pkgCmd --
  935.  *
  936.  *   Implements the command:
  937.  *      auto_load_pkg package
  938.  *
  939.  * Which is called to load a .tlib package who's index has already been loaded.
  940.  *-----------------------------------------------------------------------------
  941.  */
  942. static int
  943. Tcl_Auto_load_pkgCmd (dummy, interp, argc, argv)
  944.     ClientData   dummy;
  945.     Tcl_Interp  *interp;
  946.     int          argc;
  947.     char       **argv;
  948. {
  949.     char     *fileName;
  950.     long      offset;
  951.     unsigned  length;
  952.     int       result;
  953.  
  954.     if (argc != 2) {
  955.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " package",
  956.                           (char *) NULL);
  957.         return TCL_ERROR;
  958.     }
  959.  
  960.     if (GetPackageIndexEntry (interp, argv [1], &fileName, &offset,
  961.                               &length) != TCL_OK)
  962.         return TCL_ERROR;
  963.  
  964.     result = EvalFilePart (interp, fileName, offset, length);
  965.     ckfree (fileName);
  966.  
  967.     return result;
  968. }
  969.  
  970. /*
  971.  *-----------------------------------------------------------------------------
  972.  * AddInProgress --
  973.  *
  974.  *   An a command to the table of in progress commands.  If the command is
  975.  * already in the table, return an error.
  976.  *
  977.  * Parameters
  978.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  979.  *   o infoPtr (I) - Interpreter specific library info.
  980.  *   o command (I) - The command to add.
  981.  * Returns:
  982.  *   TCL_OK or TCL_ERROR.
  983.  *-----------------------------------------------------------------------------
  984.  */
  985. static int
  986. AddInProgress (interp, infoPtr, command)
  987.     Tcl_Interp  *interp;
  988.     libInfo_t   *infoPtr;
  989.     char        *command;
  990. {
  991.     int  newEntry;
  992.  
  993.     Tcl_CreateHashEntry (&infoPtr->inProgressTbl, command, &newEntry);
  994.  
  995.     if (!newEntry) {
  996.         Tcl_AppendResult (interp, "recursive auto_load of \"",
  997.                           command, "\"", (char *) NULL);
  998.         return TCL_ERROR;
  999.     }
  1000.     return TCL_OK;
  1001. }
  1002.  
  1003. /*
  1004.  *-----------------------------------------------------------------------------
  1005.  * RemoveInProgress --
  1006.  *
  1007.  *   Remove a command from the in progress table.
  1008.  *
  1009.  * Parameters
  1010.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  1011.  *   o infoPtr (I) - Interpreter specific library info.
  1012.  *   o command (I) - The command to remove.
  1013.  *-----------------------------------------------------------------------------
  1014.  */
  1015. static void
  1016. RemoveInProgress (interp, infoPtr, command)
  1017.     Tcl_Interp  *interp;
  1018.     libInfo_t   *infoPtr;
  1019.     char        *command;
  1020. {
  1021.     Tcl_HashEntry *entryPtr;
  1022.  
  1023.     entryPtr = Tcl_FindHashEntry (&infoPtr->inProgressTbl, command);
  1024.     if (entryPtr == NULL)
  1025.         panic ("lost in-progress command");
  1026.  
  1027.     Tcl_DeleteHashEntry (entryPtr);
  1028. }
  1029.  
  1030. /*
  1031.  *-----------------------------------------------------------------------------
  1032.  * LoadAutoPath --
  1033.  *
  1034.  *   Load all indexs on the auto_path variable.  If auto_path has not changed
  1035.  * since the last time libraries were successfully loaded, this is a no-op.
  1036.  *
  1037.  * Parameters
  1038.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  1039.  *   o infoPtr (I) - Interpreter specific library info.
  1040.  * Returns:
  1041.  *   TCL_OK or TCL_ERROR
  1042.  *-----------------------------------------------------------------------------
  1043.  */
  1044. static int
  1045. LoadAutoPath (interp, infoPtr)
  1046.     Tcl_Interp  *interp;
  1047.     libInfo_t   *infoPtr;
  1048. {
  1049.     char  *path, *oldPath;
  1050.  
  1051.     path = Tcl_GetVar (interp, AUTO_PATH, TCL_GLOBAL_ONLY);
  1052.     if (path == NULL)
  1053.         return TCL_OK;
  1054.  
  1055.     oldPath = Tcl_GetVar (interp, AUTO_OLDPATH, TCL_GLOBAL_ONLY);
  1056.  
  1057.     /*
  1058.      * Check if the path has changed.  If it has, load indexes, and
  1059.      * save the path if it succeeds.
  1060.      */
  1061.     if ((oldPath != NULL) && STREQU (path, oldPath))
  1062.         return TCL_OK;
  1063.  
  1064.     if (LoadPackageIndexes (interp, infoPtr, path) != TCL_OK)
  1065.         return TCL_ERROR;
  1066.  
  1067.     if (Tcl_SetVar (interp, AUTO_OLDPATH, path,
  1068.                     TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL)
  1069.         return TCL_ERROR;
  1070.  
  1071.     return TCL_OK;
  1072. }
  1073.  
  1074. /*
  1075.  *-----------------------------------------------------------------------------
  1076.  * LoadCommand --
  1077.  *
  1078.  *   Check the "auto_index" array for code to load a command and eval it.
  1079.  *
  1080.  * Parameters
  1081.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  1082.  *   o command (I) - The command to load.
  1083.  * Returns:
  1084.  *   TCL_OK if the command was loaded.
  1085.  *   TCL_CONTINUE if the command is not in the index.
  1086.  *   TCL_ERROR if an error occured.
  1087.  *-----------------------------------------------------------------------------
  1088.  */
  1089. static int
  1090. LoadCommand (interp, command)
  1091.     Tcl_Interp  *interp;
  1092.     char        *command;
  1093. {
  1094.     char              *loadCmd;
  1095.     ClientData         clientData;
  1096.     Tcl_CmdDeleteProc *deleteProc;
  1097.     Tcl_CmdInfo        cmdInfo;
  1098.  
  1099.     loadCmd = Tcl_GetVar2 (interp, AUTO_INDEX, command, TCL_GLOBAL_ONLY);
  1100.     if (loadCmd == NULL)
  1101.         return TCL_CONTINUE;   /* Not found */
  1102.  
  1103.     if (Tcl_GlobalEval (interp, loadCmd) == TCL_ERROR)
  1104.         return TCL_ERROR;
  1105.     Tcl_ResetResult (interp);
  1106.  
  1107.     if (Tcl_GetCommandInfo (interp, command, &cmdInfo))
  1108.         return TCL_OK;  /* Found and loaded */
  1109.  
  1110.     Tcl_AppendResult (interp, "command \"", command, "\" was defined in a Tcl",
  1111.                       " library index, but not in a Tcl library",
  1112.                       (char *) NULL);
  1113.     return TCL_ERROR;
  1114. }
  1115.  
  1116. /*
  1117.  *-----------------------------------------------------------------------------
  1118.  * Tcl_LoadlibindexCmd --
  1119.  *
  1120.  *   This procedure is invoked to process the "Loadlibindex" Tcl command:
  1121.  *
  1122.  *      loadlibindex libfile
  1123.  *
  1124.  * which loads the index for a package library (.tlib) or a Ousterhout
  1125.  * "tclIndex" file.  New package definitions will override existing ones.
  1126.  *-----------------------------------------------------------------------------
  1127.  */
  1128. static int
  1129. Tcl_LoadlibindexCmd (dummy, interp, argc, argv)
  1130.     ClientData   dummy;
  1131.     Tcl_Interp  *interp;
  1132.     int          argc;
  1133.     char       **argv;
  1134. {
  1135.     char        *pathName;
  1136.     Tcl_DString  pathNameBuf;
  1137.     int          pathLen;
  1138.  
  1139.     Tcl_DStringInit (&pathNameBuf);
  1140.  
  1141.     if (argc != 2) {
  1142.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " libFile",
  1143.                           (char *) NULL);
  1144.         return TCL_ERROR;
  1145.     }
  1146.  
  1147.     pathName = MakeAbsFile (interp, argv [1], &pathNameBuf);
  1148.     if (pathName == NULL)
  1149.         return TCL_ERROR;
  1150.  
  1151.     /*
  1152.      * Find the length of the directory name. Validate that we have a .tlib
  1153.      * extension or file name is "tclIndex" and call the routine to process
  1154.      * the specific type of index.
  1155.      */
  1156.     pathLen = strlen (pathName);
  1157.  
  1158.     if ((pathLen > 5) && (pathName [pathLen - 5] == '.')) {
  1159.         if (!STREQU (pathName + pathLen - 5, ".tlib"))
  1160.             goto invalidName;
  1161.         if (LoadPackageIndex (interp, pathName) != TCL_OK)
  1162.             goto errorExit;
  1163.     } else {
  1164.         if (!STREQU (pathName + pathLen - 9, "/tclIndex"))
  1165.             goto invalidName;
  1166.         if (LoadOusterIndex (interp, pathName) != TCL_OK)
  1167.             goto errorExit;
  1168.     }
  1169.     Tcl_DStringFree (&pathNameBuf);
  1170.     return TCL_OK;
  1171.  
  1172.   invalidName:
  1173.     Tcl_AppendResult (interp, "invalid library name, must have an extension ",
  1174.                       "of \".tlib\" or the name \"tclIndex\", got \"",
  1175.                       argv [1], "\"", (char *) NULL);
  1176.  
  1177.   errorExit:
  1178.     Tcl_DStringFree (&pathNameBuf);
  1179.     return TCL_ERROR;;
  1180. }
  1181.  
  1182. /*
  1183.  *-----------------------------------------------------------------------------
  1184.  * Tcl_auto_loadCmd --
  1185.  *
  1186.  *   This procedure is invoked to process the "auto_load" Tcl command:
  1187.  *
  1188.  *         auto_load ?command?
  1189.  *
  1190.  * which searchs the auto_load tables for the specified procedure.  If it
  1191.  * is not found, an attempt is made to load unloaded library indexes by
  1192.  * searching auto_path.
  1193.  *-----------------------------------------------------------------------------
  1194.  */
  1195. static int
  1196. Tcl_Auto_loadCmd (clientData, interp, argc, argv)
  1197.     ClientData   clientData;
  1198.     Tcl_Interp  *interp;
  1199.     int          argc;
  1200.     char       **argv;
  1201. {
  1202.     libInfo_t *infoPtr = (libInfo_t *) clientData;
  1203.     int        result;
  1204.     char      *msg;
  1205.  
  1206.     if (argc > 2) {
  1207.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " ?command?",
  1208.                           (char *) NULL);
  1209.         return TCL_ERROR;
  1210.     }
  1211.  
  1212.     /*
  1213.      * If no command is specified, just load the indexs.
  1214.      */
  1215.     if (argc == 1)
  1216.         return LoadAutoPath (interp, infoPtr);
  1217.  
  1218.     /*
  1219.      * Do checking for recursive auto_load of the same command.
  1220.      */
  1221.     if (AddInProgress (interp, infoPtr, argv [1]) != TCL_OK)
  1222.         return TCL_ERROR;
  1223.  
  1224.     /*
  1225.      * First, attempt to load it from the indexes in memory.
  1226.      */
  1227.     result = LoadCommand (interp, argv [1]);
  1228.     if (result == TCL_ERROR)
  1229.         goto errorExit;
  1230.     if (result == TCL_OK)
  1231.         goto found;
  1232.     
  1233.     /*
  1234.      * Slow path, load the libraries indices on auto_path.
  1235.      */
  1236.     if (LoadAutoPath (interp, infoPtr) != TCL_OK)
  1237.         goto errorExit;
  1238.  
  1239.     /*
  1240.      * Try to load the command again.
  1241.      */
  1242.     result = LoadCommand (interp, argv [1]);
  1243.     if (result == TCL_ERROR)
  1244.         goto errorExit;
  1245.     if (result != TCL_OK)
  1246.         goto notFound;
  1247.  
  1248.   found:
  1249.     RemoveInProgress (interp, infoPtr, argv [1]);
  1250.     interp->result = "1";
  1251.     return TCL_OK;
  1252.  
  1253.   notFound:
  1254.     RemoveInProgress (interp, infoPtr, argv [1]);
  1255.     interp->result = "0";
  1256.     return TCL_OK;
  1257.  
  1258.   errorExit:
  1259.     msg = ckalloc (strlen (argv [1]) + 35);
  1260.     strcpy (msg, "\n    while auto loading \"");
  1261.     strcat (msg, argv [1]);
  1262.     strcat (msg, "\"");
  1263.     Tcl_AddErrorInfo (interp, msg);
  1264.     ckfree (msg);
  1265.  
  1266.     RemoveInProgress (interp, infoPtr, argv [1]);
  1267.     return TCL_ERROR;
  1268. }
  1269.  
  1270. /*
  1271.  *-----------------------------------------------------------------------------
  1272.  * TclLibCleanUp --
  1273.  *
  1274.  *   Release the client data area when the interpreter is deleted.
  1275.  *-----------------------------------------------------------------------------
  1276.  */
  1277. static void
  1278. TclLibCleanUp (clientData, interp)
  1279.     ClientData  clientData;
  1280.     Tcl_Interp *interp;
  1281. {
  1282.     libInfo_t      *infoPtr = (libInfo_t *) clientData;
  1283.     Tcl_HashSearch  searchCookie;
  1284.     Tcl_HashEntry  *entryPtr;
  1285.  
  1286.     entryPtr = Tcl_FirstHashEntry (&infoPtr->inProgressTbl, &searchCookie);
  1287.  
  1288.     while (entryPtr != NULL) {
  1289.         Tcl_DeleteHashEntry (entryPtr);
  1290.         entryPtr = Tcl_NextHashEntry (&searchCookie);
  1291.     }
  1292.  
  1293.     Tcl_DeleteHashTable (&infoPtr->inProgressTbl);
  1294.     ckfree ((char *) infoPtr);
  1295. }
  1296.  
  1297. /*
  1298.  *-----------------------------------------------------------------------------
  1299.  * TclXLib_Init --
  1300.  *
  1301.  *   Initialize the Extended Tcl library facility commands.
  1302.  *-----------------------------------------------------------------------------
  1303.  */
  1304. int
  1305. TclXLib_Init (interp)
  1306.     Tcl_Interp *interp;
  1307. {
  1308.     libInfo_t *infoPtr;
  1309.  
  1310.     infoPtr = (libInfo_t *) ckalloc (sizeof (libInfo_t));
  1311.  
  1312.     Tcl_InitHashTable (&infoPtr->inProgressTbl, TCL_STRING_KEYS);
  1313.     infoPtr->doingIdxSearch = FALSE;
  1314.  
  1315.     Tcl_CallWhenDeleted (interp, TclLibCleanUp, (ClientData) infoPtr);
  1316.  
  1317.     Tcl_CreateCommand (interp, "auto_load_pkg", Tcl_Auto_load_pkgCmd,
  1318.                       (ClientData) infoPtr, (void (*)()) NULL);
  1319.     Tcl_CreateCommand (interp, "auto_load", Tcl_Auto_loadCmd,
  1320.                       (ClientData) infoPtr, (void (*)()) NULL);
  1321.     Tcl_CreateCommand (interp, "loadlibindex", Tcl_LoadlibindexCmd,
  1322.                       (ClientData) infoPtr, (void (*)()) NULL);
  1323.     return TCL_OK;
  1324. }
  1325.  
  1326.