* Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2001-2004 Vincent Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIOUtil.c,v 1.154 2008/05/02 10:27:07 dkf Exp $
 * RCS: @(#) $Id: tclIOUtil.c,v 1.155 2008/07/28 21:31:15 nijtmans Exp $
 */

#include "tclInt.h"
#ifdef __WIN32__
#   include "tclWinInt.h"
#endif
#include "tclFileSystem.h"

MODULE_SCOPE const TclFileAttrProcs	tclpFileAttrProcs[];

/*
 * The following functions are obsolete string based APIs, and should be
 * removed in a future release (Tcl 9 would be a good time).
 */



/* Obsolete */
int
Tcl_Stat(
    const char *path,		/* Path of file to stat (in current CP). */
    struct stat *oldStyleBuf)	/* Filled with results of stat call. */
{
    int ret;

#ifdef HAVE_ST_BLOCKS
	oldStyleBuf->st_blksize	= buf.st_blksize;
	oldStyleBuf->st_blocks	= (blkcnt_t) buf.st_blocks;
#endif
    }
    return ret;
}


/* Obsolete */
int
Tcl_Access(
    const char *path,		/* Path of file to access (in current CP). */
    int mode)			/* Permission setting. */
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);

    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSAccess(pathPtr,mode);
    Tcl_DecrRefCount(pathPtr);

    return ret;
}


/* Obsolete */
Tcl_Channel
Tcl_OpenFileChannel(
    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
				 * NULL. */
    const char *path,		/* Name of file to open. */
    const char *modeString,	/* A list of POSIX open modes or a string such
				 * as "rw". */
    int permissions)		/* If the open involves creating a file, with
				 * what modes to create it? */
{
    Tcl_Channel ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);

    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions);
    Tcl_DecrRefCount(pathPtr);

    return ret;
}


/* Obsolete */
int
Tcl_Chdir(
    const char *dirName)
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1);
    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSChdir(pathPtr);
    Tcl_DecrRefCount(pathPtr);
    return ret;
}


/* Obsolete */
char *
Tcl_GetCwd(
    Tcl_Interp *interp,
    Tcl_DString *cwdPtr)
{
    Tcl_Obj *cwd = Tcl_FSGetCwd(interp);

    if (cwd == NULL) {
	return NULL;
    }
    Tcl_DStringInit(cwdPtr);
    Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
    Tcl_DecrRefCount(cwd);
    return Tcl_DStringValue(cwdPtr);
}


/* Obsolete */
int
Tcl_EvalFile(
    Tcl_Interp *interp,		/* Interpreter in which to process file. */
    const char *fileName)	/* Name of file to process. Tilde-substitution
				 * will be performed on this name. */
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);

    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSEvalFile(interp, pathPtr);
    Tcl_DecrRefCount(pathPtr);
    return ret;
}


/*
 * The 3 hooks for Stat, Access and OpenFileChannel are obsolete. The
 * complete, general hooked filesystem APIs should be used instead. This
 * define decides whether to include the obsolete hooks and related code. If
 * these are removed, we'll also want to remove them from stubs/tclInt. The
 * only known users of these APIs are prowrap and mktclapp. New
 * code/extensions should not use them, since they do not provide as full
 * support as the full filesystem API.
 *
 * As soon as prowrap and mktclapp are updated to use the full filesystem
 * support, I suggest all these hooks are removed.
 */




/*
 * Declare the native filesystem support. These functions should be considered
 * private to Tcl, and should really not be called directly by any code other
 * than this file (i.e. neither by Tcl's core nor by extensions). Similarly,
 * the old string-based Tclp... native filesystem functions should not be
 * called.

 * Define the native filesystem dispatch table. If necessary, it is ok to make
 * this non-static, but it should only be accessed by the functions actually
 * listed within it (or perhaps other helper functions of them). Anything
 * which is not part of this 'native filesystem implementation' should not be
 * delving inside here!
 */

