/[dtapublic]/projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclfcmd.c

Diff of /projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclfcmd.c

Parent Directory | Revision Log | View Patch Patch

-revision 64 by dashley,
Sun Oct 30 04:21:11 2016 UTC
+revision 71 by dashley,
Sat Nov  5 11:07:06 2016 UTC
 Line 1
  /* $Header$ */
  /*
   * tclFCmd.c
   *
   *      This file implements the generic portion of file manipulation
   *      subcommands of the "file" command.
   *
   * Copyright (c) 1996-1998 Sun Microsystems, Inc.
   *
   * See the file "license.terms" for information on usage and redistribution
   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
   *
   * RCS: @(#) $Id: tclfcmd.c,v 1.1.1.1 2001/06/13 04:39:01 dtashley Exp $
   */
  #include "tclInt.h"
  #include "tclPort.h"
  /*
   * Declarations for local procedures defined in this file:
   */
  static int              CopyRenameOneFile _ANSI_ARGS_((Tcl_Interp *interp,
                              char *source, char *dest, int copyFlag,
                              int force));
  static char *           FileBasename _ANSI_ARGS_((Tcl_Interp *interp,
                              char *path, Tcl_DString *bufferPtr));
  static int              FileCopyRename _ANSI_ARGS_((Tcl_Interp *interp,
                              int argc, char **argv, int copyFlag));
  static int              FileForceOption _ANSI_ARGS_((Tcl_Interp *interp,
                              int argc, char **argv, int *forcePtr));
  /*
   *---------------------------------------------------------------------------
   *
   * TclFileRenameCmd
   *
   *      This procedure implements the "rename" subcommand of the "file"
   *      command.  Filename arguments need to be translated to native
   *      format before being passed to platform-specific code that
   *      implements rename functionality.
   *
   * Results:
   *      A standard Tcl result.
   *
   * Side effects:
   *      See the user documentation.
   *
   *---------------------------------------------------------------------------
   */
  int
  TclFileRenameCmd(interp, argc, argv)
      Tcl_Interp *interp;         /* Interp for error reporting. */
      int argc;                   /* Number of arguments. */
      char **argv;                /* Argument strings passed to Tcl_FileCmd. */
  {
      return FileCopyRename(interp, argc, argv, 0);
  }
  /*
   *---------------------------------------------------------------------------
   *
   * TclFileCopyCmd
   *
   *      This procedure implements the "copy" subcommand of the "file"
   *      command.  Filename arguments need to be translated to native
   *      format before being passed to platform-specific code that
   *      implements copy functionality.
   *
   * Results:
   *      A standard Tcl result.
   *
   * Side effects:
   *      See the user documentation.
   *
   *---------------------------------------------------------------------------
   */
  int
  TclFileCopyCmd(interp, argc, argv)
      Tcl_Interp *interp;         /* Used for error reporting */
      int argc;                   /* Number of arguments. */
      char **argv;                /* Argument strings passed to Tcl_FileCmd. */
  {
      return FileCopyRename(interp, argc, argv, 1);
  }
  /*
   *---------------------------------------------------------------------------
   *
   * FileCopyRename --
   *
   *      Performs the work of TclFileRenameCmd and TclFileCopyCmd.
   *      See comments for those procedures.
   *
   * Results:
   *      See above.
   *
   * Side effects:
   *      See above.
   *
   *---------------------------------------------------------------------------
   */
  static int
  FileCopyRename(interp, argc, argv, copyFlag)
      Tcl_Interp *interp;         /* Used for error reporting. */
      int argc;                   /* Number of arguments. */
      char **argv;                /* Argument strings passed to Tcl_FileCmd. */
      int copyFlag;               /* If non-zero, copy source(s).  Otherwise,
                                   * rename them. */
  {
      int i, result, force;
      struct stat statBuf;
      Tcl_DString targetBuffer;
      char *target;
      i = FileForceOption(interp, argc - 2, argv + 2, &force);
      if (i < 0) {
          return TCL_ERROR;
      }
      i += 2;
      if ((argc - i) < 2) {
          Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                  " ", argv[1], " ?options? source ?source ...? target\"",
                  (char *) NULL);
          return TCL_ERROR;
      }
      /*
       * If target doesn't exist or isn't a directory, try the copy/rename.
       * More than 2 arguments is only valid if the target is an existing
       * directory.
       */
      target = Tcl_TranslateFileName(interp, argv[argc - 1], &targetBuffer);
      if (target == NULL) {
          return TCL_ERROR;
      }
      result = TCL_OK;
      /*
       * Call TclStat() so that if target is a symlink that points to a
       * directory we will put the sources in that directory instead of
       * overwriting the symlink.
       */
      if ((TclStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
          if ((argc - i) > 2) {
              errno = ENOTDIR;
              Tcl_PosixError(interp);
              Tcl_AppendResult(interp, "error ",
                      ((copyFlag) ? "copying" : "renaming"), ": target \"",
                      argv[argc - 1], "\" is not a directory", (char *) NULL);
              result = TCL_ERROR;
          } else {
              /*
               * Even though already have target == translated(argv[i+1]),
               * pass the original argument down, so if there's an error, the
               * error message will reflect the original arguments.
               */
              result = CopyRenameOneFile(interp, argv[i], argv[i + 1], copyFlag,
                      force);
          }
          Tcl_DStringFree(&targetBuffer);
          return result;
      }
      /*
       * Move each source file into target directory.  Extract the basename
       * from each source, and append it to the end of the target path.
       */
      for ( ; i < argc - 1; i++) {
          char *jargv[2];
          char *source, *newFileName;
          Tcl_DString sourceBuffer, newFileNameBuffer;
          source = FileBasename(interp, argv[i], &sourceBuffer);
          if (source == NULL) {
              result = TCL_ERROR;
              break;
          }
          jargv[0] = argv[argc - 1];
          jargv[1] = source;
          Tcl_DStringInit(&newFileNameBuffer);
          newFileName = Tcl_JoinPath(2, jargv, &newFileNameBuffer);
          result = CopyRenameOneFile(interp, argv[i], newFileName, copyFlag,
                  force);
          Tcl_DStringFree(&sourceBuffer);
          Tcl_DStringFree(&newFileNameBuffer);
          if (result == TCL_ERROR) {
              break;
          }
      }
      Tcl_DStringFree(&targetBuffer);
      return result;
  }
  /*
   *---------------------------------------------------------------------------
   *
   * TclFileMakeDirsCmd
   *
   *      This procedure implements the "mkdir" subcommand of the "file"
   *      command.  Filename arguments need to be translated to native
   *      format before being passed to platform-specific code that
   *      implements mkdir functionality.
   *
   * Results:
   *      A standard Tcl result.
   *
   * Side effects:
   *      See the user documentation.
   *
   *----------------------------------------------------------------------
   */
  int
  TclFileMakeDirsCmd(interp, argc, argv)
      Tcl_Interp *interp;         /* Used for error reporting. */
      int argc;                   /* Number of arguments */
      char **argv;                /* Argument strings passed to Tcl_FileCmd. */
  {
      Tcl_DString nameBuffer, targetBuffer;
      char *errfile;
      int result, i, j, pargc;
      char **pargv;
      struct stat statBuf;
      pargv = NULL;
      errfile = NULL;
      Tcl_DStringInit(&nameBuffer);
      Tcl_DStringInit(&targetBuffer);
      result = TCL_OK;
      for (i = 2; i < argc; i++) {
          char *name = Tcl_TranslateFileName(interp, argv[i], &nameBuffer);
          if (name == NULL) {
              result = TCL_ERROR;
              break;
          }
          Tcl_SplitPath(name, &pargc, &pargv);
          if (pargc == 0) {
              errno = ENOENT;
              errfile = argv[i];
              break;
          }
          for (j = 0; j < pargc; j++) {
              char *target = Tcl_JoinPath(j + 1, pargv, &targetBuffer);
              /*
               * Call TclStat() so that if target is a symlink that points
               * to a directory we will create subdirectories in that
               * directory.
               */
              if (TclStat(target, &statBuf) == 0) {
                  if (!S_ISDIR(statBuf.st_mode)) {
                      errno = EEXIST;
                      errfile = target;
                      goto done;
                  }
              } else if ((errno != ENOENT)
                      || (TclpCreateDirectory(target) != TCL_OK)) {
                  errfile = target;
                  goto done;
              }
              Tcl_DStringFree(&targetBuffer);
          }
          ckfree((char *) pargv);
          pargv = NULL;
          Tcl_DStringFree(&nameBuffer);
      }
      done:
      if (errfile != NULL) {
          Tcl_AppendResult(interp, "can't create directory \"",
                  errfile, "\": ", Tcl_PosixError(interp), (char *) NULL);
          result = TCL_ERROR;
      }
      Tcl_DStringFree(&nameBuffer);
      Tcl_DStringFree(&targetBuffer);
      if (pargv != NULL) {
          ckfree((char *) pargv);
      }
      return result;
  }
  /*
   *----------------------------------------------------------------------
   *
   * TclFileDeleteCmd
   *
   *      This procedure implements the "delete" subcommand of the "file"
   *      command.
   *
   * Results:
   *      A standard Tcl result.
   *
   * Side effects:
   *      See the user documentation.
   *
   *----------------------------------------------------------------------
   */
  int
  TclFileDeleteCmd(interp, argc, argv)
      Tcl_Interp *interp;         /* Used for error reporting */
      int argc;                   /* Number of arguments */
      char **argv;                /* Argument strings passed to Tcl_FileCmd. */
  {
      Tcl_DString nameBuffer, errorBuffer;
      int i, force, result;
      char *errfile;
      i = FileForceOption(interp, argc - 2, argv + 2, &force);
      if (i < 0) {
          return TCL_ERROR;
      }
      i += 2;
      if ((argc - i) < 1) {
          Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                  " ", argv[1], " ?options? file ?file ...?\"", (char *) NULL);
          return TCL_ERROR;
      }
      errfile = NULL;
      result = TCL_OK;
      Tcl_DStringInit(&errorBuffer);
      Tcl_DStringInit(&nameBuffer);
      for ( ; i < argc; i++) {
          struct stat statBuf;
          char *name;
          errfile = argv[i];
          Tcl_DStringSetLength(&nameBuffer, 0);
          name = Tcl_TranslateFileName(interp, argv[i], &nameBuffer);
          if (name == NULL) {
              result = TCL_ERROR;
              goto done;
          }
          /*
           * Call lstat() to get info so can delete symbolic link itself.
           */
          if (TclpLstat(name, &statBuf) != 0) {
              /*
               * Trying to delete a file that does not exist is not
               * considered an error, just a no-op
               */
              if (errno != ENOENT) {
                  result = TCL_ERROR;
              }
          } else if (S_ISDIR(statBuf.st_mode)) {
              result = TclpRemoveDirectory(name, force, &errorBuffer);
              if (result != TCL_OK) {
                  if ((force == 0) && (errno == EEXIST)) {
                      Tcl_AppendResult(interp, "error deleting \"", argv[i],
                              "\": directory not empty", (char *) NULL);
                      Tcl_PosixError(interp);
                      goto done;
                  }
                  /*
                   * If possible, use the untranslated name for the file.
                   */
                  errfile = Tcl_DStringValue(&errorBuffer);
                  if (strcmp(name, errfile) == 0) {
                      errfile = argv[i];
                  }
              }
          } else {
              result = TclpDeleteFile(name);
          }
          if (result == TCL_ERROR) {
              break;
          }
      }
      if (result != TCL_OK) {
          Tcl_AppendResult(interp, "error deleting \"", errfile,
                  "\": ", Tcl_PosixError(interp), (char *) NULL);
      }
      done:
      Tcl_DStringFree(&errorBuffer);
      Tcl_DStringFree(&nameBuffer);
      return result;
  }
  /*
   *---------------------------------------------------------------------------
   *
   * CopyRenameOneFile
   *
   *      Copies or renames specified source file or directory hierarchy
   *      to the specified target.
   *
   * Results:
   *      A standard Tcl result.
   *
   * Side effects:
   *      Target is overwritten if the force flag is set.  Attempting to
   *      copy/rename a file onto a directory or a directory onto a file
   *      will always result in an error.
   *
   *----------------------------------------------------------------------
   */
  static int
  CopyRenameOneFile(interp, source, target, copyFlag, force)
      Tcl_Interp *interp;         /* Used for error reporting. */
      char *source;               /* Pathname of file to copy.  May need to
                                   * be translated. */
      char *target;               /* Pathname of file to create/overwrite.
                                   * May need to be translated. */
      int copyFlag;               /* If non-zero, copy files.  Otherwise,
                                   * rename them. */
      int force;                  /* If non-zero, overwrite target file if it
                                   * exists.  Otherwise, error if target already
                                   * exists. */
  {
      int result;
      Tcl_DString sourcePath, targetPath, errorBuffer;
      char *targetName, *sourceName, *errfile;
      struct stat sourceStatBuf, targetStatBuf;
      sourceName = Tcl_TranslateFileName(interp, source, &sourcePath);
      if (sourceName == NULL) {
          return TCL_ERROR;
      }
      targetName = Tcl_TranslateFileName(interp, target, &targetPath);
      if (targetName == NULL) {
          Tcl_DStringFree(&sourcePath);
          return TCL_ERROR;
      }
      errfile = NULL;
      result = TCL_ERROR;
      Tcl_DStringInit(&errorBuffer);
      /*
       * We want to copy/rename links and not the files they point to, so we
       * use lstat(). If target is a link, we also want to replace the
       * link and not the file it points to, so we also use lstat() on the
       * target.
       */
      if (TclpLstat(sourceName, &sourceStatBuf) != 0) {
          errfile = source;
          goto done;
      }
      if (TclpLstat(targetName, &targetStatBuf) != 0) {
          if (errno != ENOENT) {
              errfile = target;
              goto done;
          }
      } else {
          if (force == 0) {
              errno = EEXIST;
              errfile = target;
              goto done;
          }
          /*
           * Prevent copying or renaming a file onto itself.  Under Windows,
           * stat always returns 0 for st_ino.  However, the Windows-specific
           * code knows how to deal with copying or renaming a file on top of
           * itself.  It might be a good idea to write a stat that worked.
           */
          if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
              if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
                      (sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
                  result = TCL_OK;
                  goto done;
              }
          }
          /*
           * Prevent copying/renaming a file onto a directory and
           * vice-versa.  This is a policy decision based on the fact that
           * existing implementations of copy and rename on all platforms
           * also prevent this.
           */
          if (S_ISDIR(sourceStatBuf.st_mode)
                  && !S_ISDIR(targetStatBuf.st_mode)) {
              errno = EISDIR;
              Tcl_AppendResult(interp, "can't overwrite file \"", target,
                      "\" with directory \"", source, "\"", (char *) NULL);
              goto done;
          }
          if (!S_ISDIR(sourceStatBuf.st_mode)
                  && S_ISDIR(targetStatBuf.st_mode)) {
              errno = EISDIR;
              Tcl_AppendResult(interp, "can't overwrite directory \"", target,
                      "\" with file \"", source, "\"", (char *) NULL);
              goto done;
          }
      }
      if (copyFlag == 0) {
          result = TclpRenameFile(sourceName, targetName);
          if (result == TCL_OK) {
              goto done;
          }
          if (errno == EINVAL) {
              Tcl_AppendResult(interp, "error renaming \"", source, "\" to \"",
                      target, "\": trying to rename a volume or ",
                      "move a directory into itself", (char *) NULL);
              goto done;
          } else if (errno != EXDEV) {
              errfile = target;
              goto done;
          }
          /*
           * The rename failed because the move was across file systems.
           * Fall through to copy file and then remove original.  Note that
           * the low-level TclpRenameFile is allowed to implement
           * cross-filesystem moves itself.
           */
      }
      if (S_ISDIR(sourceStatBuf.st_mode)) {
          result = TclpCopyDirectory(sourceName, targetName, &errorBuffer);
          if (result != TCL_OK) {
              errfile = Tcl_DStringValue(&errorBuffer);
              if (strcmp(errfile, sourceName) == 0) {
                  errfile = source;
              } else if (strcmp(errfile, targetName) == 0) {
                  errfile = target;
              }
          }
      } else {
          result = TclpCopyFile(sourceName, targetName);
          if (result != TCL_OK) {
              /*
               * Well, there really shouldn't be a problem with source,
               * because up there we checked to see if it was ok to copy it.
               */
              errfile = target;
          }
      }
      if ((copyFlag == 0) && (result == TCL_OK)) {
          if (S_ISDIR(sourceStatBuf.st_mode)) {
              result = TclpRemoveDirectory(sourceName, 1, &errorBuffer);
              if (result != TCL_OK) {
                  errfile = Tcl_DStringValue(&errorBuffer);
                  if (strcmp(errfile, sourceName) == 0) {
                      errfile = source;
                  }
              }
          } else {
              result = TclpDeleteFile(sourceName);
              if (result != TCL_OK) {
                  errfile = source;
              }
          }
          if (result != TCL_OK) {
              Tcl_AppendResult(interp, "can't unlink \"", errfile, "\": ",
                      Tcl_PosixError(interp), (char *) NULL);
              errfile = NULL;
          }
      }
      done:
      if (errfile != NULL) {
          Tcl_AppendResult(interp,
                  ((copyFlag) ? "error copying \"" : "error renaming \""),
                  source, (char *) NULL);
          if (errfile != source) {
              Tcl_AppendResult(interp, "\" to \"", target, (char *) NULL);
              if (errfile != target) {
                  Tcl_AppendResult(interp, "\": \"", errfile, (char *) NULL);
              }
          }
          Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp),
                  (char *) NULL);
      }
      Tcl_DStringFree(&errorBuffer);
      Tcl_DStringFree(&sourcePath);
      Tcl_DStringFree(&targetPath);
      return result;
  }
  /*
   *---------------------------------------------------------------------------
   *
   * FileForceOption --
   *
   *      Helps parse command line options for file commands that take
   *      the "-force" and "--" options.
   *
   * Results:
   *      The return value is how many arguments from argv were consumed
   *      by this function, or -1 if there was an error parsing the
   *      options.  If an error occurred, an error message is left in the
   *      interp's result.
   *
   * Side effects:
   *      None.
   *
   *---------------------------------------------------------------------------
   */
  static int
  FileForceOption(interp, argc, argv, forcePtr)
      Tcl_Interp *interp;         /* Interp, for error return. */
      int argc;                   /* Number of arguments. */
      char **argv;                /* Argument strings.  First command line
                                   * option, if it exists, begins at 0. */
      int *forcePtr;              /* If the "-force" was specified, *forcePtr
                                   * is filled with 1, otherwise with 0. */
  {
      int force, i;
      force = 0;
      for (i = 0; i < argc; i++) {
          if (argv[i][0] != '-') {
              break;
          }
          if (strcmp(argv[i], "-force") == 0) {
              force = 1;
          } else if (strcmp(argv[i], "--") == 0) {
              i++;
              break;
          } else {
              Tcl_AppendResult(interp, "bad option \"", argv[i],
                      "\": should be -force or --", (char *)NULL);
              return -1;
          }
      }
      *forcePtr = force;
      return i;
  }
  /*
   *---------------------------------------------------------------------------
   *
   * FileBasename --
   *
   *      Given a path in either tcl format (with / separators), or in the
   *      platform-specific format for the current platform, return all the
   *      characters in the path after the last directory separator.  But,
   *      if path is the root directory, returns no characters.
   *
   * Results:
   *      Appends the string that represents the basename to the end of
   *      the specified initialized DString, returning a pointer to the
   *      resulting string.  If there is an error, an error message is left
   *      in interp, NULL is returned, and the Tcl_DString is unmodified.
   *
   * Side effects:
   *      None.
   *
   *---------------------------------------------------------------------------
   */
  static char *
  FileBasename(interp, path, bufferPtr)
      Tcl_Interp *interp;         /* Interp, for error return. */
      char *path;                 /* Path whose basename to extract. */
      Tcl_DString *bufferPtr;     /* Initialized DString that receives
                                   * basename. */
  {
      int argc;
      char **argv;
      Tcl_SplitPath(path, &argc, &argv);
      if (argc == 0) {
          Tcl_DStringInit(bufferPtr);
      } else {
          if ((argc == 1) && (*path == '~')) {
              Tcl_DString buffer;
              ckfree((char *) argv);
              path = Tcl_TranslateFileName(interp, path, &buffer);
              if (path == NULL) {
                  return NULL;
              }
              Tcl_SplitPath(path, &argc, &argv);
              Tcl_DStringFree(&buffer);
          }
          Tcl_DStringInit(bufferPtr);
          /*
           * Return the last component, unless it is the only component, and it
           * is the root of an absolute path.
           */
          if (argc > 0) {
              if ((argc > 1)
                      || (Tcl_GetPathType(argv[0]) == TCL_PATH_RELATIVE)) {
                  Tcl_DStringAppend(bufferPtr, argv[argc - 1], -1);
              }
          }
      }
      ckfree((char *) argv);
      return Tcl_DStringValue(bufferPtr);
  }
  /*
   *----------------------------------------------------------------------
   *
   * TclFileAttrsCmd --
   *
   *      Sets or gets the platform-specific attributes of a file. The objc-objv
   *      points to the file name with the rest of the command line following.
   *      This routine uses platform-specific tables of option strings
   *      and callbacks. The callback to get the attributes take three
   *      parameters:
   *          Tcl_Interp *interp;     The interp to report errors with.
   *                                  Since this is an object-based API,
   *                                  the object form of the result should be
   *                                  used.
   *          CONST char *fileName;   This is extracted using
   *                                  Tcl_TranslateFileName.
   *          TclObj **attrObjPtrPtr; A new object to hold the attribute
   *                                  is allocated and put here.
   *      The first two parameters of the callback used to write out the
   *      attributes are the same. The third parameter is:
   *          CONST *attrObjPtr;      A pointer to the object that has
   *                                  the new attribute.
   *      They both return standard TCL errors; if the routine to get
   *      an attribute fails, no object is allocated and *attrObjPtrPtr
   *      is unchanged.
   *
   * Results:
   *      Standard TCL error.
   *
   * Side effects:
   *      May set file attributes for the file name.
   *
   *----------------------------------------------------------------------
   */
  int
  TclFileAttrsCmd(interp, objc, objv)
      Tcl_Interp *interp;         /* The interpreter for error reporting. */
      int objc;                   /* Number of command line arguments. */
      Tcl_Obj *CONST objv[];      /* The command line objects. */
  {
      char *fileName;
      int result;
      Tcl_DString buffer;
      if (objc < 3) {
          Tcl_WrongNumArgs(interp, 2, objv,
                  "name ?option? ?value? ?option value ...?");
          return TCL_ERROR;
      }
      fileName = Tcl_GetString(objv[2]);
      fileName = Tcl_TranslateFileName(interp, fileName, &buffer);
      if (fileName == NULL) {
          return TCL_ERROR;
      }
      objc -= 3;
      objv += 3;
      result = TCL_ERROR;
      if (objc == 0) {
          /*
           * Get all attributes.
           */
          int index;
          Tcl_Obj *listPtr, *objPtr;
          listPtr = Tcl_NewListObj(0, NULL);
          for (index = 0; tclpFileAttrStrings[index] != NULL; index++) {
              objPtr = Tcl_NewStringObj(tclpFileAttrStrings[index], -1);
              Tcl_ListObjAppendElement(interp, listPtr, objPtr);
              if ((*tclpFileAttrProcs[index].getProc)(interp, index, fileName,
                      &objPtr) != TCL_OK) {
                  Tcl_DecrRefCount(listPtr);
                  goto end;
              }
              Tcl_ListObjAppendElement(interp, listPtr, objPtr);
          }
          Tcl_SetObjResult(interp, listPtr);
      } else if (objc == 1) {
          /*
           * Get one attribute.
           */
          int index;
          Tcl_Obj *objPtr;
          if (Tcl_GetIndexFromObj(interp, objv[0], tclpFileAttrStrings,
                  "option", 0, &index) != TCL_OK) {
              goto end;
          }
          if ((*tclpFileAttrProcs[index].getProc)(interp, index, fileName,
                  &objPtr) != TCL_OK) {
              goto end;
          }
          Tcl_SetObjResult(interp, objPtr);
      } else {
          /*
           * Set option/value pairs.
           */
          int i, index;
          for (i = 0; i < objc ; i += 2) {
              if (Tcl_GetIndexFromObj(interp, objv[i], tclpFileAttrStrings,
                      "option", 0, &index) != TCL_OK) {
                  goto end;
              }
              if (i + 1 == objc) {
                  Tcl_AppendResult(interp, "value for \"",
                          Tcl_GetString(objv[i]), "\" missing",
                          (char *) NULL);
                  goto end;
              }
              if ((*tclpFileAttrProcs[index].setProc)(interp, index, fileName,
                      objv[i + 1]) != TCL_OK) {
                  goto end;
              }
          }
      }
      result = TCL_OK;
      end:
      Tcl_DStringFree(&buffer);
      return result;
  }
  /* End of tclfcmd.c */

 Legend:



Removed from v.64
 


changed lines


 
Added in v.71
 Legend:



Removed from v.64
 


changed lines


 
Added in v.71
-Removed from v.64
+Added in v.71

dashley@gmail.com	ViewVC Help
Powered by ViewVC 1.1.25