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 / tclXfilecmds.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-01-23  |  20.1 KB  |  693 lines
  1. /*
  2.  * tclXfilecmds.c
  3.  *
  4.  * Extended Tcl pipe, copyfile and lgets commands.
  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: tclXfilecmds.c,v 3.1 1994/01/23 17:00:28 markd Exp $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18. /* 
  19.  *-----------------------------------------------------------------------------
  20.  * Note: List parsing code stolen from Tcl distribution file tclUtil.c,
  21.  * procedure TclFindElement.
  22.  *-----------------------------------------------------------------------------
  23.  * Copyright (c) 1987-1993 The Regents of the University of California.
  24.  * All rights reserved.
  25.  *
  26.  * Permission is hereby granted, without written agreement and without
  27.  * license or royalty fees, to use, copy, modify, and distribute this
  28.  * software and its documentation for any purpose, provided that the
  29.  * above copyright notice and the following two paragraphs appear in
  30.  * all copies of this software.
  31.  * 
  32.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  33.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  34.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  35.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  36.  *
  37.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  38.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  39.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  40.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  41.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  42.  *-----------------------------------------------------------------------------
  43.  */
  44.  
  45. #include "tclExtdInt.h"
  46.  
  47. /*
  48.  * Prototypes of internal functions.
  49.  */
  50. static int
  51. CopyOpenFile _ANSI_ARGS_((Tcl_Interp *interp,
  52.                           long        maxBytes,
  53.                           FILE       *inFilePtr,
  54.                           FILE       *outFilePtr));
  55.  
  56. static int
  57. GetsListElement _ANSI_ARGS_((Tcl_Interp    *interp,
  58.                              FILE          *filePtr,
  59.                              Tcl_DString   *bufferPtr,
  60.                              int           *idxPtr));
  61.  
  62. /*
  63.  *-----------------------------------------------------------------------------
  64.  *
  65.  * Tcl_PipeCmd --
  66.  *     Implements the pipe TCL command:
  67.  *         pipe ?fileId_var_r fileId_var_w?
  68.  *
  69.  * Results:
  70.  *      Standard TCL result.
  71.  *-----------------------------------------------------------------------------
  72.  */
  73. int
  74. Tcl_PipeCmd (clientData, interp, argc, argv)
  75.     ClientData  clientData;
  76.     Tcl_Interp *interp;
  77.     int         argc;
  78.     char      **argv;
  79. {
  80.     int   fileNums [2];
  81.     char  fileIds [12];
  82.  
  83.     if (!((argc == 1) || (argc == 3))) {
  84.         Tcl_AppendResult (interp, tclXWrongArgs, argv[0], 
  85.                           " ?fileId_var_r fileId_var_w?", (char*) NULL);
  86.         return TCL_ERROR;
  87.     }
  88.  
  89.     if (pipe (fileNums) < 0) {
  90.         interp->result = Tcl_PosixError (interp);
  91.         return TCL_ERROR;
  92.     }
  93.  
  94.     if (Tcl_SetupFileEntry (interp, fileNums [0], TCL_FILE_READABLE) == NULL)
  95.         goto errorExit;
  96.     if (Tcl_SetupFileEntry (interp, fileNums [1], TCL_FILE_WRITABLE) == NULL)
  97.         goto errorExit;
  98.  
  99.     if (argc == 1)      
  100.         sprintf (interp->result, "file%d file%d", fileNums [0], fileNums [1]);
  101.     else {
  102.         sprintf (fileIds, "file%d", fileNums [0]);
  103.         if (Tcl_SetVar (interp, argv[1], fileIds, TCL_LEAVE_ERR_MSG) == NULL)
  104.             goto errorExit;
  105.  
  106.         sprintf (fileIds, "file%d", fileNums [1]);
  107.         if (Tcl_SetVar (interp, argv[2], fileIds, TCL_LEAVE_ERR_MSG) == NULL)
  108.             goto errorExit;
  109.         Tcl_ResetResult (interp);
  110.     }
  111.         
  112.     return TCL_OK;
  113.  
  114.   errorExit:
  115.     Tcl_CloseForError (interp, fileNums [0]);
  116.     Tcl_CloseForError (interp, fileNums [1]);
  117.     return TCL_ERROR;
  118. }
  119.  
  120. /*
  121.  *-----------------------------------------------------------------------------
  122.  *
  123.  * CopyOpenFile --
  124.  * 
  125.  *  Utility function to copy an open file to another open file.
  126.  *
  127.  * Parameters:
  128.  *   o interp (I) - Error messages are returned in the interpreter.
  129.  *   o maxBytes (I) - Maximum number of bytes to copy.
  130.  *   o inFilePtr (I) - Input file.
  131.  *   o outFilePtr (I) - Output file.
  132.  * Returns:
  133.  *    The number of bytes transfered or -1 on an error.
  134.  *
  135.  *-----------------------------------------------------------------------------
  136.  */
  137. static int
  138. CopyOpenFile (interp, maxBytes, inFilePtr, outFilePtr)
  139.     Tcl_Interp *interp;
  140.     long        maxBytes;
  141.     FILE       *inFilePtr;
  142.     FILE       *outFilePtr;
  143. {
  144.     char   buffer [2048];
  145.     long   bytesToRead, bytesRead, totalBytesRead, bytesLeft;
  146.  
  147.     bytesLeft = maxBytes;
  148.     totalBytesRead = 0;
  149.  
  150.     while (bytesLeft > 0) {
  151.         bytesToRead = sizeof (buffer);
  152.         if (bytesToRead > bytesLeft)
  153.             bytesToRead = bytesLeft;
  154.  
  155.         bytesRead = fread (buffer, sizeof (char), bytesToRead, inFilePtr);
  156.         if (bytesRead <= 0) {
  157.             if (feof (inFilePtr))
  158.                 break;
  159.             else
  160.                 goto unixError;
  161.         }
  162.         if (fwrite (buffer, sizeof (char), bytesRead, outFilePtr) != bytesRead)
  163.             goto unixError;
  164.  
  165.         bytesLeft -= bytesRead;
  166.         totalBytesRead += bytesRead;
  167.     }
  168.  
  169.     if (fflush (outFilePtr) != 0)
  170.         goto unixError;
  171.  
  172.     return totalBytesRead;
  173.  
  174.   unixError:
  175.     interp->result = Tcl_PosixError (interp);
  176.     return -1;
  177. }
  178.  
  179. /*
  180.  *-----------------------------------------------------------------------------
  181.  *
  182.  * Tcl_CopyfileCmd --
  183.  *     Implements the copyfile TCL command:
  184.  *         copyfile ?-bytes num|-maxbytes num? fromFileId toFileId
  185.  *
  186.  * Results:
  187.  *      The number of bytes transfered or an error.
  188.  *
  189.  *-----------------------------------------------------------------------------
  190.  */
  191. int
  192. Tcl_CopyfileCmd (clientData, interp, argc, argv)
  193.     ClientData  clientData;
  194.     Tcl_Interp *interp;
  195.     int         argc;
  196.     char      **argv;
  197. {
  198. #define TCL_COPY_ALL        0
  199. #define TCL_COPY_BYTES      1
  200. #define TCL_COPY_MAX_BYTES  2
  201.  
  202.     FILE  *inFilePtr, *outFilePtr;
  203.     long   bytesToRead, bytesRead, totalBytesToRead, totalBytesRead, bytesLeft;
  204.     int    copyMode;
  205.  
  206.     if (!(argc == 3 || argc == 5))
  207.         goto wrongArgs;
  208.  
  209.     if (argc == 5) {
  210.         if (STREQU (argv [1], "-bytes")) 
  211.             copyMode = TCL_COPY_BYTES;
  212.         else if (STREQU (argv [1], "-maxbytes"))
  213.             copyMode = TCL_COPY_MAX_BYTES;
  214.         else
  215.             goto invalidOption;
  216.  
  217.         if (Tcl_GetLong (interp, argv [2], &totalBytesToRead) != TCL_OK)
  218.             return TCL_ERROR;
  219.     } else {
  220.         copyMode = TCL_COPY_ALL;
  221.         totalBytesToRead = MAXLONG;
  222.     }
  223.  
  224.     if (Tcl_GetOpenFile (interp, argv [argc - 2],
  225.                          FALSE,  /* Read access  */
  226.                          TRUE,   /* Check access */  
  227.                          &inFilePtr) != TCL_OK)
  228.         return TCL_ERROR;
  229.  
  230.     if (Tcl_GetOpenFile (interp, argv [argc - 1],
  231.                          TRUE,   /* Write access */
  232.                          TRUE,   /* Check access */
  233.                          &outFilePtr) != TCL_OK)
  234.         return TCL_ERROR;
  235.  
  236.     totalBytesRead = CopyOpenFile (interp, totalBytesToRead,
  237.                                    inFilePtr, outFilePtr);
  238.     if (totalBytesRead < 0)
  239.         return TCL_ERROR;
  240.  
  241.     /*
  242.      * Return an error if -bytes were specified and not that many were
  243.      * available.
  244.      */
  245.     if ((copyMode == TCL_COPY_BYTES) &&
  246.         (totalBytesToRead > 0) && (totalBytesRead != totalBytesToRead)) {
  247.  
  248.         sprintf (interp->result,
  249.                  "premature EOF, %ld bytes expected, %ld bytes actually read",
  250.                  totalBytesToRead, totalBytesRead);
  251.         return TCL_ERROR;
  252.     }
  253.  
  254.     sprintf (interp->result, "%ld", totalBytesRead);
  255.     return TCL_OK;
  256.  
  257.   wrongArgs:
  258.     Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  259.                       " ?-bytes num|-maxbytes num? fromFileId toFileId",
  260.                       (char *) NULL);
  261.     return TCL_ERROR;
  262.  
  263.   invalidOption:
  264.     Tcl_AppendResult (interp, "expect \"-bytes\" or \"-maxbytes\", got \"",
  265.                       argv [1], "\"", (char *) NULL);
  266.     return TCL_ERROR;
  267.  
  268. }
  269.  
  270. /*
  271.  *-----------------------------------------------------------------------------
  272.  *
  273.  * GetsListElement --
  274.  *
  275.  *   Parse through a line read from a file for a list element.  If the end of
  276.  * the string is reached while still in the list element, read another line.
  277.  *
  278.  * Paramaters:
  279.  *   o interp (I) - Errors are returned in result.
  280.  *   o filePtr (I) - The file to read from.
  281.  *   o bufferPtr (I) - Buffer that file is read into.  The first line of the
  282.  *     list should already have been read in.
  283.  *   o idxPtr (I/O) - Pointer to the index of the next element in the buffer.
  284.  *     initialize to zero before the first call.
  285.  * Returns:
  286.  *   o TCL_OK if an element was validated but there are more in the buffer.
  287.  *   o TCL_BREAK if the end of the list was reached.
  288.  *   o TCL_ERROR if an error occured.
  289.  * Notes:
  290.  *   Code is a modified version of UCB procedure tclUtil.c:TclFindElement
  291.  *-----------------------------------------------------------------------------
  292.  */
  293. static int
  294. GetsListElement (interp, filePtr, bufferPtr, idxPtr)
  295.     Tcl_Interp    *interp;
  296.     FILE          *filePtr;
  297.     Tcl_DString   *bufferPtr;
  298.     int           *idxPtr;
  299. {
  300.     register char *p;
  301.     int openBraces = 0;
  302.     int inQuotes = 0;
  303.  
  304.     p = bufferPtr->string + *idxPtr;
  305.  
  306.     /*
  307.      * Skim off leading white space and check for an opening brace or
  308.      * quote.
  309.      */
  310.     
  311.     while (ISSPACE(*p)) {
  312.         p++;
  313.     }
  314.     if (*p == '{') {
  315.         openBraces = 1;
  316.         p++;
  317.     } else if (*p == '"') {
  318.         inQuotes = 1;
  319.         p++;
  320.     }
  321.  
  322.     /*
  323.      * Find the end of the element (either a space or a close brace or
  324.      * the end of the string).
  325.      */
  326.  
  327.     while (1) {
  328.         switch (*p) {
  329.  
  330.             /*
  331.              * Open brace: don't treat specially unless the element is
  332.              * in braces.  In this case, keep a nesting count.
  333.              */
  334.  
  335.             case '{':
  336.                 if (openBraces != 0) {
  337.                     openBraces++;
  338.                 }
  339.                 break;
  340.  
  341.             /*
  342.              * Close brace: if element is in braces, keep nesting
  343.              * count and quit when the last close brace is seen.
  344.              */
  345.  
  346.             case '}':
  347.                 if (openBraces == 1) {
  348.                     char *p2;
  349.  
  350.                     p++;
  351.                     if (ISSPACE(*p) || (*p == 0)) {
  352.                         goto done;
  353.                     }
  354.                     for (p2 = p; (*p2 != 0) && (!isspace(*p2)) && (p2 < p+20);
  355.                             p2++) {
  356.                         /* null body */
  357.                     }
  358.                     Tcl_ResetResult(interp);
  359.                     sprintf(interp->result,
  360.                             "list element in braces followed by \"%.*s\" instead of space in list read from file",
  361.                             p2-p, p);
  362.                     return TCL_ERROR;
  363.                 } else if (openBraces != 0) {
  364.                     openBraces--;
  365.                 }
  366.                 break;
  367.  
  368.             /*
  369.              * Backslash:  skip over everything up to the end of the
  370.              * backslash sequence.
  371.              */
  372.  
  373.             case '\\': {
  374.                 int size;
  375.  
  376.                 (void) Tcl_Backslash(p, &size);
  377.                 p += size - 1;
  378.                 break;
  379.             }
  380.  
  381.             /*
  382.              * Space: ignore if element is in braces or quotes;  otherwise
  383.              * terminate element.
  384.              */
  385.  
  386.             case ' ':
  387.             case '\f':
  388.             case '\n':
  389.             case '\r':
  390.             case '\t':
  391.             case '\v':
  392.                 if ((openBraces == 0) && !inQuotes) {
  393.                     goto done;
  394.                 }
  395.                 break;
  396.  
  397.             /*
  398.              * Double-quote:  if element is in quotes then terminate it.
  399.              */
  400.  
  401.             case '"':
  402.                 if (inQuotes) {
  403.                     char *p2;
  404.  
  405.                     p++;
  406.                     if (ISSPACE(*p) || (*p == 0)) {
  407.                         goto done;
  408.                     }
  409.                     for (p2 = p; (*p2 != 0) && (!isspace(*p2)) && (p2 < p+20);
  410.                             p2++) {
  411.                         /* null body */
  412.                     }
  413.                     Tcl_ResetResult(interp);
  414.                     sprintf(interp->result,
  415.                             "list element in quotes followed by \"%.*s\" %s",
  416.                             p2-p, p, "instead of space in list read from file");
  417.                     return TCL_ERROR;
  418.                 }
  419.                 break;
  420.  
  421.             /*
  422.              * End of line, read and append another line if in braces or
  423.              * quotes. Replace the '\0' with the newline that was in the sting.
  424.              * Reset scan pointer (p) in case of buffer realloc.
  425.              */
  426.  
  427.             case 0: {
  428.                 char *oldString;
  429.                 int   stat;
  430.                 
  431.                 if ((openBraces == 0) && (inQuotes == 0))
  432.                     goto done;
  433.  
  434.                 oldString = bufferPtr->string;
  435.                 Tcl_DStringAppend (bufferPtr, "\n", -1);
  436.  
  437.                 stat = Tcl_DStringGets (filePtr, bufferPtr); 
  438.                 if (stat == TCL_ERROR)
  439.                     goto fileError;
  440.                 
  441.                 p = bufferPtr->string + (p - oldString);
  442.                 if (stat == TCL_OK)
  443.                     break;  /* Got some data */
  444.                 /*
  445.                  * EOF in list error.
  446.                  */
  447.                 if (openBraces != 0) {
  448.                     Tcl_SetResult(interp,
  449.                             "unmatched open brace in list read from file (at EOF)",
  450.                             TCL_STATIC);
  451.                     return TCL_ERROR;
  452.                 } else {
  453.                     Tcl_SetResult(interp,
  454.                             "unmatched open quote in list read from file (at EOF)",
  455.                             TCL_STATIC);
  456.                     return TCL_ERROR;
  457.                 }
  458.             }
  459.         }
  460.         p++;
  461.     }
  462.  
  463.     done:
  464.     while (ISSPACE(*p)) {
  465.         p++;
  466.     }
  467.     *idxPtr = p - bufferPtr->string;
  468.     return (*p == '\0') ? TCL_BREAK : TCL_OK;
  469.  
  470.     fileError:
  471.     Tcl_AppendResult (interp, "error reading list from file: ",
  472.                       Tcl_PosixError (interp), (char *) NULL);
  473.     return TCL_ERROR;
  474. }
  475.  
  476. /*
  477.  *-----------------------------------------------------------------------------
  478.  *
  479.  * Tcl_LgetsCmd --
  480.  *
  481.  * Implements the `lgets' Tcl command:
  482.  *    lgets fileId ?varName?
  483.  *
  484.  * Results:
  485.  *      A standard Tcl result.
  486.  *
  487.  * Side effects:
  488.  *      See the user documentation.
  489.  *
  490.  *-----------------------------------------------------------------------------
  491.  */
  492. int
  493. Tcl_LgetsCmd (notUsed, interp, argc, argv)
  494.     ClientData   notUsed;
  495.     Tcl_Interp  *interp;
  496.     int          argc;
  497.     char       **argv;
  498. {
  499.     FILE        *filePtr;
  500.     Tcl_DString  buffer;
  501.     int          stat, bufIdx = 0;
  502.  
  503.     if ((argc != 2) && (argc != 3)) {
  504.         Tcl_AppendResult (interp, tclXWrongArgs, argv[0],
  505.                           " fileId ?varName?", (char *) NULL);
  506.         return TCL_ERROR;
  507.     }
  508.     if (Tcl_GetOpenFile (interp, argv[1],
  509.                          FALSE,  /* Read access  */
  510.                          TRUE,   /* Check access */
  511.                          &filePtr) != TCL_OK) {
  512.         return TCL_ERROR;
  513.     }
  514.  
  515.     /*
  516.      * Read the list, parsing off each element until the list is read.
  517.      * More lines are read if newlines are encountered in the middle of
  518.      * a list.
  519.      */
  520.     Tcl_DStringInit (&buffer);
  521.  
  522.     stat = Tcl_DStringGets (filePtr, &buffer);
  523.     if (stat == TCL_ERROR)
  524.         goto readError;
  525.  
  526.     while (stat != TCL_BREAK) {
  527.         stat = GetsListElement (interp, filePtr, &buffer, &bufIdx);
  528.         if (stat == TCL_ERROR)
  529.             goto errorExit;
  530.     }
  531.  
  532.     /*
  533.      * Return the string as a result or in a variable.
  534.      */
  535.     if (argc == 2) {
  536.         Tcl_DStringResult (interp, &buffer);
  537.     } else {
  538.         if (Tcl_SetVar (interp, argv[2], buffer.string,
  539.                         TCL_LEAVE_ERR_MSG) == NULL)
  540.             goto errorExit;
  541.  
  542.         if (feof (filePtr) && (buffer.length == 0))
  543.             interp->result = "-1";
  544.         else
  545.             sprintf (interp->result, "%d", buffer.length);
  546.  
  547.         Tcl_DStringFree (&buffer);
  548.     }
  549.     return TCL_OK;
  550.  
  551. readError:
  552.     Tcl_AppendResult (interp, "error reading list from file: ",
  553.                       Tcl_PosixError (interp), (char *) NULL);
  554.     clearerr (filePtr);
  555.  
  556. errorExit:
  557.     Tcl_DStringFree (&buffer);
  558.     return TCL_ERROR;
  559.  
  560. }
  561.  
  562.  
  563. /*
  564.  *-----------------------------------------------------------------------------
  565.  *
  566.  * Tcl_FrenameCmd --
  567.  *     Implements the frename TCL command:
  568.  *         frename oldPath newPath
  569.  *
  570.  * Results:
  571.  *      Standard TCL result.
  572.  *-----------------------------------------------------------------------------
  573.  */
  574. int
  575. Tcl_FrenameCmd (clientData, interp, argc, argv)
  576.     ClientData  clientData;
  577.     Tcl_Interp *interp;
  578.     int         argc;
  579.     char      **argv;
  580. {
  581.     Tcl_DString    tildeBuf1, tildeBuf2;
  582.     char          *oldPath, *newPath;
  583.  
  584.     if (argc != 3) {
  585.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  586.                           " oldPath newPath", (char *) NULL);
  587.         return TCL_ERROR;
  588.     }
  589.  
  590.     Tcl_DStringInit (&tildeBuf1);
  591.     Tcl_DStringInit (&tildeBuf2);
  592.     
  593.     oldPath = argv [1];
  594.     if (oldPath [0] == '~') {
  595.         oldPath = Tcl_TildeSubst (interp, oldPath, &tildeBuf1);
  596.         if (oldPath == NULL)
  597.             goto errorExit;
  598.     }
  599.  
  600.     newPath = argv [2];
  601.     if (newPath [0] == '~') {
  602.         newPath = Tcl_TildeSubst (interp, newPath, &tildeBuf2);
  603.         if (newPath == NULL)
  604.             goto errorExit;
  605.     }
  606.  
  607.     if (rename (oldPath, newPath) != 0) {
  608.         Tcl_AppendResult (interp, "rename \"", argv [1], "\" to \"", argv [2],
  609.                           "\" failed: ", Tcl_PosixError (interp),
  610.                           (char *) NULL);
  611.         return TCL_ERROR;
  612.     }
  613.  
  614.     
  615.     Tcl_DStringFree (&tildeBuf1);
  616.     Tcl_DStringFree (&tildeBuf2);
  617.     return TCL_OK;
  618.  
  619.   errorExit:
  620.     Tcl_DStringFree (&tildeBuf1);
  621.     Tcl_DStringFree (&tildeBuf2);
  622.     return TCL_ERROR;
  623. }
  624.  
  625.  
  626. /*
  627.  *-----------------------------------------------------------------------------
  628.  *
  629.  * Tcl_ReaddirCmd --
  630.  *     Implements the rename TCL command:
  631.  *         readdir dirPath
  632.  *
  633.  * Results:
  634.  *      Standard TCL result.
  635.  *-----------------------------------------------------------------------------
  636.  */
  637. int
  638. Tcl_ReaddirCmd (clientData, interp, argc, argv)
  639.     ClientData  clientData;
  640.     Tcl_Interp *interp;
  641.     int         argc;
  642.     char      **argv;
  643. {
  644.     Tcl_DString    tildeBuf;
  645.     char          *dirPath;
  646.     DIR           *dirPtr;
  647.     struct dirent *entryPtr;
  648.  
  649.     if (argc != 2) {
  650.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  651.                           " dirPath", (char *) NULL);
  652.         return TCL_ERROR;
  653.     }
  654.  
  655.     Tcl_DStringInit (&tildeBuf);
  656.  
  657.     dirPath = argv [1];
  658.     if (dirPath [0] == '~') {
  659.         dirPath = Tcl_TildeSubst (interp, dirPath, &tildeBuf);
  660.         if (dirPath == NULL)
  661.             goto errorExit;
  662.     }
  663.  
  664.     dirPtr = opendir (dirPath);
  665.     if (dirPtr == NULL)  {
  666.         Tcl_AppendResult (interp, dirPath, ": ", Tcl_PosixError (interp),
  667.                           (char *) NULL);
  668.         goto errorExit;
  669.     }
  670.  
  671.     while (TRUE) {
  672.         entryPtr = readdir (dirPtr);
  673.         if (entryPtr == NULL)
  674.             break;
  675.         if (entryPtr->d_name [0] == '.') {
  676.             if (entryPtr->d_name [1] == '\0')
  677.                 continue;
  678.             if ((entryPtr->d_name [1] == '.') &&
  679.                 (entryPtr->d_name [2] == '\0'))
  680.                 continue;
  681.         }
  682.         Tcl_AppendElement (interp, entryPtr->d_name);
  683.     }
  684.     closedir (dirPtr);
  685.     Tcl_DStringFree (&tildeBuf);
  686.     return TCL_OK;
  687.  
  688.   errorExit:
  689.     Tcl_DStringFree (&tildeBuf);
  690.     return TCL_ERROR;
  691. }
  692.  
  693.