Tcl_Filesystem tclNativeFilesystem = {
const Tcl_Filesystem tclNativeFilesystem = {
    "native",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_2,
    &TclNativePathInFilesystem,
    &TclNativeDupInternalRep,
    &NativeFreeInternalRep,
    &TclpNativeToNormalized,

typedef struct FsDivertLoad {
    Tcl_LoadHandle loadHandle;
    Tcl_FSUnloadFileProc *unloadProcPtr;
    Tcl_Obj *divertedFile;
    const Tcl_Filesystem *divertedFilesystem;
    ClientData divertedFileNativeRep;
} FsDivertLoad;


/*
 * Now move on to the basic filesystem implementation
 */

static void
FsThrExitProc(
    ClientData cd)

	if (--fsRecPtr->fileRefCount <= 0) {
	    ckfree((char *) fsRecPtr);
	}
	fsRecPtr = tmpFsRecPtr;
    }
    tsdPtr->initialized = 0;
}


int
TclFSCwdIsNative(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    if (tsdPtr->cwdClientData != NULL) {
	return 1;
    } else {
	return 0;
    }
}


/*
 *----------------------------------------------------------------------
 *
 * TclFSCwdPointerEquals --
 *
 *	Check whether the current working directory is equal to the path
 *	given.

	    Tcl_IncrRefCount(*pathPtrPtr);
	    return 1;
	} else {
	    return 0;
	}
    }
}


#ifdef TCL_THREADS
static void
FsRecacheFilesystemList(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL;

    if (tsdPtr->initialized == 0) {
	Tcl_CreateThreadExitHandler(FsThrExitProc, tsdPtr);
	tsdPtr->initialized = 1;
    }
}
#endif /* TCL_THREADS */


static FilesystemRecord *
FsGetFirstFilesystem(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    FilesystemRecord *fsRecPtr;

#ifndef TCL_THREADS

	tsdPtr->filesystemEpoch = theFilesystemEpoch;
    }
    Tcl_MutexUnlock(&filesystemMutex);
    fsRecPtr = tsdPtr->filesystemList;
#endif
    return fsRecPtr;
}


/*
 * The epoch can be changed both by filesystems being added or removed and by
 * env(HOME) changing.
 */

int
TclFSEpochOk(
    int filesystemEpoch)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    (void) FsGetFirstFilesystem();
    return (filesystemEpoch == tsdPtr->filesystemEpoch);
}


/*
 * If non-NULL, clientData is owned by us and must be freed later.
 */

static void
FsUpdateCwd(
    Tcl_Obj *cwdObj,

	tsdPtr->cwdClientData = NULL;
    } else {
	tsdPtr->cwdPathPtr = Tcl_NewStringObj(str, len);
	tsdPtr->cwdClientData = clientData;
	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeFilesystem --
 *
 *	Clean up the filesystem. After this, calls to all Tcl_FS... functions
 *	will fail.

     * filesystem is likely to fail.
     */

#ifdef __WIN32__
    TclWinEncodingsCleanup();
#endif
}


/*
 *----------------------------------------------------------------------
 *
 * TclResetFilesystem --
 *
 *	Restore the filesystem to a pristine state.
 *

     * Cleans up the win32 API filesystem proc lookup table. This must happen
     * very late in finalization so that deleting of copied dlls can occur.
     */

    TclWinResetInterfaces();
