--- projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclfcmd.c	2016/10/14 02:09:58	44
+++ projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclfcmd.c	2018/07/22 15:58:07	220
@@ -1,854 +1,844 @@
-/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclfcmd.c,v 1.1.1.1 2001/06/13 04:39:01 dtashley Exp $ */
-
-/*
- * 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;
-}
-
-
-/* $History: tclfcmd.c $
- * 
- * *****************  Version 1  *****************
- * User: Dtashley     Date: 1/02/01    Time: 1:31a
- * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
- * Initial check-in.
- */ 
-
-/* End of TCLFCMD.C */
\ No newline at end of file
+/* $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 */