summaryrefslogtreecommitdiffstats
path: root/generic/tclFCmd.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclFCmd.c')
-rw-r--r--generic/tclFCmd.c841
1 files changed, 0 insertions, 841 deletions
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
deleted file mode 100644
index b69358b..0000000
--- a/generic/tclFCmd.c
+++ /dev/null
@@ -1,841 +0,0 @@
-/*
- * 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.4 1999/04/16 00:46:46 stanton 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 TclpStat() 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 ((TclpStat(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 TclpStat() so that if target is a symlink that points
- * to a directory we will create subdirectories in that
- * directory.
- */
-
- if (TclpStat(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;
-}
generated by cgit v0.12 at 2025-01-30 08:37:10 (GMT)