#endif
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSRegister --
 *
 *	Insert the filesystem function table at the head of the list of
 *	functions which are used during calls to all file-system operations.

 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSRegister(
    ClientData clientData,	/* Client specific data for this fs */
    Tcl_Filesystem *fsPtr)	/* The filesystem record for the new fs. */
    const Tcl_Filesystem *fsPtr)	/* The filesystem record for the new fs. */
{
    FilesystemRecord *newFilesystemPtr;

    if (fsPtr == NULL) {
	return TCL_ERROR;
    }

     */

    theFilesystemEpoch++;
    Tcl_MutexUnlock(&filesystemMutex);

    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSUnregister --
 *
 *	Remove the passed filesystem from the list of filesystem function
 *	tables. It also ensures that the built-in (native) filesystem is not

 *	updated immediately.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSUnregister(
    Tcl_Filesystem *fsPtr)	/* The filesystem record to remove. */
    const Tcl_Filesystem *fsPtr)	/* The filesystem record to remove. */
{
    int retVal = TCL_ERROR;
    FilesystemRecord *fsRecPtr;

    Tcl_MutexLock(&filesystemMutex);

    /*

	    fsRecPtr = fsRecPtr->nextPtr;
	}
    }

    Tcl_MutexUnlock(&filesystemMutex);
    return retVal;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSMatchInDirectory --
 *
 *	This routine is used by the globbing code to search a directory for
 *	all files which match a given pattern. The appropriate function for

	    }
	}
	TclDecrRefCount(tmpResultPtr);
    }
    Tcl_DecrRefCount(cwd);
    return ret;
}


/*
 *----------------------------------------------------------------------
 *
 * FsAddMountsToGlobResult --
 *
 *	This routine is used by the globbing code to take the results of a
 *	directory listing and add any mounted paths to that listing. This is

	     */
	}
    }

  endOfMounts:
    Tcl_DecrRefCount(mounts);
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSMountsChanged --
 *
 *	Notify the filesystem that the available mounted filesystems (or
 *	within any one filesystem type, the number or location of mount

 *	if it really doesn't understand them or if they don't exist).
 *
 *----------------------------------------------------------------------
 */

void
Tcl_FSMountsChanged(
    Tcl_Filesystem *fsPtr)
    const Tcl_Filesystem *fsPtr)
{
    /*
     * We currently don't do anything with this parameter. We could in the
     * future only invalidate files for this filesystem or otherwise take more
     * advanced action.
     */

    (void)fsPtr;

    /*
     * Increment the filesystem epoch counter, since existing paths might now
     * belong to different filesystems.
     */

    Tcl_MutexLock(&filesystemMutex);
    theFilesystemEpoch++;
    Tcl_MutexUnlock(&filesystemMutex);
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSData --
 *
 *	Retrieve the clientData field for the filesystem given, or NULL if
 *	that filesystem is not registered.

 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_FSData(
    Tcl_Filesystem *fsPtr) /* The filesystem record to query. */
    const Tcl_Filesystem *fsPtr) /* The filesystem record to query. */
{
    ClientData retVal = NULL;
    FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();

    /*
     * Traverse the list of filesystems look for a particular one. If found,
     * return that filesystem's clientData (originally provided when calling
     * Tcl_FSRegister).
     */

    while ((retVal == NULL) && (fsRecPtr != NULL)) {
	if (fsRecPtr->fsPtr == fsPtr) {
	    retVal = fsRecPtr->clientData;
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    return retVal;
}


/*
 *---------------------------------------------------------------------------
 *
 * TclFSNormalizeToUniquePath --
 *
 *	Takes a path specification containing no ../, ./ sequences, and
 *	converts it into a unique path for the given platform. On Unix, this

	 *		if (retVal == length-of(pathPtr)) {break;}
	 * but there's not much benefit.
	 */
    }

    return startAt;
}


/*
 *---------------------------------------------------------------------------
 *
 * TclGetOpenMode --
 *
 *	This routine is an obsolete, limited version of TclGetOpenModeEx()
 *	below. It exists only to satisfy any extensions imprudently using it

    const char *modeString,	/* Mode string, e.g. "r+" or "RDONLY CREAT" */
    int *seekFlagPtr)		/* Set this to 1 if the caller should seek to
				 * EOF during the opening of the file. */
{
    int binary = 0;
    return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary);
}


/*
 *---------------------------------------------------------------------------
 *
 * TclGetOpenModeEx --
 *
 *	Computes a POSIX mode mask for opening a file, from a given string,
 *	and also sets flags to indicate whether the caller should seek to EOF

	    Tcl_AppendResult(interp, "access mode must include either"
		    " RDONLY, WRONLY, or RDWR", NULL);
	}
	return -1;
    }
    return mode;
}


/*
 * Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument.
 */

