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