int
Tcl_FSEvalFile(
    Tcl_Interp *interp,		/* Interpreter in which to process file. */
    Tcl_Obj *pathPtr)		/* Path of file to process. Tilde-substitution
				 * will be performed on this name. */
{
    return Tcl_FSEvalFileEx(interp, pathPtr, NULL);
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSEvalFileEx --
 *
 *	Read in a file and process the entire file as one gigantic Tcl
 *	command.

		(overflow ? "..." : ""), interp->errorLine));
    }

  end:
    Tcl_DecrRefCount(objPtr);
    return result;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetErrno --
 *
 *	Gets the current value of the Tcl error code variable. This is
 *	currently the global variable "errno" but could in the future change

    /*
     * On some platforms, errno is really a thread local (implemented by the C
     * library).
     */

    return errno;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetErrno --
 *
 *	Sets the Tcl error code variable to the supplied value.
 *

    /*
     * On some platforms, errno is really a thread local (implemented by the C
     * library).
     */

    errno = err;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_PosixError --
 *
 *	This function is typically called after UNIX kernel calls return
 *	errors. It stores machine-readable information about the error in

    msg = Tcl_ErrnoMsg(errno);
    id = Tcl_ErrnoId();
    if (interp) {
	Tcl_SetErrorCode(interp, "POSIX", id, msg, NULL);
    }
    return msg;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSStat --
 *
 *	This function replaces the library version of stat and lsat.
 *

    if (fsPtr != NULL && fsPtr->statProc != NULL) {
	return fsPtr->statProc(pathPtr, buf);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSLstat --
 *
 *	This function replaces the library version of lstat. The appropriate
 *	function for the filesystem to which pathPtr belongs will be called.

	if (fsPtr->statProc != NULL) {
	    return fsPtr->statProc(pathPtr, buf);
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSAccess --
 *
 *	This function replaces the library version of access. The appropriate
 *	function for the filesystem to which pathPtr belongs will be called.

    if (fsPtr != NULL && fsPtr->accessProc != NULL) {
	return fsPtr->accessProc(pathPtr, mode);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSOpenFileChannel --
 *
 *	The appropriate function for the filesystem to which pathPtr belongs
 *	will be called.

    Tcl_SetErrno(ENOENT);
    if (interp != NULL) {
	Tcl_AppendResult(interp, "couldn't open \"", Tcl_GetString(pathPtr),
		"\": ", Tcl_PosixError(interp), NULL);
    }
    return NULL;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSUtime --
 *
 *	This function replaces the library version of utime. The appropriate
 *	function for the filesystem to which pathPtr belongs will be called.

    if (fsPtr != NULL && fsPtr->utimeProc != NULL) {
	return fsPtr->utimeProc(pathPtr, tval);
    }
    /* TODO: set errno here? Tcl_SetErrno(ENOENT); */
    return -1;
}


/*
 *----------------------------------------------------------------------
 *
 * NativeFileAttrStrings --
 *
 *	This function implements the platform dependent 'file attributes'
 *	subcommand, for the native filesystem, for listing the set of possible

static const char **
NativeFileAttrStrings(
    Tcl_Obj *pathPtr,
    Tcl_Obj **objPtrRef)
{
    return tclpFileAttrStrings;
}


/*
 *----------------------------------------------------------------------
 *
 * NativeFileAttrsGet --
 *
 *	This function implements the platform dependent 'file attributes'
 *	subcommand, for the native filesystem, for 'get' operations. This

    int index,			/* index of the attribute command. */
    Tcl_Obj *pathPtr,		/* path of file we are operating on. */
    Tcl_Obj **objPtrRef)	/* for output. */
{
    return (*tclpFileAttrProcs[index].getProc)(interp, index, pathPtr,
	    objPtrRef);
}


/*
 *----------------------------------------------------------------------
 *
 * NativeFileAttrsSet --
 *
 *	This function implements the platform dependent 'file attributes'
 *	subcommand, for the native filesystem, for 'set' operations. This

    Tcl_Interp *interp,		/* The interpreter for error reporting. */
    int index,			/* index of the attribute command. */
    Tcl_Obj *pathPtr,		/* path of file we are operating on. */
    Tcl_Obj *objPtr)		/* set to this value. */
{
    return (*tclpFileAttrProcs[index].setProc)(interp, index, pathPtr, objPtr);
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSFileAttrStrings --
 *
 *	This function implements part of the hookable 'file attributes'
 *	subcommand. The appropriate function for the filesystem to which

    if (fsPtr != NULL && fsPtr->fileAttrStringsProc != NULL) {
	return fsPtr->fileAttrStringsProc(pathPtr, objPtrRef);
    }
    Tcl_SetErrno(ENOENT);
    return NULL;
}


/*
 *----------------------------------------------------------------------
 *
 * TclFSFileAttrIndex --
 *
 *	Helper function for converting an attribute name to an index into the
 *	attribute table.

	}
	TclDecrRefCount(listObj);
	return TCL_ERROR;
    } else {
	return TCL_ERROR;
    }
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSFileAttrsGet --
 *
 *	This function implements read access for the hookable 'file
 *	attributes' subcommand. The appropriate function for the filesystem to

    if (fsPtr != NULL && fsPtr->fileAttrsGetProc != NULL) {
	return fsPtr->fileAttrsGetProc(interp, index, pathPtr, objPtrRef);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSFileAttrsSet --
 *
 *	This function implements write access for the hookable 'file
 *	attributes' subcommand. The appropriate function for the filesystem to

    if (fsPtr != NULL && fsPtr->fileAttrsSetProc != NULL) {
	return fsPtr->fileAttrsSetProc(interp, index, pathPtr, objPtr);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSGetCwd --
 *
 *	This function replaces the library version of getcwd().
 *

  cdDidNotChange:
    if (tsdPtr->cwdPathPtr != NULL) {
	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
    }

    return tsdPtr->cwdPathPtr;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSChdir --
 *
 *	This function replaces the library version of chdir().
 *

	} else {
	    FsUpdateCwd(normDirName, NULL);
	}
    }

    return retVal;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSLoadFile --
 *
 *	Dynamically loads a binary code file into memory and returns the
 *	addresses of two functions within that file, if they are defined. The

     * This also means that the signatures Tcl_FSUnloadFileProc and
     * Tcl_FSLoadFileProc are both misleading.
     */

    *handlePtr = clientData;
    return res;
}


/*
 *----------------------------------------------------------------------
 *
 * TclLoadFile --
 *
 *	Dynamically loads a binary code file into memory and returns the
 *	addresses of a number of given functions within that file, if they are

				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    Tcl_Filesystem *copyFsPtr;
    const Tcl_Filesystem *copyFsPtr;
    Tcl_Obj *copyToPtr;
    Tcl_LoadHandle newLoadHandle = NULL;
    ClientData newClientData = NULL;
    Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
    FsDivertLoad *tvdlPtr;
    int retVal;

    *clientDataPtr = handle;

    *proc1Ptr = TclpFindSymbol(interp, handle, sym1);
    *proc2Ptr = TclpFindSymbol(interp, handle, sym2);
    return TCL_OK;
}


/*
 *---------------------------------------------------------------------------
 *
 * FSUnloadTempFile --
 *
 *	This function is called when we loaded a library of code via an
 *	intermediate temporary file. This function ensures the library is

	 */

	Tcl_DecrRefCount(tvdlPtr->divertedFile);
    }

    ckfree((char *) tvdlPtr);
}


/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSLink --
 *
 *	This function replaces the library version of readlink() and can also
 *	be used to make links. The appropriate function for the filesystem to

#ifndef S_IFLNK
    errno = EINVAL; /* TODO: Change to Tcl_SetErrno()? */
#else
    Tcl_SetErrno(ENOENT);
#endif /* S_IFLNK */
    return NULL;
}


/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSListVolumes --
 *
 *	Lists the currently mounted volumes. The chain of functions that have
 *	been "inserted" into the filesystem will be called in succession; each

	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    return resultPtr;
}


/*
 *---------------------------------------------------------------------------
 *
 * FsListMounts --
 *
 *	List all mounts within the given directory, which match the given
 *	pattern.

		    pattern, &mountsOnly);
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    return resultPtr;
}


/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSSplitPath --
 *
 *	This function takes the given Tcl_Obj, which should be a valid path,
 *	and returns a Tcl List object containing each segment of that path as

Tcl_Obj *
Tcl_FSSplitPath(
    Tcl_Obj *pathPtr,		/* Path to split. */
    int *lenPtr)		/* int to store number of path elements. */
{
    Tcl_Obj *result = NULL;	/* Needed only to prevent gcc warnings. */
    Tcl_Filesystem *fsPtr;
    const Tcl_Filesystem *fsPtr;
    char separator = '/';
    int driveNameLength;
    char *p;

    /*
     * Perform platform specific splitting.
     */

     */

    if (lenPtr != NULL) {
	TclListObjLength(NULL, result, lenPtr);
    }
    return result;
}


/* Simple helper function */
Tcl_Obj *
TclFSInternalToNormalized(
    Tcl_Filesystem *fromFilesystem,
    const Tcl_Filesystem *fromFilesystem,
    ClientData clientData,
    FilesystemRecord **fsRecPtrPtr)
{
    FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();

    while (fsRecPtr != NULL) {
	if (fsRecPtr->fsPtr == fromFilesystem) {
	    *fsRecPtrPtr = fsRecPtr;
	    break;
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    if ((fsRecPtr == NULL)
	    || (fromFilesystem->internalToNormalizedProc == NULL)) {
	return NULL;
    }
    return (*fromFilesystem->internalToNormalizedProc)(clientData);
}


/*
 *----------------------------------------------------------------------
 *
 * TclGetPathType --
 *
 *	Helper function used by FSGetPathType.
 *

 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclGetPathType(
    Tcl_Obj *pathPtr,		/* Path to determine type for */
    Tcl_Filesystem **filesystemPtrPtr,
    const Tcl_Filesystem **filesystemPtrPtr,
				/* If absolute path and this is not NULL, then
				 * set to the filesystem which claims this
				 * path. */
    int *driveNameLengthPtr,	/* If the path is absolute, and this is
				 * non-NULL, then set to the length of the
				 * driveName. */
    Tcl_Obj **driveNameRef)	/* If the path is absolute, and this is

		driveNameRef);
	if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) {
	    *filesystemPtrPtr = &tclNativeFilesystem;
	}
    }
    return type;
}


/*
 *----------------------------------------------------------------------
 *
 * TclFSNonnativePathType --
 *
 *	Helper function used by TclGetPathType. Its purpose is to check
 *	whether the given path starts with a string which corresponds to a

 *----------------------------------------------------------------------
 */

Tcl_PathType
TclFSNonnativePathType(
    const char *path,		/* Path to determine type for */
    int pathLen,		/* Length of the path */
    Tcl_Filesystem **filesystemPtrPtr,
    const Tcl_Filesystem **filesystemPtrPtr,
				/* If absolute path and this is not NULL, then
				 * set to the filesystem which claims this
				 * path. */
    int *driveNameLengthPtr,	/* If the path is absolute, and this is
				 * non-NULL, then set to the length of the
				 * driveName. */
    Tcl_Obj **driveNameRef)	/* If the path is absolute, and this is

		}
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    return type;
}


/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSRenameFile --
 *
 *	If the two paths given belong to the same filesystem, we call that
 *	filesystems rename function. Otherwise we simply return the POSIX

	retVal = fsPtr->renameFileProc(srcPathPtr, destPathPtr);
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    return retVal;
}


/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSCopyFile --
 *
 *	If the two paths given belong to the same filesystem, we call that
 *	filesystem's copy function. Otherwise we simply return the POSIX error

	retVal = fsPtr->copyFileProc(srcPathPtr, destPathPtr);
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    return retVal;
}


/*
 *---------------------------------------------------------------------------
 *
 * TclCrossFilesystemCopy --
 *
 *	Helper for above function, and for Tcl_FSLoadFile, to copy files from
 *	one filesystem to another. This function will overwrite the target

	tval.modtime = sourceStatBuf.st_mtime;
	Tcl_FSUtime(target, &tval);
    }

  done:
    return result;
}


/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSDeleteFile --
 *
 *	The appropriate function for the filesystem to which pathPtr belongs
 *	will be called.

    if (fsPtr != NULL && fsPtr->deleteFileProc != NULL) {
	return fsPtr->deleteFileProc(pathPtr);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}


/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSCreateDirectory --
 *
 *	The appropriate function for the filesystem to which pathPtr belongs
 *	will be called.

    if (fsPtr != NULL && fsPtr->createDirectoryProc != NULL) {
	return fsPtr->createDirectoryProc(pathPtr);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}


/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSCopyDirectory --
 *
 *	If the two paths given belong to the same filesystem, we call that
 *	filesystems copy-directory function. Otherwise we simply return the

	retVal = fsPtr->copyDirectoryProc(srcPathPtr, destPathPtr, errorPtr);
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    return retVal;
}


/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSRemoveDirectory --
 *
 *	The appropriate function for the filesystem to which pathPtr belongs
 *	will be called.

	    }
	}
	return fsPtr->removeDirectoryProc(pathPtr, recursive, errorPtr);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}


/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetFileSystemForPath --
 *
 *	This function determines which filesystem to use for a particular path
 *	object, and returns the filesystem which accepts this file. If no
 *	filesystem will accept this object as a valid file path, then NULL is
 *	returned.
 *
 * Results:
 *	NULL or a filesystem which will accept this path.
 *
 * Side effects:
 *	The object may be converted to a path type.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Filesystem *
const Tcl_Filesystem *
Tcl_FSGetFileSystemForPath(
    Tcl_Obj *pathPtr)
{
    FilesystemRecord *fsRecPtr;
    Tcl_Filesystem *retVal = NULL;
    const Tcl_Filesystem *retVal = NULL;

    if (pathPtr == NULL) {
	Tcl_Panic("Tcl_FSGetFileSystemForPath called with NULL object");
	return NULL;
    }

    /*

	    TclFSSetPathDetails(pathPtr, fsRecPtr, clientData);
	    return fsRecPtr->fsPtr;
	}
    }

    return NULL;
}


/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetNativePath --
 *
 *	This function is for use by the Win/Unix native filesystems, so that
 *	they can easily retrieve the native (char* or TCHAR*) representation

const char *
Tcl_FSGetNativePath(
    Tcl_Obj *pathPtr)
{
    return (const char *) Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem);
}


/*
 *---------------------------------------------------------------------------
 *
 * NativeFreeInternalRep --
 *
 *	Free a native internal representation, which will be non-NULL.
 *

static void
NativeFreeInternalRep(
    ClientData clientData)
{
    ckfree((char *) clientData);
}


/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSFileSystemInfo --
 *
 *	This function returns a list of two elements. The first element is the
 *	name of the filesystem (e.g. "native" or "vfs"), and the second is the

	if (typePtr != NULL) {
	    Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
	}
    }

    return resPtr;
}


/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSPathSeparator --
 *
 *	This function returns the separator to be used for a given path. The
 *	object returned should have a refCount of zero

	 * wish to use the standard forward slash.
	 */

	TclNewLiteralStringObj(resultObj, "/");
	return resultObj;
    }
}


/*
 *---------------------------------------------------------------------------
 *
 * NativeFilesystemSeparator --
 *
 *	This function is part of the native filesystem support, and returns
 *	the separator for the given path.

    case TCL_PLATFORM_WINDOWS:
	separator = "\\";
	break;
    }
    return Tcl_NewStringObj(separator,1);
}



/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */