Tcl Source Code

2004-01-21  Vince Darley  <[email protected]>

	* doc/FileSystem.3: 
	* generic/tcl.decls: 
	* generic/tclCmdAH.c
	* generic/tclDecls.h
	* generic/tclFCmd.c
	* generic/tclFileName.c
	* generic/tclFileSystem.h
	* generic/tclIOUtil.c
	* generic/tclInt.decls
	* generic/tclInt.h
	* generic/tclIntDecls.h
	* generic/tclPathObj.c
	* generic/tclStubInit.c
	* generic/tclTest.c
	* mac/tclMacFile.c
	* tests/fileName.test
	* tests/fileSystem.test
	* tests/winFCmd.test
	* unix/tclUnixFile.c
	* win/tclWin32Dll.c
	* win/tclWinFCmd.c
	* win/tclWinFile.c
	* win/tclWinInt.h
	
	Three main issues accomplished: (1) cleaned up variable names in
	the filesystem code so that 'pathPtr' is used throughout.  (2)
	applied a round of filesystem optimisation with better handling
	and caching of relative and absolute paths, requiring fewer
	conversions.  (3) clarifications to the documentation,
	particularly regarding the acceptable refCounts of objects.
	Some new tests added.  Tcl benchmarks show a significant
	improvement over 8.4.5, and typically a small improvement over
	8.3.5.  TCL_FILESYSTEM_VERSION_2 introduced, but for internal
	use only.  There should be no public incompatibilities from
	these changes.  Thanks to dgp for extensive testing.
	
2004-01-19  David Gravereaux <[email protected]>

	* win/tclWinPipe.c (Tcl_WaitPid): Fixed a thread-safety problem
	with the process list.  The delayed cut operation after the wait
	was going stale by being outside the list lock.  It now cuts
	within the lock and does a locked splice for when it needs to
	instead.  [Bug 859820]

'\"
'\" Copyright (c) 2001 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: FileSystem.3,v 1.38 2004/01/21 19:59:33 vincentdarley Exp $
'\" 
.so man.macros
.TH Filesystem 3 8.4 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_FSRegister, Tcl_FSUnregister, Tcl_FSData, Tcl_FSMountsChanged, Tcl_FSGetFileSystemForPath, Tcl_FSGetPathType, Tcl_FSCopyFile, Tcl_FSCopyDirectory, Tcl_FSCreateDirectory, Tcl_FSDeleteFile, Tcl_FSRemoveDirectory, Tcl_FSRenameFile, Tcl_FSListVolumes, Tcl_FSEvalFile, Tcl_FSLoadFile, Tcl_FSMatchInDirectory, Tcl_FSLink, Tcl_FSLstat, Tcl_FSUtime, Tcl_FSFileAttrsGet, Tcl_FSFileAttrsSet, Tcl_FSFileAttrStrings, Tcl_FSStat, Tcl_FSAccess, Tcl_FSOpenFileChannel, Tcl_FSGetCwd, Tcl_FSChdir, Tcl_FSPathSeparator, Tcl_FSJoinPath, Tcl_FSSplitPath, Tcl_FSEqualPaths, Tcl_FSGetNormalizedPath, Tcl_FSJoinToPath, Tcl_FSConvertToPathType, Tcl_FSGetInternalRep, Tcl_FSGetTranslatedPath, Tcl_FSGetTranslatedStringPath, Tcl_FSNewNativePath, Tcl_FSGetNativePath, Tcl_FSFileSystemInfo, Tcl_AllocStatBuf \- procedures to interact with any filesystem
.SH SYNOPSIS

\fBTcl_FSPathSeparator\fR returns the separator character to be used for 
most specific element of the path specified by pathPtr (i.e. the last 
part of the path).
.PP
The separator is returned as a Tcl_Obj containing a string of length
1.  If the path is invalid, NULL is returned.
.PP
\fBTcl_FSJoinPath\fR takes the given Tcl_Obj, which should be a valid
list (which is allowed to have a refCount of zero), and returns the path
object given by considering the first 'elements' elements as valid path
segments.  If elements < 0, we use the entire list.

.PP
Returns object, typically with refCount of zero (but it could be shared
under some conditions) , containing the joined path.  The caller must
add a refCount to the object before using it.  In particular, the
returned object could be an element of the given list, so freeing the
list might free the object prematurely if no refCount has been taken.
.PP
\fBTcl_FSSplitPath\fR takes the given Tcl_Obj, which should be a valid path,
and returns a Tcl List object containing each segment of that path as
an element.
.PP
Returns list object with refCount of zero.  If the passed in lenPtr is
non-NULL, we use it to return the number of elements in the returned

object may be freed any time the cwd changes) - the caller can of
course increment the refCount if it wishes to maintain a copy for longer.
.PP
\fBTcl_FSJoinToPath\fR takes the given object, which should usually be a
valid path or NULL, and joins onto it the array of paths segments
given.
.PP
Returns object, typically with refCount of zero (but it could be shared
under some conditions), containing the joined path.  The caller must
add a refCount to the object before using it.  If any of the objects
passed into this function (pathPtr or path elements) have a refCount
of zero, they will be freed when this function returns.
.PP
\fBTcl_FSConvertToPathType\fR tries to convert the given Tcl_Obj to a valid
Tcl path type, taking account of the fact that the cwd may have changed
even if this object is already supposedly of the correct type.
The filename may begin with "~" (to indicate current user's home
directory) or "~<user>" (to indicate any user's home directory).
.PP

TCHAR*) representation of a path.  This function is a convenience
wrapper around \fBTcl_FSGetInternalRep\fR, and assumes the native
representation is string-based.  It may be desirable in the future to
have non-string-based native representations (for example, on MacOS, a
representation using a fileSpec of FSRef structure would probably be
more efficient).  On Windows a full Unicode representation would allow
for paths of unlimited length.  Currently the representation is simply a
character string which may contain either the relative path or a
complete, absolute normalized path in the native encoding (complex
conditions dictate which of these will be provided, so neither can be
relied upon, unless the path is known to be absolute).  If you need a
native path which must be absolute, then you should ask for the native
version of a normalized path.  If for some reason a non-absolute,
non-normalized version of the path is needed, that must be constructed
separately (e.g. using \fBTcl_FSGetTranslatedPath\fR).
.PP
The native representation is cached so that repeated calls to this
function will not require additional conversions.  The return value is
owned by Tcl and has a lifetime equivalent to that of the \fIpathPtr\fR
passed in (unless that is a relative path, in which case the native

# tcl.decls --
#
#	This file contains the declarations for all supported public
#	functions that are exported by the Tcl library via the stubs table.
#	This file is used to generate the tclDecls.h, tclPlatDecls.h,
#	tclStub.c, and tclPlatStub.c files.
#	
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: tcl.decls,v 1.102 2004/01/21 19:59:33 vincentdarley Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private

declare 461 generic {
    Tcl_Obj* Tcl_FSSplitPath(Tcl_Obj* pathPtr, int *lenPtr)
}
declare 462 generic {
    int Tcl_FSEqualPaths(Tcl_Obj* firstPtr, Tcl_Obj* secondPtr)
}
declare 463 generic {
    Tcl_Obj* Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj* pathPtr)
}
declare 464 generic {
    Tcl_Obj* Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
	    Tcl_Obj *CONST objv[])
}
declare 465 generic {
    ClientData Tcl_FSGetInternalRep(Tcl_Obj* pathPtr,
	    Tcl_Filesystem *fsPtr)
}
declare 466 generic {
    Tcl_Obj* Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj* pathPtr)
}
declare 467 generic {
    int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName)
}
declare 468 generic {
    Tcl_Obj* Tcl_FSNewNativePath(Tcl_Filesystem* fromFilesystem,
	    ClientData clientData)
}
declare 469 generic {
    CONST char* Tcl_FSGetNativePath(Tcl_Obj* pathPtr)
}
declare 470 generic {
    Tcl_Obj* Tcl_FSFileSystemInfo(Tcl_Obj* pathPtr)
}
declare 471 generic {
    Tcl_Obj* Tcl_FSPathSeparator(Tcl_Obj* pathPtr)
}
declare 472 generic {
    Tcl_Obj* Tcl_FSListVolumes(void)
}
declare 473 generic {
    int Tcl_FSRegister(ClientData clientData, Tcl_Filesystem *fsPtr)
}
declare 474 generic {
    int Tcl_FSUnregister(Tcl_Filesystem *fsPtr)
}
declare 475 generic {
    ClientData Tcl_FSData(Tcl_Filesystem *fsPtr)
}
declare 476 generic {
    CONST char* Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
	    Tcl_Obj* pathPtr)
}
declare 477 generic {
    Tcl_Filesystem* Tcl_FSGetFileSystemForPath(Tcl_Obj* pathPtr)
}
declare 478 generic {
    Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr)
}
# New function due to TIP#49
declare 479 generic {
    int Tcl_OutputBuffered(Tcl_Channel chan)
}
declare 480 generic {
    void Tcl_FSMountsChanged(Tcl_Filesystem *fsPtr)

/* 
 * tclCmdAH.c --
 *
 *	This file contains the top-level command routines for most of
 *	the Tcl built-in commands whose names begin with the letters
 *	A to H.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 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: tclCmdAH.c,v 1.40 2004/01/21 19:59:33 vincentdarley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include <locale.h>

/*
 * Prototypes for local procedures defined in this file:
 */

static int		CheckAccess _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int mode));
static int		GetStatBuf _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, Tcl_FSStatProc *statProc,
			    Tcl_StatBuf *statPtr));
static char *		GetTypeFromMode _ANSI_ARGS_((int mode));
static int		StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *varName, Tcl_StatBuf *statPtr));

/*
 *----------------------------------------------------------------------
 *
 * Tcl_BreakObjCmd --
 *
 *	This procedure is invoked to process the "break" Tcl command.

	    return TclFileDeleteCmd(interp, objc, objv);
    	case FCMD_DIRNAME: {
	    Tcl_Obj *dirPtr;

	    if (objc != 3) {
		goto only3Args;
	    }
	    dirPtr = TclPathPart(interp, objv[2], TCL_PATH_DIRNAME);
	    if (dirPtr == NULL) {
	        return TCL_ERROR;
	    } else {
		Tcl_SetObjResult(interp, dirPtr);
		Tcl_DecrRefCount(dirPtr);
		return TCL_OK;
	    }
	}
	case FCMD_EXECUTABLE:
	    if (objc != 3) {
		goto only3Args;
	    }
	    return CheckAccess(interp, objv[2], X_OK);
	case FCMD_EXISTS:
	    if (objc != 3) {
		goto only3Args;
	    }
	    return CheckAccess(interp, objv[2], F_OK);
	case FCMD_EXTENSION: {
	    Tcl_Obj *ext;
	    
	    if (objc != 3) {
	    	goto only3Args;
	    }
	    ext = TclPathPart(interp, objv[2], TCL_PATH_EXTENSION);

	    if (ext != NULL) {
	        Tcl_SetObjResult(interp, ext);
		Tcl_DecrRefCount(ext);
		return TCL_OK;
	    } else {
		return TCL_ERROR;
	    }
	}
    	case FCMD_ISDIRECTORY: {
	    int value;
	    Tcl_StatBuf buf;

	    if (objc != 3) {
		goto only3Args;

		    } else if (errno == ENOENT) {
			/*
			 * There are two cases here: either the target
			 * doesn't exist, or the directory of the src
			 * doesn't exist.
			 */
			int access;
			Tcl_Obj *dirPtr = TclPathPart(interp, objv[index], TCL_PATH_DIRNAME);
			if (dirPtr == NULL) {
			    return TCL_ERROR;
			}
			access = Tcl_FSAccess(dirPtr, F_OK);
			Tcl_DecrRefCount(dirPtr);
			if (access != 0) {
			    Tcl_AppendResult(interp, 

		 * will just be objv[index+1], and so we don't own it.
		 */
		Tcl_DecrRefCount(contents);
	    }
	    return TCL_OK;
	}
    	case FCMD_LSTAT: {

	    Tcl_StatBuf buf;

    	    if (objc != 4) {
    	    	Tcl_WrongNumArgs(interp, 2, objv, "name varName");
    	    	return TCL_ERROR;
    	    }
	    if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
		return TCL_ERROR;
	    }

	    return StoreStatData(interp, objv[3], &buf);
	}
	case FCMD_MTIME: {
	    Tcl_StatBuf buf;
	    struct utimbuf tval;

	    if ((objc < 3) || (objc > 4)) {
		Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");

	    Tcl_SetObjResult(interp, contents);
	    Tcl_DecrRefCount(contents);
	    return TCL_OK;
	}
	case FCMD_RENAME:
	    return TclFileRenameCmd(interp, objc, objv);
	case FCMD_ROOTNAME: {

	    Tcl_Obj *root;
	    
	    if (objc != 3) {
		goto only3Args;
	    }
	    root = TclPathPart(interp, objv[2], TCL_PATH_ROOT);

	    if (root != NULL) {
		Tcl_SetObjResult(interp, root);
		Tcl_DecrRefCount(root);
		return TCL_OK;
	    } else {

		return TCL_ERROR;
	    }

	}
	case FCMD_SEPARATOR:
	    if ((objc < 2) || (objc > 3)) {
		Tcl_WrongNumArgs(interp, 2, objv, "?name?");
		return TCL_ERROR;
	    }
	    if (objc == 2) {

	    if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_SetWideIntObj(Tcl_GetObjResult(interp),
		    (Tcl_WideInt) buf.st_size);
	    return TCL_OK;
	}
	case FCMD_SPLIT: {
	    Tcl_Obj *res;
	    
	    if (objc != 3) {
		goto only3Args;
	    }
	    res = Tcl_FSSplitPath(objv[2], NULL);
	    if (res == NULL) {
		if (interp != NULL) {
		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
			"could not read \"", Tcl_GetString(objv[2]),
			"\": no such file or directory", 
			(char *) NULL);
		}
		return TCL_ERROR;
	    } else {
		Tcl_SetObjResult(interp, res);
		return TCL_OK;
	    }
	}
	case FCMD_STAT: {

	    Tcl_StatBuf buf;
	    
	    if (objc != 4) {
	    	Tcl_WrongNumArgs(interp, 1, objv, "stat name varName");
		return TCL_ERROR;
	    }
	    if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
		return TCL_ERROR;
	    }

	    return StoreStatData(interp, objv[3], &buf);
	}
	case FCMD_SYSTEM: {
	    Tcl_Obj* fsInfo;

	    if (objc != 3) {
		goto only3Args;
	    }
	    fsInfo = Tcl_FSFileSystemInfo(objv[2]);
	    if (fsInfo != NULL) {
		Tcl_SetObjResult(interp, fsInfo);
		return TCL_OK;
	    } else {
		Tcl_SetObjResult(interp, 
				 Tcl_NewStringObj("Unrecognised path",-1));
		return TCL_ERROR;
	    }
	}
    	case FCMD_TAIL: {

	    Tcl_Obj *dirPtr;

	    if (objc != 3) {
		goto only3Args;
	    }










	    dirPtr = TclPathPart(interp, objv[2], TCL_PATH_TAIL);
	    if (dirPtr == NULL) {
		return TCL_ERROR;



	    } else {











		Tcl_SetObjResult(interp, dirPtr);


		Tcl_DecrRefCount(dirPtr);
		return TCL_OK;
	    }
	}
	case FCMD_TYPE: {
	    Tcl_StatBuf buf;

	    if (objc != 3) {
	    	goto only3Args;
	    }

 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
  
static int
CheckAccess(interp, pathPtr, mode)
    Tcl_Interp *interp;		/* Interp for status return.  Must not be
				 * NULL. */
    Tcl_Obj *pathPtr;		/* Name of file to check. */
    int mode;			/* Attribute to check; passed as argument to
				 * access(). */
{
    int value;
    
    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
	value = 0;
    } else {
	value = (Tcl_FSAccess(pathPtr, mode) == 0);
    }
    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);

    return TCL_OK;
}

/*

 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
GetStatBuf(interp, pathPtr, statProc, statPtr)
    Tcl_Interp *interp;		/* Interp for error return.  May be NULL. */
    Tcl_Obj *pathPtr;		/* Path name to examine. */
    Tcl_FSStatProc *statProc;	/* Either stat() or lstat() depending on
				 * desired behavior. */
    Tcl_StatBuf *statPtr;	/* Filled with info about file obtained by
				 * calling (*statProc)(). */
{
    int status;
    
    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
	return TCL_ERROR;
    }

    status = (*statProc)(pathPtr, statPtr);
    
    if (status < 0) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "could not read \"",
		    Tcl_GetString(pathPtr), "\": ",
		    Tcl_PosixError(interp), (char *) NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}


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

static int
StoreStatData(interp, varName, statPtr)
    Tcl_Interp *interp;			/* Interpreter for error reports. */
    Tcl_Obj *varName;			/* Name of associative array variable
					 * in which to store stat results. */
    Tcl_StatBuf *statPtr;		/* Pointer to buffer containing
					 * stat data to store in varName. */
{

    Tcl_Obj *field = Tcl_NewObj();
    Tcl_Obj *value;
    register unsigned short mode;

    /*
     * Assume Tcl_ObjSetVar2() does not keep a copy of the field name!
     */
#define STORE_ARY(fieldName, object) \
    Tcl_SetStringObj(field, (fieldName), -1); \
    value = (object); \
    if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG) == NULL) { \
	Tcl_DecrRefCount(varName); \
	Tcl_DecrRefCount(field); \
	Tcl_DecrRefCount(value); \
	return TCL_ERROR; \
    }


    Tcl_IncrRefCount(field);
    STORE_ARY("dev",   Tcl_NewLongObj((long)statPtr->st_dev));
    /*
     * Watch out porters; the inode is meant to be an *unsigned* value,
     * so the cast might fail when there isn't a real arithmentic 'long
     * long' type...
     */

    STORE_ARY("atime", Tcl_NewLongObj((long)statPtr->st_atime));
    STORE_ARY("mtime", Tcl_NewLongObj((long)statPtr->st_mtime));
    STORE_ARY("ctime", Tcl_NewLongObj((long)statPtr->st_ctime));
    mode = (unsigned short) statPtr->st_mode;
    STORE_ARY("mode",  Tcl_NewIntObj(mode));
    STORE_ARY("type",  Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ARY

    Tcl_DecrRefCount(field);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

/*
 * tclDecls.h --
 *
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclDecls.h,v 1.101 2004/01/21 19:59:33 vincentdarley Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl

EXTERN int		Tcl_FSEqualPaths _ANSI_ARGS_((Tcl_Obj* firstPtr, 
				Tcl_Obj* secondPtr));
#endif
#ifndef Tcl_FSGetNormalizedPath_TCL_DECLARED
#define Tcl_FSGetNormalizedPath_TCL_DECLARED
/* 463 */
EXTERN Tcl_Obj*		Tcl_FSGetNormalizedPath _ANSI_ARGS_((
				Tcl_Interp * interp, Tcl_Obj* pathPtr));
#endif
#ifndef Tcl_FSJoinToPath_TCL_DECLARED
#define Tcl_FSJoinToPath_TCL_DECLARED
/* 464 */
EXTERN Tcl_Obj*		Tcl_FSJoinToPath _ANSI_ARGS_((Tcl_Obj * pathPtr, 
				int objc, Tcl_Obj *CONST objv[]));
#endif
#ifndef Tcl_FSGetInternalRep_TCL_DECLARED
#define Tcl_FSGetInternalRep_TCL_DECLARED
/* 465 */
EXTERN ClientData	Tcl_FSGetInternalRep _ANSI_ARGS_((Tcl_Obj* pathPtr, 
				Tcl_Filesystem * fsPtr));
#endif
#ifndef Tcl_FSGetTranslatedPath_TCL_DECLARED
#define Tcl_FSGetTranslatedPath_TCL_DECLARED
/* 466 */
EXTERN Tcl_Obj*		Tcl_FSGetTranslatedPath _ANSI_ARGS_((
				Tcl_Interp * interp, Tcl_Obj* pathPtr));
#endif

EXTERN Tcl_Obj*		Tcl_FSNewNativePath _ANSI_ARGS_((
				Tcl_Filesystem* fromFilesystem, 
				ClientData clientData));
#endif
#ifndef Tcl_FSGetNativePath_TCL_DECLARED
#define Tcl_FSGetNativePath_TCL_DECLARED
/* 469 */
EXTERN CONST char*	Tcl_FSGetNativePath _ANSI_ARGS_((Tcl_Obj* pathPtr));
#endif
#ifndef Tcl_FSFileSystemInfo_TCL_DECLARED
#define Tcl_FSFileSystemInfo_TCL_DECLARED
/* 470 */
EXTERN Tcl_Obj*		Tcl_FSFileSystemInfo _ANSI_ARGS_((Tcl_Obj* pathPtr));

#endif
#ifndef Tcl_FSPathSeparator_TCL_DECLARED
#define Tcl_FSPathSeparator_TCL_DECLARED
/* 471 */
EXTERN Tcl_Obj*		Tcl_FSPathSeparator _ANSI_ARGS_((Tcl_Obj* pathPtr));
#endif
#ifndef Tcl_FSListVolumes_TCL_DECLARED
#define Tcl_FSListVolumes_TCL_DECLARED
/* 472 */
EXTERN Tcl_Obj*		Tcl_FSListVolumes _ANSI_ARGS_((void));
#endif
#ifndef Tcl_FSRegister_TCL_DECLARED

EXTERN CONST char*	Tcl_FSGetTranslatedStringPath _ANSI_ARGS_((
				Tcl_Interp * interp, Tcl_Obj* pathPtr));
#endif
#ifndef Tcl_FSGetFileSystemForPath_TCL_DECLARED
#define Tcl_FSGetFileSystemForPath_TCL_DECLARED
/* 477 */
EXTERN Tcl_Filesystem*	Tcl_FSGetFileSystemForPath _ANSI_ARGS_((
				Tcl_Obj* pathPtr));
#endif
#ifndef Tcl_FSGetPathType_TCL_DECLARED
#define Tcl_FSGetPathType_TCL_DECLARED
/* 478 */
EXTERN Tcl_PathType	Tcl_FSGetPathType _ANSI_ARGS_((Tcl_Obj * pathPtr));
#endif
#ifndef Tcl_OutputBuffered_TCL_DECLARED
#define Tcl_OutputBuffered_TCL_DECLARED
/* 479 */
EXTERN int		Tcl_OutputBuffered _ANSI_ARGS_((Tcl_Channel chan));
#endif
#ifndef Tcl_FSMountsChanged_TCL_DECLARED

    Tcl_Channel (*tcl_FSOpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, CONST char * modeString, int permissions)); /* 456 */
    Tcl_Obj* (*tcl_FSGetCwd) _ANSI_ARGS_((Tcl_Interp * interp)); /* 457 */
    int (*tcl_FSChdir) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 458 */
    int (*tcl_FSConvertToPathType) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr)); /* 459 */
    Tcl_Obj* (*tcl_FSJoinPath) _ANSI_ARGS_((Tcl_Obj * listObj, int elements)); /* 460 */
    Tcl_Obj* (*tcl_FSSplitPath) _ANSI_ARGS_((Tcl_Obj* pathPtr, int * lenPtr)); /* 461 */
    int (*tcl_FSEqualPaths) _ANSI_ARGS_((Tcl_Obj* firstPtr, Tcl_Obj* secondPtr)); /* 462 */
    Tcl_Obj* (*tcl_FSGetNormalizedPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 463 */
    Tcl_Obj* (*tcl_FSJoinToPath) _ANSI_ARGS_((Tcl_Obj * pathPtr, int objc, Tcl_Obj *CONST objv[])); /* 464 */
    ClientData (*tcl_FSGetInternalRep) _ANSI_ARGS_((Tcl_Obj* pathPtr, Tcl_Filesystem * fsPtr)); /* 465 */
    Tcl_Obj* (*tcl_FSGetTranslatedPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 466 */
    int (*tcl_FSEvalFile) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * fileName)); /* 467 */
    Tcl_Obj* (*tcl_FSNewNativePath) _ANSI_ARGS_((Tcl_Filesystem* fromFilesystem, ClientData clientData)); /* 468 */
    CONST char* (*tcl_FSGetNativePath) _ANSI_ARGS_((Tcl_Obj* pathPtr)); /* 469 */
    Tcl_Obj* (*tcl_FSFileSystemInfo) _ANSI_ARGS_((Tcl_Obj* pathPtr)); /* 470 */
    Tcl_Obj* (*tcl_FSPathSeparator) _ANSI_ARGS_((Tcl_Obj* pathPtr)); /* 471 */
    Tcl_Obj* (*tcl_FSListVolumes) _ANSI_ARGS_((void)); /* 472 */
    int (*tcl_FSRegister) _ANSI_ARGS_((ClientData clientData, Tcl_Filesystem * fsPtr)); /* 473 */
    int (*tcl_FSUnregister) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 474 */
    ClientData (*tcl_FSData) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 475 */
    CONST char* (*tcl_FSGetTranslatedStringPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 476 */
    Tcl_Filesystem* (*tcl_FSGetFileSystemForPath) _ANSI_ARGS_((Tcl_Obj* pathPtr)); /* 477 */
    Tcl_PathType (*tcl_FSGetPathType) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 478 */
    int (*tcl_OutputBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 479 */
    void (*tcl_FSMountsChanged) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 480 */
    int (*tcl_EvalTokensStandard) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 481 */
    void (*tcl_GetTime) _ANSI_ARGS_((Tcl_Time* timeBuf)); /* 482 */
    Tcl_Trace (*tcl_CreateObjTrace) _ANSI_ARGS_((Tcl_Interp* interp, int level, int flags, Tcl_CmdObjTraceProc* objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc* delProc)); /* 483 */
    int (*tcl_GetCommandInfoFromToken) _ANSI_ARGS_((Tcl_Command token, Tcl_CmdInfo* infoPtr)); /* 484 */
    int (*tcl_SetCommandInfoFromToken) _ANSI_ARGS_((Tcl_Command token, CONST Tcl_CmdInfo* infoPtr)); /* 485 */

/*
 * 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.23 2004/01/21 19:59:33 vincentdarley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * Declarations for local procedures defined in this file:

    for (i = 2; i < objc; i++) {
	if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
	    result = TCL_ERROR;
	    break;
	}

	split = Tcl_FSSplitPath(objv[i],&pobjc);
	Tcl_IncrRefCount(split);
	if (pobjc == 0) {
	    errno = ENOENT;
	    errfile = objv[i];
	    break;
	}
	for (j = 0; j < pobjc; j++) {
	    target = Tcl_FSJoinPath(split, j + 1);

	 * the low-level Tcl_FSRenameFileProc in the filesystem is allowed 
	 * to implement cross-filesystem moves itself, if it desires.
	 */
    }

    actualSource = source;
    Tcl_IncrRefCount(actualSource);


    /* 
     * Activate the following block to copy files instead of links.
     * However Tcl's semantics currently say we should copy links, so
     * any such change should be the subject of careful study on 
     * the consequences.
     * 
     * Perhaps there could be an optional flag to 'file copy' to
     * dictate which approach to use, with the default being _not_
     * to have this block active.
     */
#if 0
#ifdef S_ISLNK
    if (copyFlag && S_ISLNK(sourceStatBuf.st_mode)) {
	/* 
	 * We want to copy files not links.  Therefore we must follow the
	 * link.  There are two purposes to this 'stat' call here.  First
	 * we want to know if the linked-file/dir actually exists, and
	 * second, in the block of code which follows, some 20 lines
	 * down, we want to check if the thing is a file or directory.

	} else {
	    int counter = 0;
	    while (1) {
		Tcl_Obj *path = Tcl_FSLink(actualSource, NULL, 0);
		if (path == NULL) {
		    break;
		}
		/* 
		 * Now we want to check if this is a relative path,
		 * and if so, to make it absolute
		 */
		if (Tcl_FSGetPathType(path) == TCL_PATH_RELATIVE) {
		    Tcl_Obj *abs = Tcl_FSJoinToPath(actualSource, 1, &path);
		    if (abs == NULL) break;
		    Tcl_IncrRefCount(abs);
		    Tcl_DecrRefCount(path);
		    path = abs;
		}
		Tcl_DecrRefCount(actualSource);
		actualSource = path;
		counter++;
		/* Arbitrary limit of 20 links to follow */
		if (counter > 20) {
		    /* Too many links */
		    Tcl_SetErrno(EMLINK);

    Tcl_Obj *pathPtr;		/* Path whose basename to extract. */
{
    int objc;
    Tcl_Obj *splitPtr;
    Tcl_Obj *resultPtr = NULL;
    
    splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
    Tcl_IncrRefCount(splitPtr);
    
    if (objc != 0) {
	if ((objc == 1) && (*Tcl_GetString(pathPtr) == '~')) {
	    Tcl_DecrRefCount(splitPtr);
	    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
		return NULL;
	    }
	    splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
	    Tcl_IncrRefCount(splitPtr);
	}

	/*
	 * Return the last component, unless it is the only component, and it
	 * is the root of an absolute path.
	 */

/* 
 * tclFileName.c --
 *
 *	This file contains routines for converting file names betwen
 *	native and network form.
 *
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclFileName.c,v 1.46 2004/01/21 19:59:33 vincentdarley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"

/* 

 */

static CONST char *	DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST char *user, Tcl_DString *resultPtr));
static CONST char *	ExtractWinRoot _ANSI_ARGS_((CONST char *path,
			    Tcl_DString *resultPtr, int offset, 
			    Tcl_PathType *typePtr));
static int		SkipToChar _ANSI_ARGS_((CONST char **stringPtr,
			    char match));
static Tcl_Obj*		SplitMacPath _ANSI_ARGS_((CONST char *path));
static Tcl_Obj*		SplitWinPath _ANSI_ARGS_((CONST char *path));
static Tcl_Obj*		SplitUnixPath _ANSI_ARGS_((CONST char *path));
static int              DoGlob _ANSI_ARGS_((Tcl_Interp *interp, 
			    char *separators, Tcl_Obj *pathPtr, 
			    int flags, char *pattern, Tcl_GlobTypeData *types));

#ifdef MAC_UNDERSTANDS_UNIX_PATHS

/*
 *----------------------------------------------------------------------
 *
 * FileNameInit --
 *

 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclpGetNativePathType(pathPtr, driveNameLengthPtr, driveNameRef)
    Tcl_Obj *pathPtr;      /* Native path of interest */
    int *driveNameLengthPtr;  /* Returns length of drive, if non-NULL
                               * and path was absolute */
    Tcl_Obj **driveNameRef;   
{
    Tcl_PathType type = TCL_PATH_ABSOLUTE;
    int pathLen;
    char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
    
    if (path[0] == '~') {
	/* 
	 * This case is common to all platforms.
	 * Paths that begin with ~ are absolute.
	 */
	if (driveNameLengthPtr != NULL) {

    /*
     * Perform the splitting, using objectified, vfs-aware code.
     */

    tmpPtr = Tcl_NewStringObj(path, -1);
    Tcl_IncrRefCount(tmpPtr);
    resultPtr = Tcl_FSSplitPath(tmpPtr, argcPtr);
    Tcl_IncrRefCount(resultPtr);
    Tcl_DecrRefCount(tmpPtr);

    /* Calculate space required for the result */
    
    size = 1;
    for (i = 0; i < *argcPtr; i++) {
	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);

 *---------------------------------------------------------------------------
 *
 * Tcl_FSJoinToPath --
 *
 *      This function takes the given object, which should usually be a
 *      valid path or NULL, and joins onto it the array of paths
 *      segments given.
 *      
 *      The objects in the array given will temporarily have their
 *      refCount increased by one, and then decreased by one when this
 *      function exits (which means if they had zero refCount when we
 *      were called, they will be freed).
 *      
 * Results:
 *      Returns object owned by the caller (which should increment its
 *      refCount) - typically an object with refCount of zero.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj* 
Tcl_FSJoinToPath(pathPtr, objc, objv)
    Tcl_Obj *pathPtr;      /* Valid path or NULL. */
    int objc;              /* Number of array elements to join */
    Tcl_Obj *CONST objv[]; /* Path elements to join. */
{
    int i;
    Tcl_Obj *lobj, *ret;

    if (pathPtr == NULL) {
	lobj = Tcl_NewListObj(0, NULL);
    } else {
	lobj = Tcl_NewListObj(1, &pathPtr);
    }
    
    for (i = 0; i<objc;i++) {
	Tcl_ListObjAppendElement(NULL, lobj, objv[i]);
    }
    ret = Tcl_FSJoinPath(lobj, -1);
    /*
     * It is possible that 'ret' is just a member of the list and is
     * therefore going to be freed here.  Therefore we must adjust the
     * refCount manually.  (It would be better if we changed the
     * documentation of this function and Tcl_FSJoinPath so that
     * the returned object already has a refCount for the caller,
     * hence avoiding these subtleties (and code ugliness)). 
     */
    Tcl_IncrRefCount(ret);
    Tcl_DecrRefCount(lobj);
    ret->refCount--;
    return ret;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpNativeJoinPath --

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

CONST char *
TclGetExtension(name)
    CONST char *name;			/* File name to parse. */
{
    CONST char *p, *lastSep;

    /*
     * First find the last directory separator.
     */

    lastSep = NULL;		/* Needed only to prevent gcc warnings. */
    switch (tclPlatform) {

	    /* It's really a directory */
	    dir = PATH_DIR;
	} else {
	    Tcl_DString pref;
	    char *search, *find;
	    Tcl_DStringInit(&pref);
	    if (last == first) {
		/* 
		 * The whole thing is a prefix.  This means we must
		 * remove any 'tails' flag too, since it is irrelevant
		 * now (the same effect will happen without it), but in
		 * particular its use in TclGlob requires a non-NULL
		 * pathOrDir.
		 */
		Tcl_DStringAppend(&pref, first, -1);
		globFlags &= ~TCL_GLOBMODE_TAILS;
		pathOrDir = NULL;
	    } else {
		/* Have to split off the end */
		Tcl_DStringAppend(&pref, last, first+pathlength-last);
		pathOrDir = Tcl_NewStringObj(first, last-first-1);
	    }
	    /* Need to quote 'prefix' */

}

/*
 *----------------------------------------------------------------------
 *
 * TclGlob --
 *
 *	This procedure prepares arguments for the DoGlob call.
 *	It sets the separator string based on the platform, performs
 *      tilde substitution, and calls DoGlob.
 *      
 *      The interpreter's result, on entry to this function, must
 *      be a valid Tcl list (e.g. it could be empty), since we will
 *      lappend any new results to that list.  If it is not a valid
 *      list, this function will fail to do anything very meaningful.
 *      
 *      Note that if globFlags contains 'TCL_GLOBMODE_TAILS' then
 *      pathPrefix cannot be NULL (it is only allowed with -dir or
 *      -path).
 *
 * Results:
 *	The return value is a standard Tcl result indicating whether
 *	an error occurred in globbing.  After a normal return the
 *	result in interp (set by DoGlob) holds all of the file names
 *	given by the pattern and pathPrefix arguments.  After an 
 *	error the result in interp will hold an error message, unless
 *	the 'TCL_GLOBMODE_NO_COMPLAIN' flag was given, in which case
 *	an error results in a TCL_OK return leaving the interpreter's
 *	result unmodified.
 *
 * Side effects:
 *	The 'pattern' is written to.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
TclGlob(interp, pattern, pathPrefix, globFlags, types)
    Tcl_Interp *interp;		/* Interpreter for returning error message
				 * or appending list of matching file names. */
    char *pattern;		/* Glob pattern to match. Must not refer
				 * to a static string. */
    Tcl_Obj *pathPrefix;	/* Path prefix to glob pattern, if non-null, 
                        	 * which is considered literally. */
    int globFlags;		/* Stores or'ed combination of flags */
    Tcl_GlobTypeData *types;	/* Struct containing acceptable types.
				 * May be NULL. */
{
    char *separators;
    CONST char *head;
    char *tail, *start;

    int result;

    Tcl_Obj *oldResult;
    
    separators = NULL;		/* lint. */
    switch (tclPlatform) {
	case TCL_PLATFORM_UNIX:
	    separators = "/";
	    break;
	case TCL_PLATFORM_WINDOWS:
	    separators = "/\\:";
	    break;
	case TCL_PLATFORM_MAC:
#ifdef MAC_UNDERSTANDS_UNIX_PATHS
	    if (pathPrefix == NULL) {
		separators = (strchr(pattern, ':') == NULL) ? "/" : ":";
	    } else {
		separators = ":";
	    }
#else
	    separators = ":";
#endif
	    break;
    }

    if (pathPrefix == NULL) {
	char c;
	Tcl_DString buffer;
	Tcl_DStringInit(&buffer);



	start = pattern;


	/*
	 * Perform tilde substitution, if needed.
	 */

	if (start[0] == '~') {
	    
	    /*
	     * Find the first path separator after the tilde.
	     */
	    for (tail = start; *tail != '\0'; tail++) {
		if (*tail == '\\') {
		    if (strchr(separators, tail[1]) != NULL) {
			break;
		    }
		} else if (strchr(separators, *tail) != NULL) {
		    break;
		}
	    }

	    /*
	     * Determine the home directory for the specified user.  
	     */
	    
	    c = *tail;
	    *tail = '\0';
	    if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
		/* 
		 * We will ignore any error message here, and we
		 * don't want to mess up the interpreter's result.
		 */
		head = DoTildeSubst(NULL, start+1, &buffer);
	    } else {
		head = DoTildeSubst(interp, start+1, &buffer);
	    }
	    *tail = c;
	    if (head == NULL) {
		if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
		    return TCL_OK;
		} else {
		    return TCL_ERROR;
		}
	    }
	    if (head != Tcl_DStringValue(&buffer)) {
		Tcl_DStringAppend(&buffer, head, -1);
	    }
	    pathPrefix = Tcl_NewStringObj(Tcl_DStringValue(&buffer),
					  Tcl_DStringLength(&buffer));
	    Tcl_IncrRefCount(pathPrefix);
	    globFlags |= TCL_GLOBMODE_DIR;
	    if (c != '\0') {
	        tail++;
	    }
	    Tcl_DStringFree(&buffer);
	} else {
	    tail = pattern;


	}
    } else {
	Tcl_IncrRefCount(pathPrefix);
	tail = pattern;
    }
    
    /* 
     * Handling empty path prefixes with glob patterns like 'C:' or
     * 'c:////////' is a pain on Windows if we leave it too late, since
     * these aren't really patterns at all!  We therefore check the head
     * of the pattern now for such cases, if we don't have an unquoted


     * prefix yet.
     * 
     * Similarly on Unix with '/' at the head of the pattern -- it
     * just indicates the root volume, so we treat it as such.
     */
    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
	if (pathPrefix == NULL && tail[0] != '\0' && tail[1] == ':') {
	    char *p = tail + 1;
	    pathPrefix = Tcl_NewStringObj(tail, 1);
	    while (*p != '\0') {
		char c = p[1];
	        if (*p == '\\') {
	            if (strchr(separators, c) != NULL) {
			if (c == '\\') c = '/';
			Tcl_AppendToObj(pathPrefix, &c, 1);
			p++;
	            } else {
			break;
		    }


		} else if (strchr(separators, *p) != NULL) {
		    Tcl_AppendToObj(pathPrefix, p, 1);
	        } else {
		    break;
		}
		p++;
	    }
	    tail = p;
	    Tcl_IncrRefCount(pathPrefix);
	}
	/* 

	 * ':' no longer needed as a separator. It is only relevant
	 * to the beginning of the path.
	 */

	separators = "/\\";

    } else if (tclPlatform == TCL_PLATFORM_UNIX) {
	if (pathPrefix == NULL && tail[0] == '/') {
	    pathPrefix = Tcl_NewStringObj(tail, 1);
	    tail++;
	    Tcl_IncrRefCount(pathPrefix);
	}
    }
    
    /* 
     * We need to get the old result, in case it is over-written
     * below when we still need it.
     */
    oldResult = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(oldResult);
    Tcl_ResetResult(interp);

    if (*tail == '\0' && pathPrefix != NULL) {
	/* 
	 * An empty pattern 
	 */
	result = Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp), 
					pathPrefix, NULL, types);
	
    } else {
	result = DoGlob(interp, separators, pathPrefix, 
			globFlags & TCL_GLOBMODE_DIR, tail, types);
    }
    
    if (result != TCL_OK) {
	if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
	    /* Put back the old result and reset the return code */
	    Tcl_SetObjResult(interp, oldResult);
	    result = TCL_OK;
	}
    } else {
	/* 
	 * Now we must concatenate the 'oldResult' and the current
	 * result, and then place that into the interpreter.
	 * 
	 * If we only want the tails, we must strip off the prefix now.
	 * It may seem more efficient to pass the tails flag down into
	 * DoGlob, Tcl_FSMatchInDirectory, but those functions are
	 * continually adjusting the prefix as the various pieces of
	 * the pattern are assimilated, so that would add a lot of
	 * complexity to the code.  This way is a little slower (when
	 * the -tails flag is given), but much simpler to code.
	 */



	/* 
	 * Ensure sole ownership.  We also assume that oldResult
	 * is a valid list in the code below.
	 */
	if (Tcl_IsShared(oldResult)) {
	    Tcl_DecrRefCount(oldResult);
	    oldResult = Tcl_DuplicateObj(oldResult);
	    Tcl_IncrRefCount(oldResult);
	}

	if (globFlags & TCL_GLOBMODE_TAILS) {
	    int objc, i;
	    Tcl_Obj **objv;
	    int prefixLen;
	    
	    /* If this length has never been set, set it here */
	    CONST char *pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen);
	    if (prefixLen > 0) {
		if (strchr(separators, pre[prefixLen-1]) == NULL) {
		    prefixLen++;
		}
	    }

	    Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), 
				   &objc, &objv);
    #ifdef MAC_TCL
	    /* adjust prefixLen if DoGlob prepended a ':' */
	    if ((prefixLen > 0) && (objc > 0) && (pre[0] != ':')) {

		CONST char *str = Tcl_GetStringFromObj(objv[0],NULL);
		if (str[0] == ':') {
		    prefixLen++;
		}
	    }
    #endif
	    for (i = 0; i< objc; i++) {
		Tcl_Obj* elt;

		int len;
		char *oldStr = Tcl_GetStringFromObj(objv[i],&len);
		if (len == prefixLen) {
		    if ((pattern[0] == '\0')
			|| (strchr(separators, pattern[0]) == NULL)) {
			elt = Tcl_NewStringObj(".",1);
		    } else {
			elt = Tcl_NewStringObj("/",1);
		    }
		} else {
		    elt = Tcl_NewStringObj(oldStr + prefixLen, 
						len - prefixLen);
		}
		Tcl_ListObjAppendElement(interp, oldResult, elt);

	    }

	} else {
	    Tcl_ListObjAppendList(interp, oldResult, Tcl_GetObjResult(interp));
	}
	Tcl_SetObjResult(interp, oldResult);
    }
    /* 
     * Release our temporary copy.  All code paths above must
     * end here so we free our reference.
     */
    Tcl_DecrRefCount(oldResult);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * SkipToChar --

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

static int
SkipToChar(stringPtr, match)
    CONST char **stringPtr;	/* Pointer string to check. */
    char match;			/* Pointer to character to find. */
{
    int quoted, level;
    register CONST char *p;

    quoted = 0;
    level = 0;

    for (p = *stringPtr; *p != '\0'; p++) {
	if (quoted) {
	    quoted = 0;
	    continue;
	}
	if ((level == 0) && (*p == match)) {
	    *stringPtr = p;
	    return 1;
	}
	if (*p == '{') {
	    level++;
	} else if (*p == '}') {
	    level--;
	} else if (*p == '\\') {
	    quoted = 1;
	}
    }
    *stringPtr = p;
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * DoGlob --
 *
 *	This recursive procedure forms the heart of the globbing code.
 *	It performs a depth-first traversal of the tree given by the
 *	path name to be globbed and the pattern.  The directory and
 *	remainder are assumed to be native format paths.  The prefix
 *	contained in 'pathPtr' is either a directory or path from which


 *	to start the search (or NULL).
 *	
 * Results:
 *	The return value is a standard Tcl result indicating whether
 *	an error occurred in globbing.  After a normal return the
 *	result in interp will be set to hold all of the file names
 *	given by the dir and remaining arguments.  After an error the
 *	result in interp will hold an error message.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
DoGlob(interp, separators, pathPtr, flags, pattern, types)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting
				 * (e.g. unmatched brace). */
    char *separators;		/* String containing separator characters
				 * that should be used to identify globbing
				 * boundaries. */
    Tcl_Obj *pathPtr;	        /* Completely expanded prefix. */
    int flags;                  /* If non-zero then pathPtr is a
                                 * directory */
    char *pattern;		/* The pattern to match against.
				 * Must not be a pointer to a static string. */
    Tcl_GlobTypeData *types;	/* List object containing list of acceptable 
				 * types. May be NULL. */
{
    int baseLength, quoted, count;
    int result = TCL_OK;
    char *name, *p, *openBrace, *closeBrace, *firstSpecialChar;








    /*
     * Consume any leading directory separators, leaving pattern pointing
     * just past the last initial separator.
     */

    count = 0;
    name = pattern;
    for (; *pattern != '\0'; pattern++) {
	if (*pattern == '\\') {
	    /* 
	     * If the first character is escaped, either we have a directory
	     * separator, or we have any other character.  In the latter case
	     * the rest is a pattern, and we must break from the loop.
	     * This is particularly important on Windows where '\' is both
	     * the escaping character and a directory separator.
	     */
	    if (strchr(separators, pattern[1]) != NULL) {
		pattern++;
	    } else {
		break;
	    }
	} else if (strchr(separators, *pattern) == NULL) {
	    break;
	}
	count++;
    }

    /* 
     * This block of code is not exercised by the Tcl test suite as of
     * Tcl 8.5a0.  Simplifications to the calling paths suggest it may
     * not be necessary any more, since path separators are handled
     * elsewhere.  It is left in place in case new bugs are reported
     * (particularly on MacOS)
     */

#if 0
    /*
     * Deal with path separators.  On the Mac, we have to watch out
     * for multiple separators, since they are special in Mac-style
     * paths.
     */
    if (pathPtr == NULL) {
	/* 
	 * Length used to be the length of the prefix, and lastChar
	 * the lastChar of the prefix.  But, none of this is used
	 * any more.
	 */
	int length = 0;
	char lastChar = 0;

	switch (tclPlatform) {
	    case TCL_PLATFORM_MAC:
    #ifdef MAC_UNDERSTANDS_UNIX_PATHS
		if (*separators == '/') {
		    if (((length == 0) && (count == 0))
			    || ((length > 0) && (lastChar != ':'))) {
			Tcl_DStringAppend(&append, ":", 1);
		    }
		} else {
    #endif
		    if (count == 0) {
			if ((length > 0) && (lastChar != ':')) {
			    Tcl_DStringAppend(&append, ":", 1);
			}
		    } else {
			if (lastChar == ':') {
			    count--;
			}
			while (count-- > 0) {
			    Tcl_DStringAppend(&append, ":", 1);
			}
		    }
    #ifdef MAC_UNDERSTANDS_UNIX_PATHS
		}
    #endif
		break;
	    case TCL_PLATFORM_WINDOWS:
		/*
		 * If this is a drive relative path, add the colon and the
		 * trailing slash if needed.  Otherwise add the slash if
		 * this is the first absolute element, or a later relative
		 * element.  Add an extra slash if this is a UNC path.
		 */

		if (*name == ':') {
		    Tcl_DStringAppend(&append, ":", 1);
		    if (count > 1) {
			Tcl_DStringAppend(&append, "/", 1);
		    }
		} else if ((*pattern != '\0')
			&& (((length > 0)
				&& (strchr(separators, lastChar) == NULL))
				|| ((length == 0) && (count > 0)))) {
		    Tcl_DStringAppend(&append, "/", 1);
		    if ((length == 0) && (count > 1)) {
			Tcl_DStringAppend(&append, "/", 1);
		    }
		}
		
		break;
	    case TCL_PLATFORM_UNIX:
		/*
		 * Add a separator if this is the first absolute element, or
		 * a later relative element.
		 */

		if ((*pattern != '\0')
			&& (((length > 0)
				&& (strchr(separators, lastChar) == NULL))
				|| ((length == 0) && (count > 0)))) {
		    Tcl_DStringAppend(&append, "/", 1);
		}
		break;
	}
    }
#endif
    
    /*
     * Look for the first matching pair of braces or the first
     * directory separator that is not inside a pair of braces.
     */

    openBrace = closeBrace = NULL;
    quoted = 0;
    for (p = pattern; *p != '\0'; p++) {
	if (quoted) {
	    quoted = 0;
	} else if (*p == '\\') {
	    quoted = 1;
	    if (strchr(separators, p[1]) != NULL) {
		/* Quoted directory separator. */
		break;			
	    }
	} else if (strchr(separators, *p) != NULL) {
	    /* Unquoted directory separator. */
	    break;
	} else if (*p == '{') {
	    openBrace = p;
	    p++;
	    if (SkipToChar(&p, '}')) {
		/* Balanced braces. */
		closeBrace = p;
		break;
	    }
	    Tcl_SetResult(interp, "unmatched open-brace in file name",
		    TCL_STATIC);
	    return TCL_ERROR;
	} else if (*p == '}') {
	    Tcl_SetResult(interp, "unmatched close-brace in file name",
		    TCL_STATIC);
	    return TCL_ERROR;
	}
    }

    /*
     * Substitute the alternate patterns from the braces and recurse.
     */

    if (openBrace != NULL) {
	char *element;
	
	Tcl_DString newName;
	Tcl_DStringInit(&newName);

	/*
	 * For each element within in the outermost pair of braces,
	 * append the element and the remainder to the fixed portion
	 * before the first brace and recursively call TclDoGlob.
	 */

	Tcl_DStringAppend(&newName, pattern, openBrace-pattern);
	baseLength = Tcl_DStringLength(&newName);

	*closeBrace = '\0';
	for (p = openBrace; p != closeBrace; ) {
	    p++;
	    element = p;
	    SkipToChar(&p, ',');

	    Tcl_DStringSetLength(&newName, baseLength);
	    Tcl_DStringAppend(&newName, element, p-element);
	    Tcl_DStringAppend(&newName, closeBrace+1, -1);
	    result = DoGlob(interp, separators, pathPtr, flags,
			    Tcl_DStringValue(&newName), types);
	    if (result != TCL_OK) {
		break;
	    }
	}
	*closeBrace = '}';
	Tcl_DStringFree(&newName);
	return result;
    }

    /*
     * At this point, there are no more brace substitutions to perform on
     * this path component.  The variable p is pointing at a quoted or
     * unquoted directory separator or the end of the string.  So we need
     * to check for special globbing characters in the current pattern.
     * We avoid modifying pattern if p is pointing at the end of the string.
     * 
     * If we find any globbing characters, then we must call 
     * Tcl_FSMatchInDirectory.  If we're at the end of the string, then
     * that's all we need to do.  If we're not at the end of the
     * string, then we must recurse, so we do that below.
     * 
     * Alternatively, if there are no globbing characters then again
     * there are two cases.  If we're at the end of the string, we just
     * need to check for the given path's existence and type.  If we're
     * not at the end of the string, we recurse.
     */

    if (*p != '\0') {

	/*
	 * Note that we are modifying the string in place.  This won't work
	 * if the string is a static.
	 */

	char savedChar = *p;
	*p = '\0';
	firstSpecialChar = strpbrk(pattern, "*[]?\\");
	*p = savedChar;
    } else {
	firstSpecialChar = strpbrk(pattern, "*[]?\\");
    }

    if (firstSpecialChar != NULL) {
	int ret;


	/*
	 * Look for matching files in the given directory.  The
	 * implementation of this function is filesystem specific.  For
	 * each file that matches, it will add the match onto the
	 * resultPtr given.
	 */
	if (*p == '\0') {
	    ret = Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp), 
					 pathPtr, pattern, types);
	} else {
	    Tcl_Obj* resultPtr;

	    /* 
	     * We do the recursion ourselves.  This makes implementing
	     * Tcl_FSMatchInDirectory for each filesystem much easier.
	     */
	    Tcl_GlobTypeData dirOnly = { TCL_GLOB_TYPE_DIR, 0, NULL, NULL };
	    char save = *p;
	    
	    *p = '\0';
	    resultPtr = Tcl_NewListObj(0, NULL);
	    ret = Tcl_FSMatchInDirectory(interp, resultPtr, 
					 pathPtr, pattern, &dirOnly);
	    *p = save;
	    if (ret == TCL_OK) {
		int resLength;
		ret = Tcl_ListObjLength(interp, resultPtr, &resLength);
		if (ret == TCL_OK) {
		    int i;
		    for (i =0; i< resLength; i++) {
			Tcl_Obj *elt;
			
			Tcl_ListObjIndex(interp, resultPtr, i, &elt);







			ret = DoGlob(interp, separators, elt, 1, p+1, types);

			if (ret != TCL_OK) {
			    break;
			}
		    }
		}
	    }
	    Tcl_DecrRefCount(resultPtr);
	}

	return ret;
    } else {
	/* 
	 * We reach here with no pattern char in current section 
	 */
	

	if (*p != '\0') {
	    Tcl_Obj *joined;
	    int ret;
	    
	    /* 
	     * If it's not the end of the string, we must recurse 
	     */
	    if (pathPtr != NULL) {
		if (flags) {
		    joined = TclNewFSPathObj(pathPtr, pattern, p-pattern);
		} else {
		    joined = Tcl_DuplicateObj(pathPtr);
		    Tcl_AppendToObj(joined, pattern, p-pattern);
		}
	    } else {
		joined = Tcl_NewStringObj(pattern, p-pattern);
	    }
	    Tcl_IncrRefCount(joined);
	    ret = DoGlob(interp, separators, joined, 1, p, types);
	    Tcl_DecrRefCount(joined);
	    return ret;
	} else {
	    /*
	     * This is the code path reached by a command like 'glob foo'.
	     *
	     * There are no more wildcards in the pattern and no more
	     * unprocessed characters in the pattern, so now we can construct
	     * the path, and pass it to Tcl_FSMatchInDirectory with an
	     * empty pattern to verify the existence of the file and check
	     * it is of the correct type (if a 'types' flag it given -- if
	     * no such flag was given, we could just use 'Tcl_FSLStat', but
	     * for simplicity we keep to a common approach).
	     */

	    Tcl_Obj *joined;
	    int length;
	    Tcl_DString append;
	    
	    Tcl_DStringInit(&append);
	    Tcl_DStringAppend(&append, pattern, p-pattern);

	    if (pathPtr != NULL) {
		Tcl_GetStringFromObj(pathPtr, &length);
	    } else {
		length = 0;
	    }

	    switch (tclPlatform) {
		case TCL_PLATFORM_MAC: {
		    if (strchr(Tcl_DStringValue(&append), ':') == NULL) {
			Tcl_DStringAppend(&append, ":", 1);
		    }
		    break;
		}
		case TCL_PLATFORM_WINDOWS: {
		    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
			if (((*name == '\\') && (name[1] == '/' || name[1] == '\\'))
				|| (*name == '/')) {
			    Tcl_DStringAppend(&append, "/", 1);
			} else {
			    Tcl_DStringAppend(&append, ".", 1);
			}
		    }
    #if defined(__CYGWIN__) && defined(__WIN32__)
		    {
		    extern int cygwin_conv_to_win32_path 
			_ANSI_ARGS_((CONST char *, char *));
		    char winbuf[MAX_PATH+1];

		    cygwin_conv_to_win32_path(Tcl_DStringValue(&append), winbuf);
		    Tcl_DStringFree(&append);
		    Tcl_DStringAppend(&append, winbuf, -1);
		    }
    #endif /* __CYGWIN__ && __WIN32__ */











		    break;
		}
		case TCL_PLATFORM_UNIX: {
		    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
			if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
			    Tcl_DStringAppend(&append, "/", 1);
			} else {
			    Tcl_DStringAppend(&append, ".", 1);
			}
		    }
		    break;
		}
	    }
	    /* Common for all platforms */
	    if (pathPtr != NULL) {
		if (flags) {
		    joined = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append), 
					     Tcl_DStringLength(&append));
		} else {
		    joined = Tcl_DuplicateObj(pathPtr);
		    Tcl_AppendToObj(joined, Tcl_DStringValue(&append), 

				    Tcl_DStringLength(&append));

		}

	    } else {
		joined = Tcl_NewStringObj(Tcl_DStringValue(&append), 

























					  Tcl_DStringLength(&append));

	    }


	    Tcl_IncrRefCount(joined);


	    Tcl_DStringFree(&append);


	    Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp), joined, 
				   NULL, types);
	    Tcl_DecrRefCount(joined);


	    return TCL_OK;
	}

    }



















}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_AllocStatBuf
 *

/* 
 * tclFileSystem.h --
 *
 *	This file contains the common defintions and prototypes for
 *	use by Tcl's filesystem and path handling layers.
 *
 * Copyright (c) 2003 Vince Darley.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclFileSystem.h,v 1.6 2004/01/21 19:59:33 vincentdarley Exp $
 */

/* 
 * struct FilesystemRecord --
 * 
 * A filesystem record is used to keep track of each
 * filesystem currently registered with the core,

 * time the corresponding epoch counter changes.
 */
typedef struct ThreadSpecificData {
    int initialized;
    int cwdPathEpoch;
    int filesystemEpoch;
    Tcl_Obj *cwdPathPtr;
    ClientData cwdClientData;
    FilesystemRecord *filesystemList;
} ThreadSpecificData;

/* 
 * The internal TclFS API provides routines for handling and
 * manipulating paths efficiently, taking direct advantage of
 * the "path" Tcl_Obj type.
 * 
 * These functions are not exported at all at present.
 */

int      TclFSCwdPointerEquals _ANSI_ARGS_((Tcl_Obj** pathPtrPtr));
int	 TclFSMakePathFromNormalized _ANSI_ARGS_((Tcl_Interp *interp, 
		Tcl_Obj *pathPtr, ClientData clientData));
int      TclFSNormalizeToUniquePath _ANSI_ARGS_((Tcl_Interp *interp, 
		Tcl_Obj *pathPtr, int startAt, ClientData *clientDataPtr));
Tcl_Obj* TclFSMakePathRelative _ANSI_ARGS_((Tcl_Interp *interp, 
		Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr));
Tcl_Obj* TclFSInternalToNormalized _ANSI_ARGS_((
		Tcl_Filesystem *fromFilesystem, ClientData clientData,
		FilesystemRecord **fsRecPtrPtr));
int      TclFSEnsureEpochOk _ANSI_ARGS_((Tcl_Obj* pathPtr,
		Tcl_Filesystem **fsPtrPtr));
void     TclFSSetPathDetails _ANSI_ARGS_((Tcl_Obj *pathPtr, 
		FilesystemRecord *fsRecPtr, ClientData clientData ));
Tcl_Obj* TclFSNormalizeAbsolutePath _ANSI_ARGS_((Tcl_Interp* interp, 
		Tcl_Obj *pathPtr, ClientData *clientDataPtr));

/* 
 * Private shared variables for use by tclIOUtil.c and tclPathObj.c
 */
extern Tcl_Filesystem tclNativeFilesystem;
extern Tcl_ThreadDataKey tclFsDataKey;

/* 
 * Private shared functions for use by tclIOUtil.c and tclPathObj.c
 */
Tcl_PathType     TclFSGetPathType  _ANSI_ARGS_((Tcl_Obj *pathPtr, 
			    Tcl_Filesystem **filesystemPtrPtr, 
			    int *driveNameLengthPtr));
Tcl_PathType     TclGetPathType  _ANSI_ARGS_((Tcl_Obj *pathPtr, 
			    Tcl_Filesystem **filesystemPtrPtr, 
			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
Tcl_FSPathInFilesystemProc TclNativePathInFilesystem;

 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 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: tclIOUtil.c,v 1.93 2004/01/21 19:59:33 vincentdarley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#ifdef MAC_TCL
#include "tclMacInt.h"
#endif
#ifdef __WIN32__
/* for tclWinProcs->useWide */
#include "tclWinInt.h"
#endif
#include "tclFileSystem.h"

/*
 * Prototypes for procedures defined later in this file.
 */

static FilesystemRecord*   FsGetFirstFilesystem _ANSI_ARGS_((void));
static void                FsThrExitProc _ANSI_ARGS_((ClientData cd));
static Tcl_Obj*            FsListMounts _ANSI_ARGS_((Tcl_Obj *pathPtr, 
					   CONST char *pattern));
static Tcl_Obj*            FsAddMountsToGlobResult  _ANSI_ARGS_((Tcl_Obj *result, 
	                                   Tcl_Obj *pathPtr, CONST char *pattern, 
					   Tcl_GlobTypeData *types));
static void                FsUpdateCwd _ANSI_ARGS_((Tcl_Obj *cwdObj, 
					   ClientData clientData));

#ifdef TCL_THREADS
static void FsRecacheFilesystemList(void);
#endif

/* 
 * These form part of the native filesystem support.  They are needed
 * here because we have a few native filesystem functions (which are

 * which ensure correct and complete virtual filesystem support.
 * 
 * We cannot make all of these static, since some of them
 * are implemented in the platform-specific directories.
 */
static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;
static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;

static Tcl_FSCreateInternalRepProc NativeCreateNativeRep;
static Tcl_FSFileAttrStringsProc NativeFileAttrStrings;
static Tcl_FSFileAttrsGetProc NativeFileAttrsGet;
static Tcl_FSFileAttrsSetProc NativeFileAttrsSet;

/* 
 * The only reason these functions are not static is that they
 * are either called by code in the native (win/unix/mac) directories
 * or they are actually implemented in those directories.  They
 * should simply not be called by code outside Tcl's native
 * filesystem core.  i.e. they should be considered 'static' to
 * Tcl's filesystem code (if we ever built the native filesystem
 * support into a separate code library, this could actually be
 * enforced).
 */
Tcl_FSFilesystemPathTypeProc TclpFilesystemPathType;
Tcl_FSInternalToNormalizedProc TclpNativeToNormalized;
Tcl_FSStatProc TclpObjStat;
Tcl_FSAccessProc TclpObjAccess;	    
Tcl_FSMatchInDirectoryProc TclpMatchInDirectory;  

Tcl_FSChdirProc TclpObjChdir;	    
Tcl_FSLstatProc TclpObjLstat;	    
Tcl_FSCopyFileProc TclpObjCopyFile; 
Tcl_FSDeleteFileProc TclpObjDeleteFile;	    
Tcl_FSRenameFileProc TclpObjRenameFile;	    
Tcl_FSCreateDirectoryProc TclpObjCreateDirectory;	    
Tcl_FSCopyDirectoryProc TclpObjCopyDirectory;	    

 * helper functions of them).  Anything which is not part of this
 * 'native filesystem implementation' should not be delving inside
 * here!
 */
Tcl_Filesystem tclNativeFilesystem = {
    "native",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_2,
    &TclNativePathInFilesystem,
    &TclNativeDupInternalRep,
    &NativeFreeInternalRep,
    &TclpNativeToNormalized,
    &NativeCreateNativeRep,
    &TclpObjNormalizePath,
    &TclpFilesystemPathType,

    &TclpObjRemoveDirectory, 
    &TclpObjDeleteFile,
    &TclpObjCopyFile,
    &TclpObjRenameFile,
    &TclpObjCopyDirectory, 
    &TclpObjLstat,
    &TclpDlopen,
    /* Needs a cast since we're using version_2 */
    (Tcl_FSGetCwdProc*)&TclpGetNativeCwd,
    &TclpObjChdir
};

/* 
 * Define the tail of the linked list.  Note that for unconventional
 * uses of Tcl without a native filesystem, we may in the future wish
 * to modify the current approach of hard-coding the native filesystem

TCL_DECLARE_MUTEX(filesystemMutex)

/* 
 * Used to implement Tcl_FSGetCwd in a file-system independent way.
 */
static Tcl_Obj* cwdPathPtr = NULL;
static int cwdPathEpoch = 0;
static ClientData cwdClientData = NULL;
TCL_DECLARE_MUTEX(cwdMutex)

Tcl_ThreadDataKey tclFsDataKey;

/* 
 * Declare fallback support function and 
 * information for Tcl_FSLoadFile 

    ThreadSpecificData *tsdPtr = (ThreadSpecificData*)cd;
    FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL;

    /* Trash the cwd copy */
    if (tsdPtr->cwdPathPtr != NULL) {
	Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
    }
    if (tsdPtr->cwdClientData != NULL) {
	NativeFreeInternalRep(tsdPtr->cwdClientData);
    }
    /* Trash the filesystems cache */
    fsRecPtr = tsdPtr->filesystemList;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = fsRecPtr->nextPtr;
	if (--fsRecPtr->fileRefCount <= 0) {
	    ckfree((char *)fsRecPtr);
	}
	fsRecPtr = tmpFsRecPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclFSCwdPointerEquals --
 *
 *	Check whether the current working directory is equal to the
 *	path given.  
 *	
 * Results:
 *	1 (equal) or 0 (un-equal) as appropriate.
 *
 * Side effects:
 *	If the paths are equal, but are not the same object, this
 *	method will modify the given pathPtrPtr to refer to the same
 *	object.  In this case the object pointed to by pathPtrPtr will
 *	have its refCount decremented, and it will be adjusted to 
 *	point to the cwd (with a new refCount).
 *
 *----------------------------------------------------------------------
 */

int 
TclFSCwdPointerEquals(pathPtrPtr)
    Tcl_Obj** pathPtrPtr;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    Tcl_MutexLock(&cwdMutex);
    if (tsdPtr->cwdPathPtr == NULL
	    || tsdPtr->cwdPathEpoch != cwdPathEpoch) {
	if (tsdPtr->cwdPathPtr != NULL) {
	    Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
	}
	if (tsdPtr->cwdClientData != NULL) {
	    NativeFreeInternalRep(tsdPtr->cwdClientData);
	}
        if (cwdPathPtr == NULL) {
    	    tsdPtr->cwdPathPtr = NULL;
        } else {
    	    tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr);
    	    Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
        }
	if (cwdClientData == NULL) {
	    tsdPtr->cwdClientData = NULL;
	} else {
	    tsdPtr->cwdClientData = TclNativeDupInternalRep(cwdClientData);
	}
	tsdPtr->cwdPathEpoch = cwdPathEpoch;
    }
    Tcl_MutexUnlock(&cwdMutex);

    if (tsdPtr->initialized == 0) {
	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData)tsdPtr);
	tsdPtr->initialized = 1;
    }

    if (pathPtrPtr == NULL) {
        return (tsdPtr->cwdPathPtr == NULL);
    }
    
    if (tsdPtr->cwdPathPtr == *pathPtrPtr) {
        return 1;
    } else {
	int len1, len2;
	CONST char *str1, *str2;
	str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2);
	if (len1 == len2 && !strcmp(str1,str2)) {
	    /* 
	     * They are equal, but different objects.  Update so they
	     * will be the same object in the future.
	     */
	    Tcl_DecrRefCount(*pathPtrPtr);
	    *pathPtrPtr = tsdPtr->cwdPathPtr;
	    Tcl_IncrRefCount(*pathPtrPtr);
	    return 1;
	} else {
	    return 0;
	}
    }
}

#ifdef TCL_THREADS
static void
FsRecacheFilesystemList(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    }
    Tcl_MutexUnlock(&filesystemMutex);
    fsRecPtr = tsdPtr->filesystemList;
#endif
    return fsRecPtr;
}

/* 
 * If non-NULL, clientData is owned by us and must be freed later.
 */
static void
FsUpdateCwd(cwdObj, clientData)
    Tcl_Obj *cwdObj;
    ClientData clientData;
{
    int len;
    char *str = NULL;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    if (cwdObj != NULL) {
	str = Tcl_GetStringFromObj(cwdObj, &len);
    }

    Tcl_MutexLock(&cwdMutex);
    if (cwdPathPtr != NULL) {
        Tcl_DecrRefCount(cwdPathPtr);
    }
    if (cwdClientData != NULL) {
	NativeFreeInternalRep(cwdClientData);
    }
    if (cwdObj == NULL) {
	cwdPathPtr = NULL;
	cwdClientData = NULL;
    } else {
	/* This must be stored as string obj! */
	cwdPathPtr = Tcl_NewStringObj(str, len); 
    	Tcl_IncrRefCount(cwdPathPtr);
	cwdClientData = TclNativeDupInternalRep(clientData);
    }
    cwdPathEpoch++;
    tsdPtr->cwdPathEpoch = cwdPathEpoch;
    Tcl_MutexUnlock(&cwdMutex);

    if (tsdPtr->cwdPathPtr) {
        Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
    }
    if (tsdPtr->cwdClientData) {
	NativeFreeInternalRep(tsdPtr->cwdClientData);
    }
    if (cwdObj == NULL) {
	tsdPtr->cwdPathPtr = NULL;
	tsdPtr->cwdClientData = NULL;
    } else {
	tsdPtr->cwdPathPtr = Tcl_NewStringObj(str, len); 
	tsdPtr->cwdClientData = clientData;
	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *

     * we would need to put various mutexes around this code.
     */
    
    if (cwdPathPtr != NULL) {
	Tcl_DecrRefCount(cwdPathPtr);
	cwdPathPtr = NULL;
        cwdPathEpoch = 0;
    }
    if (cwdClientData != NULL) {
	NativeFreeInternalRep(cwdClientData);
	cwdClientData = NULL;
    }

    /* 
     * Remove all filesystems, freeing any allocated memory
     * that is no longer needed
     */

    Tcl_Obj *result;		/* List object to receive results. */
    Tcl_Obj *pathPtr;	        /* Contains path to directory to search. */
    CONST char *pattern;	/* Pattern to match against. */
    Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.
				 * May be NULL. In particular the directory
				 * flag is very important. */
{
    Tcl_Filesystem *fsPtr;
    if (pathPtr != NULL) {
        fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    } else {
	fsPtr = NULL;
    }
    
    if (fsPtr != NULL) {
	Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
	if (proc != NULL) {
	    int ret = (*proc)(interp, result, pathPtr, pattern, types);
	    if (ret == TCL_OK && pattern != NULL) {
		result = FsAddMountsToGlobResult(result, pathPtr, 
						 pattern, types);

 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------- 
 */
static Tcl_Obj*
FsAddMountsToGlobResult(result, pathPtr, pattern, types)
    Tcl_Obj *result;            /* The current list of matching paths */
    Tcl_Obj *pathPtr;           /* The directory in question */
    CONST char *pattern;        /* Pattern to match against. */
    Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.
				 * May be NULL. In particular the directory
				 * flag is very important. */
{
    int mLength, gLength, i;
    int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR));
    Tcl_Obj *mounts = FsListMounts(pathPtr, pattern);

    if (mounts == NULL) return result; 

 *      to a directory separator that we know exists and is already
 *      normalized (so it is important not to point to the char just
 *      after the separator).
 *---------------------------------------------------------------------------
 */
int
TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
    Tcl_Interp *interp;         /* Used for error messages. */
    Tcl_Obj *pathPtr;           /* The path to normalize in place */
    int startAt;                /* Start at this char-offset */
    ClientData *clientDataPtr;  /* If we generated a complete
                                 * normalized path for a given
                                 * filesystem, we can optionally return
                                 * an fs-specific clientdata here. */ 
{
    FilesystemRecord *fsRecPtr, *firstFsRecPtr;
    /* Ignore this variable */
    (void)clientDataPtr;
    
    /*
     * Call each of the "normalise path" functions in succession. This is

 */

int
Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
    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. */
    CONST char *encodingName;   /* If non-NULL, then use this encoding 
                                 * for the file. */
{
    int result, length;
    Tcl_StatBuf statBuf;
    Tcl_Obj *oldScriptFile;
    Interp *iPtr;
    char *string;
    Tcl_Channel chan;

     */
    Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");
    /*
     * If the encoding is specified, set it for the channel.
     * Else don't touch it (and use the system encoding)
     * Report error on unknown encoding.
     */
    if (encodingName != NULL) {
	if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
		!= TCL_OK) {
	    Tcl_Close(interp,chan);
	    goto end;
	}
    }
    if (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) {

	 * succeeded.
	 */

	fsRecPtr = FsGetFirstFilesystem();
	while ((retVal == NULL) && (fsRecPtr != NULL)) {
	    Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc;
	    if (proc != NULL) {
		if (fsRecPtr->fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
		    ClientData retCd;
		    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;
		    
		    retCd = (*proc2)(NULL);
		    if (retCd != NULL) {
			Tcl_Obj *norm;
			/* Looks like a new current directory */
			retVal = (*fsRecPtr->fsPtr->internalToNormalizedProc)(retCd);
			Tcl_IncrRefCount(retVal);
			norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
			if (norm != NULL) {
			    /* 
			     * We found a cwd, which is now in our global storage.
			     * We must make a copy. Norm already has a refCount of 1.
			     * 
			     * Threading issue: note that multiple threads at system
			     * startup could in principle call this procedure 
			     * simultaneously.  They will therefore each set the
			     * cwdPathPtr independently.  That behaviour is a bit
			     * peculiar, but should be fine.  Once we have a cwd,
			     * we'll always be in the 'else' branch below which
			     * is simpler.
			     */
			    FsUpdateCwd(norm, retCd);
			    Tcl_DecrRefCount(norm);
			} else {
			    (*fsRecPtr->fsPtr->freeInternalRepProc)(retCd);
			}
			Tcl_DecrRefCount(retVal);
			retVal = NULL;
			goto cdDidNotChange;
		    } else {
			if (interp != NULL) {
			    Tcl_AppendResult(interp,
				    "error getting working directory name: ",
				    Tcl_PosixError(interp), (char *) NULL);
			}
		    }
		} else {
		    retVal = (*proc)(interp);
		}
	    }
	    fsRecPtr = fsRecPtr->nextPtr;
	}
	/* 
	 * Now the 'cwd' may NOT be normalized, at least on some
	 * platforms.  For the sake of efficiency, we want a completely
	 * normalized cwd at all times.

		 * startup could in principle call this procedure 
		 * simultaneously.  They will therefore each set the
		 * cwdPathPtr independently.  That behaviour is a bit
		 * peculiar, but should be fine.  Once we have a cwd,
		 * we'll always be in the 'else' branch below which
		 * is simpler.
		 */
		ClientData cd = (ClientData) Tcl_FSGetNativePath(norm);
		FsUpdateCwd(norm, TclNativeDupInternalRep(cd));
		Tcl_DecrRefCount(norm);
	    }
	    Tcl_DecrRefCount(retVal);
	}
    } else {
	/* 
	 * We already have a cwd cached, but we want to give the

	 * (if the cwd returns NULL).  This ensures that, say, on Unix
	 * if the permissions of the cwd change, 'pwd' does actually
	 * throw the correct error in Tcl.  (This is tested for in the
	 * test suite on unix).
	 */
	if (fsPtr != NULL) {
	    Tcl_FSGetCwdProc *proc = fsPtr->getCwdProc;
	    ClientData retCd = NULL;
	    if (proc != NULL) {
		Tcl_Obj *retVal;
		if (fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
		    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;
		    
		    retCd = (*proc2)(tsdPtr->cwdClientData);
		    if (retCd == NULL && interp != NULL) {
			Tcl_AppendResult(interp,
				"error getting working directory name: ",
				Tcl_PosixError(interp), (char *) NULL);
		    }
		    
		    if (retCd == tsdPtr->cwdClientData) {
			goto cdDidNotChange;
		    }
		    
		    /* Looks like a new current directory */
		    retVal = (*fsPtr->internalToNormalizedProc)(retCd);
		    Tcl_IncrRefCount(retVal);
		} else {
		    retVal = (*proc)(interp);
		}
		if (retVal != NULL) {
		    Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, 
							       NULL);
		    /* 
		     * Check whether cwd has changed from the value
		     * previously stored in cwdPathPtr.  Really 'norm'
		     * shouldn't be null, but we are careful.
		     */
		    if (norm == NULL) {
			/* Do nothing */
			if (retCd != NULL) {
			    (*fsPtr->freeInternalRepProc)(retCd);
			}
		    } else if (Tcl_FSEqualPaths(tsdPtr->cwdPathPtr, norm)) {
			/* 
			 * If the paths were equal, we can be more
			 * efficient and retain the old path object
			 * which will probably already be shared.  In
			 * this case we can simply free the normalized
			 * path we just calculated.
			 */
			Tcl_DecrRefCount(norm);
			if (retCd != NULL) {
			    (*fsPtr->freeInternalRepProc)(retCd);
			}
		    } else {
			FsUpdateCwd(norm, retCd);
			Tcl_DecrRefCount(norm);
		    }
		    Tcl_DecrRefCount(retVal);
		} else {
		    /* The 'cwd' function returned an error; reset the cwd */
		    FsUpdateCwd(NULL, NULL);
		}
	    }
	}
    }
    
  cdDidNotChange:
    if (tsdPtr->cwdPathPtr != NULL) {
	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
    }
    
    return tsdPtr->cwdPathPtr; 
}


	     * we found above (or at least a different object), if the
	     * filesystem epoch changed recently.  This can actually
	     * happen with scripted documents very easily.  Therefore
	     * we ask for the normalized path again (the correct value
	     * will have been cached as a result of the
	     * Tcl_FSGetFileSystemForPath call above anyway).
	     */
	    ClientData cd;
	    Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	    if (normDirName == NULL) {
	        return TCL_ERROR;
	    }
	    cd = (ClientData) Tcl_FSGetNativePath(pathPtr);
	    FsUpdateCwd(normDirName, TclNativeDupInternalRep(cd));
	}
    } else {
	Tcl_SetErrno(ENOENT);
    }
    
    return (retVal);
}

 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
    Tcl_Obj *pathPtr;                   /* Path to determine type for */
    Tcl_Filesystem **filesystemPtrPtr;  /* If absolute path and this is
                                         * non-NULL, then set to the
                                         * filesystem which claims this
                                         * path */  
    int *driveNameLengthPtr;            
    Tcl_Obj **driveNameRef;
{
    FilesystemRecord *fsRecPtr;
    int pathLen;
    char *path;
    Tcl_PathType type = TCL_PATH_RELATIVE;
    
    path = Tcl_GetStringFromObj(pathPtr, &pathLen);

    /*
     * Call each of the "listVolumes" function in succession, checking
     * whether the given path is an absolute path on any of the volumes
     * returned (this is done by checking whether the path's prefix
     * matches).
     */

		}
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    
    if (type != TCL_PATH_ABSOLUTE) {
	type = TclpGetNativePathType(pathPtr, driveNameLengthPtr, 
				     driveNameRef);
	if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) {
	    *filesystemPtrPtr = &tclNativeFilesystem;
	}
    }
    return type;
}

			cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
			if ((cwdLen >= normLen) && (strncmp(normPathStr, 
					cwdStr, (size_t) normLen) == 0)) {
			    /* 
			     * the cwd is inside the directory, so we
			     * perform a 'cd [file dirname $path]'
			     */
			    Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr, 
							     TCL_PATH_DIRNAME);
			    Tcl_FSChdir(dirPtr);
			    Tcl_DecrRefCount(dirPtr);
			}
		    }
		    Tcl_DecrRefCount(cwdPtr);
		}
	    }

 * Side effects:
 *	The object may be converted to a path type.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Filesystem*
Tcl_FSGetFileSystemForPath(pathPtr)
    Tcl_Obj* pathPtr;
{
    FilesystemRecord *fsRecPtr;
    Tcl_Filesystem* retVal = NULL;
    
    if (pathPtr == NULL) {
	Tcl_Panic("Tcl_FSGetFileSystemForPath called with NULL object");
	return NULL;
    }
    
    /* 
     * If the object has a refCount of zero, we reject it.  This
     * is to avoid possible segfaults or nondeterministic memory
     * leaks (i.e. the user doesn't know if they should decrement
     * the ref count on return or not).
     */
    
    if (pathPtr->refCount == 0) {
	Tcl_Panic("Tcl_FSGetFileSystemForPath called with object with refCount == 0");
	return NULL;
    }
    
    /* 
     * Check if the filesystem has changed in some way since
     * this object's internal representation was calculated.
     */
    if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) {
	return NULL;
    }

    /*
     * Call each of the "pathInFilesystem" functions in succession.  A
     * non-return value of -1 indicates the particular function has
     * succeeded.
     */

    fsRecPtr = FsGetFirstFilesystem();
    while ((retVal == NULL) && (fsRecPtr != NULL)) {
	Tcl_FSPathInFilesystemProc *proc = fsRecPtr->fsPtr->pathInFilesystemProc;
	if (proc != NULL) {
	    ClientData clientData = NULL;
	    int ret = (*proc)(pathPtr, &clientData);
	    if (ret != -1) {
		/* 
		 * We assume the type of pathPtr hasn't been changed 
		 * by the above call to the pathInFilesystemProc.
		 */
		TclFSSetPathDetails(pathPtr, fsRecPtr, clientData);
		retVal = fsRecPtr->fsPtr;
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    return retVal;

 * Side effects:
 *	See Tcl_FSGetInternalRep.
 *
 *---------------------------------------------------------------------------
 */

CONST char *
Tcl_FSGetNativePath(pathPtr)
    Tcl_Obj *pathPtr;
{
    return (CONST char *)Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem);
}

/*
 *---------------------------------------------------------------------------
 *
 * NativeCreateNativeRep --
 *
 *      Create a native representation for the given path.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
static ClientData 
NativeCreateNativeRep(pathPtr)
    Tcl_Obj* pathPtr;
{
    char *nativePathPtr;
    Tcl_DString ds;
    Tcl_Obj* validPathPtr;
    int len;
    char *str;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    if (tsdPtr->cwdClientData != NULL) {
        /* The cwd is native */
	validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
    } else {
	/* Make sure the normalized path is set */
	validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	Tcl_IncrRefCount(validPathPtr);
    }

    str = Tcl_GetStringFromObj(validPathPtr, &len);
#ifdef __WIN32__
    Tcl_WinUtfToTChar(str, len, &ds);
    if (tclWinProcs->useWide) {
	len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
    } else {
	len = Tcl_DStringLength(&ds) + sizeof(char);
    }
#else
    Tcl_UtfToExternalDString(NULL, str, len, &ds);
    len = Tcl_DStringLength(&ds) + sizeof(char);
#endif
    Tcl_DecrRefCount(validPathPtr);
    nativePathPtr = ckalloc((unsigned) len);
    memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), (size_t) len);
	  
    Tcl_DStringFree(&ds);
    return (ClientData)nativePathPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpNativeToNormalized --
 *
 *      Convert native format to a normalized path object, with refCount
 *      of zero.
 *      
 *      Currently assumes all native paths are actually normalized
 *      already, so if the path given is not normalized this will
 *      actually just convert to a valid string path, but not
 *      necessarily a normalized one.
 *
 * Results:
 *      A valid normalized path.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj* 
TclpNativeToNormalized(clientData)
    ClientData clientData;
{
    Tcl_DString ds;
    Tcl_Obj *objPtr;

    int len;
    
#ifdef __WIN32__
    char *copy;
    char *p;
    Tcl_WinTCharToUtf((CONST char*)clientData, -1, &ds);
#else
    CONST char *copy;
    Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds);
#endif
    
    copy = Tcl_DStringValue(&ds);
    len = Tcl_DStringLength(&ds);

#ifdef __WIN32__
    /* 
     * Certain native path representations on Windows have this special
     * prefix to indicate that they are to be treated specially.  For
     * example extremely long paths, or symlinks 
     */
    if (*copy == '\\') {
        if (0 == strncmp(copy,"\\??\\",4)) {
	    copy += 4;
	    len -= 4;
	} else if (0 == strncmp(copy,"\\\\?\\",4)) {
	    copy += 4;
	    len -= 4;
	}
    }
    /* 
     * Ensure we are using forward slashes only.
     */
    for (p = copy; *p != '\0'; p++) {
	if (*p == '\\') {
	    *p = '/';
	}
    }
#endif

    objPtr = Tcl_NewStringObj(copy,len);
    Tcl_DStringFree(&ds);
    
    return objPtr;

 *
 * Side effects:
 *	The object may be converted to a path type.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj*
Tcl_FSFileSystemInfo(pathPtr)
    Tcl_Obj* pathPtr;
{
    Tcl_Obj *resPtr;
    Tcl_FSFilesystemPathTypeProc *proc;
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    
    if (fsPtr == NULL) {
	return NULL;
    }
    
    resPtr = Tcl_NewListObj(0,NULL);
    
    Tcl_ListObjAppendElement(NULL, resPtr, 
			     Tcl_NewStringObj(fsPtr->typeName,-1));

    proc = fsPtr->filesystemPathTypeProc;
    if (proc != NULL) {
	Tcl_Obj *typePtr = (*proc)(pathPtr);
	if (typePtr != NULL) {
	    Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
	}
    }
    
    return resPtr;
}

 *
 * Side effects:
 *	The path object may be converted to a path type.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj*
Tcl_FSPathSeparator(pathPtr)
    Tcl_Obj* pathPtr;
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    
    if (fsPtr == NULL) {
	return NULL;
    }
    if (fsPtr->filesystemSeparatorProc != NULL) {
	return (*fsPtr->filesystemSeparatorProc)(pathPtr);
    }
    
    return NULL;
}

/*
 *---------------------------------------------------------------------------

 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
static Tcl_Obj*
NativeFilesystemSeparator(pathPtr)
    Tcl_Obj* pathPtr;
{
    char *separator = NULL; /* lint */
    switch (tclPlatform) {
	case TCL_PLATFORM_UNIX:
	    separator = "/";
	    break;
	case TCL_PLATFORM_WINDOWS:

#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: tclInt.decls,v 1.68 2004/01/21 19:59:33 vincentdarley Exp $

library tcl

# Define the unsupported generic interfaces.

interface tclInt

}
declare 11 generic {
    void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr)
}
declare 12 generic {
    void TclDeleteVars(Interp *iPtr, Tcl_HashTable *tablePtr)
}
# Removed in 8.5
#declare 13 generic {
#    int TclDoGlob(Tcl_Interp *interp, char *separators,
#	    Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)

#}
declare 14 generic {
    void TclDumpMemoryInfo(FILE *outFile)
}
# Removed in 8.1:
#  declare 15 generic {
#      void TclExpandParseValue(ParseValue *pvPtr, int needed)
#  }

#	    int localIndex, Tcl_Obj *elemPtr, int flags)
#}
# Replaced by char *TclGetEnv(CONST char *name, Tcl_DString *valuePtr) in 8.1:
#  declare 30 generic {
#      char *TclGetEnv(CONST char *name)
#  }
declare 31 generic {
    CONST char *TclGetExtension(CONST char *name)
}
declare 32 generic {
    int TclGetFrame(Tcl_Interp *interp, CONST char *str,
	    CallFrame **framePtrPtr)
}
declare 33 generic {
    TclCmdProcType TclGetInterpProc(void)

 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclInt.h,v 1.143 2004/01/21 19:59:33 vincentdarley Exp $
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Common include files needed by most of the Tcl source files are

typedef struct List {
    int maxElemCount;		/* Total number of element array slots. */
    int elemCount;		/* Current number of list elements. */
    Tcl_Obj **elements;		/* Array of pointers to element objects. */
} List;

/*
 *----------------------------------------------------------------
 * Data structures related to the filesystem internals
 *----------------------------------------------------------------
 */


/* 
 * The version_2 filesystem is private to Tcl.  As and when these
 * changes have been thoroughly tested and investigated a new public
 * filesystem interface will be released.  The aim is more versatile
 * virtual filesystem interfaces, more efficiency in 'path' manipulation
 * and usage, and cleaner filesystem code internally.
 */
#define TCL_FILESYSTEM_VERSION_2	((Tcl_FSVersion) 0x2)
typedef ClientData (TclFSGetCwdProc2) _ANSI_ARGS_((ClientData clientData));

/*
 * The following types are used for getting and storing platform-specific
 * file attributes in tclFCmd.c and the various platform-versions of
 * that file. This is done to have as much common code as possible
 * in the file attributes code. For more information about the callbacks,
 * see TclFileAttrsCmd in tclFCmd.c.

 * or'ed combination of the following values:
 */

#define TCL_GLOBMODE_NO_COMPLAIN      1
#define TCL_GLOBMODE_JOIN             2
#define TCL_GLOBMODE_DIR              4
#define TCL_GLOBMODE_TAILS            8

typedef enum Tcl_PathPart {
    TCL_PATH_DIRNAME,
    TCL_PATH_TAIL,	
    TCL_PATH_EXTENSION,
    TCL_PATH_ROOT
} Tcl_PathPart;

/*
 *----------------------------------------------------------------
 * Data structures related to obsolete filesystem hooks
 *----------------------------------------------------------------
 */

EXTERN int              TclpObjNormalizePath _ANSI_ARGS_((Tcl_Interp *interp, 
			    Tcl_Obj *pathPtr, int nextCheckpoint));
EXTERN int		TclpObjCreateDirectory _ANSI_ARGS_((Tcl_Obj *pathPtr));
EXTERN void             TclpNativeJoinPath _ANSI_ARGS_((Tcl_Obj *prefix, 
							char *joining));
EXTERN Tcl_Obj*         TclpNativeSplitPath _ANSI_ARGS_((Tcl_Obj *pathPtr, 
							 int *lenPtr));
EXTERN Tcl_PathType     TclpGetNativePathType _ANSI_ARGS_((Tcl_Obj *pathPtr,
			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
EXTERN int 		TclCrossFilesystemCopy _ANSI_ARGS_((Tcl_Interp *interp, 
			    Tcl_Obj *source, Tcl_Obj *target));
EXTERN int		TclpObjDeleteFile _ANSI_ARGS_((Tcl_Obj *pathPtr));
EXTERN int		TclpObjCopyDirectory _ANSI_ARGS_((Tcl_Obj *srcPathPtr, 
				Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr));
EXTERN int		TclpObjCopyFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr, 
				Tcl_Obj *destPathPtr));
EXTERN int		TclpObjRemoveDirectory _ANSI_ARGS_((Tcl_Obj *pathPtr, 
				int recursive, Tcl_Obj **errorPtr));
EXTERN int		TclpObjRenameFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr, 
				Tcl_Obj *destPathPtr));
EXTERN int		TclpMatchInDirectory _ANSI_ARGS_((Tcl_Interp *interp, 
			        Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, 
				CONST char *pattern, Tcl_GlobTypeData *types));
EXTERN ClientData	TclpGetNativeCwd _ANSI_ARGS_((ClientData clientData));
EXTERN Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
EXTERN Tcl_Obj*		TclpObjLink _ANSI_ARGS_((Tcl_Obj *pathPtr, 
				Tcl_Obj *toPtr, int linkType));
EXTERN int		TclpObjChdir _ANSI_ARGS_((Tcl_Obj *pathPtr));
EXTERN Tcl_Obj*         TclPathPart _ANSI_ARGS_((Tcl_Interp *interp, 
				Tcl_Obj *pathPtr, Tcl_PathPart portion));
EXTERN int		TclpObjStat _ANSI_ARGS_((Tcl_Obj *pathPtr, 
						 Tcl_StatBuf *buf));
EXTERN Tcl_Channel	TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int mode,
			    int permissions));
EXTERN void		TclpCutFileChannel _ANSI_ARGS_((Tcl_Channel chan));
EXTERN void		TclpCutSockChannel _ANSI_ARGS_((Tcl_Channel chan));
EXTERN void		TclpSpliceFileChannel _ANSI_ARGS_((Tcl_Channel chan));
EXTERN void		TclpSpliceSockChannel _ANSI_ARGS_((Tcl_Channel chan));

			    Tcl_Token *tokenPtr, int count,
			    int *tokensLeftPtr));
EXTERN void		TclTransferResult _ANSI_ARGS_((Tcl_Interp *sourceInterp,
			    int result, Tcl_Interp *targetInterp));
EXTERN Tcl_Obj*         TclpNativeToNormalized 
                            _ANSI_ARGS_((ClientData clientData));
EXTERN Tcl_Obj*	        TclpFilesystemPathType
					_ANSI_ARGS_((Tcl_Obj* pathPtr));
EXTERN Tcl_PackageInitProc* TclpFindSymbol _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_LoadHandle loadHandle, CONST char *symbol));
EXTERN int              TclpDlopen _ANSI_ARGS_((Tcl_Interp *interp, 
			    Tcl_Obj *pathPtr, 
	                    Tcl_LoadHandle *loadHandle, 
		            Tcl_FSUnloadFileProc **unloadProcPtr));
EXTERN int              TclpUtime _ANSI_ARGS_((Tcl_Obj *pathPtr,

/*
 * tclIntDecls.h --
 *
 *	This file contains the declarations for all unsupported
 *	functions that are exported by the Tcl library.  These
 *	interfaces are not guaranteed to remain the same between
 *	versions.  Use at your own risk.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIntDecls.h,v 1.56 2004/01/21 19:59:33 vincentdarley Exp $
 */

#ifndef _TCLINTDECLS
#define _TCLINTDECLS

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl

#endif
#ifndef TclDeleteVars_TCL_DECLARED
#define TclDeleteVars_TCL_DECLARED
/* 12 */
EXTERN void		TclDeleteVars _ANSI_ARGS_((Interp * iPtr, 
				Tcl_HashTable * tablePtr));
#endif


/* Slot 13 is reserved */




#ifndef TclDumpMemoryInfo_TCL_DECLARED
#define TclDumpMemoryInfo_TCL_DECLARED
/* 14 */
EXTERN void		TclDumpMemoryInfo _ANSI_ARGS_((FILE * outFile));
#endif
/* Slot 15 is reserved */
#ifndef TclExprFloatError_TCL_DECLARED

EXTERN Tcl_Channel	TclpGetDefaultStdChannel _ANSI_ARGS_((int type));
#endif
/* Slot 29 is reserved */
/* Slot 30 is reserved */
#ifndef TclGetExtension_TCL_DECLARED
#define TclGetExtension_TCL_DECLARED
/* 31 */
EXTERN CONST char *	TclGetExtension _ANSI_ARGS_((CONST char * name));
#endif
#ifndef TclGetFrame_TCL_DECLARED
#define TclGetFrame_TCL_DECLARED
/* 32 */
EXTERN int		TclGetFrame _ANSI_ARGS_((Tcl_Interp * interp, 
				CONST char * str, CallFrame ** framePtrPtr));
#endif

#endif /* __WIN32__ */
#ifdef MAC_TCL
    void *reserved9;
#endif /* MAC_TCL */
    int (*tclCreateProc) _ANSI_ARGS_((Tcl_Interp * interp, Namespace * nsPtr, CONST char * procName, Tcl_Obj * argsPtr, Tcl_Obj * bodyPtr, Proc ** procPtrPtr)); /* 10 */
    void (*tclDeleteCompiledLocalVars) _ANSI_ARGS_((Interp * iPtr, CallFrame * framePtr)); /* 11 */
    void (*tclDeleteVars) _ANSI_ARGS_((Interp * iPtr, Tcl_HashTable * tablePtr)); /* 12 */
    void *reserved13;
    void (*tclDumpMemoryInfo) _ANSI_ARGS_((FILE * outFile)); /* 14 */
    void *reserved15;
    void (*tclExprFloatError) _ANSI_ARGS_((Tcl_Interp * interp, double value)); /* 16 */
    void *reserved17;
    void *reserved18;
    void *reserved19;
    void *reserved20;
    void *reserved21;
    int (*tclFindElement) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * listStr, int listLength, CONST char ** elementPtr, CONST char ** nextPtr, int * sizePtr, int * bracePtr)); /* 22 */
    Proc * (*tclFindProc) _ANSI_ARGS_((Interp * iPtr, CONST char * procName)); /* 23 */
    int (*tclFormatInt) _ANSI_ARGS_((char * buffer, long n)); /* 24 */
    void (*tclFreePackageInfo) _ANSI_ARGS_((Interp * iPtr)); /* 25 */
    void *reserved26;
    int (*tclGetDate) _ANSI_ARGS_((char * p, unsigned long now, long zone, unsigned long * timePtr)); /* 27 */
    Tcl_Channel (*tclpGetDefaultStdChannel) _ANSI_ARGS_((int type)); /* 28 */
    void *reserved29;
    void *reserved30;
    CONST char * (*tclGetExtension) _ANSI_ARGS_((CONST char * name)); /* 31 */
    int (*tclGetFrame) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, CallFrame ** framePtrPtr)); /* 32 */
    TclCmdProcType (*tclGetInterpProc) _ANSI_ARGS_((void)); /* 33 */
    int (*tclGetIntForIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int endValue, int * indexPtr)); /* 34 */
    void *reserved35;
    int (*tclGetLong) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, long * longPtr)); /* 36 */
    int (*tclGetLoadedPackages) _ANSI_ARGS_((Tcl_Interp * interp, char * targetName)); /* 37 */
    int (*tclGetNamespaceForQualName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * qualName, Namespace * cxtNsPtr, int flags, Namespace ** nsPtrPtr, Namespace ** altNsPtrPtr, Namespace ** actualCxtPtrPtr, CONST char ** simpleNamePtr)); /* 38 */

#define TclDeleteCompiledLocalVars \
	(tclIntStubsPtr->tclDeleteCompiledLocalVars) /* 11 */
#endif
#ifndef TclDeleteVars
#define TclDeleteVars \
	(tclIntStubsPtr->tclDeleteVars) /* 12 */
#endif
/* Slot 13 is reserved */



#ifndef TclDumpMemoryInfo
#define TclDumpMemoryInfo \
	(tclIntStubsPtr->tclDumpMemoryInfo) /* 14 */
#endif
/* Slot 15 is reserved */
#ifndef TclExprFloatError
#define TclExprFloatError \

/* 
 * tclPathObj.c --
 *
 *	This file contains the implementation of Tcl's "path" object
 *	type used to represent and manipulate a general (virtual)
 *	filesystem entity in an efficient manner.
 *
 * Copyright (c) 2003 Vince Darley.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclPathObj.c,v 1.20 2004/01/21 19:59:33 vincentdarley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#ifdef MAC_TCL
#include "tclMacInt.h"
#endif
#include "tclFileSystem.h"

/*
 * Prototypes for procedures defined later in this file.
 */

static void	DupFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
						  Tcl_Obj *copyPtr));
static void	FreeFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *pathPtr));
static void	UpdateStringOfFsPath  _ANSI_ARGS_((Tcl_Obj *pathPtr));
static int	SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp,
					      Tcl_Obj *pathPtr));
static int	FindSplitPos _ANSI_ARGS_((CONST char *path, int separator));
static int      IsSeparatorOrNull _ANSI_ARGS_((int ch));
static Tcl_Obj* GetExtension _ANSI_ARGS_((Tcl_Obj *pathPtr));


/*
 * Define the 'path' object type, which Tcl uses to represent
 * file paths internally.
 */
Tcl_ObjType tclFsPathType = {

 * struct FsPath --
 * 
 * Internal representation of a Tcl_Obj of "path" type.  This
 * can be used to represent relative or absolute paths, and has
 * certain optimisations when used to represent paths which are
 * already normalized and absolute.
 * 
 * Note that both 'translatedPathPtr' and 'normPathPtr' can be a
 * circular reference to the container Tcl_Obj of this FsPath.
 * 
 * There are two cases, with the first being the most common:
 * 
 * (i) flags == 0, => Ordinary path.  
 * 
 * translatedPathPtr contains the translated path (which may be
 * a circular reference to the object itself).  If it is NULL
 * then the path is pure normalized (and the normPathPtr will be
 * a circular reference).  cwdPtr is null for an absolute path,
 * and non-null for a relative path (unless the cwd has never been
 * set, in which case the cwdPtr may also be null for a relative path).
 * 
 * (ii) flags != 0, => Special path, see TclNewFSPathObj
 * 
 * Now, this is a path like 'file join $dir $tail' where, cwdPtr is
 * the $dir and normPathPtr is the $tail.
 * 
 */
typedef struct FsPath {
    Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences.
				 * If this is NULL, then this is a 
				 * pure normalized, absolute path
				 * object, in which the parent Tcl_Obj's
				 * string rep is already both translated
				 * and normalized. */
    Tcl_Obj *normPathPtr;       /* Normalized absolute path, without 
				 * ., .. or ~user sequences. If the 
				 * Tcl_Obj containing 
				 * this FsPath is already normalized, 
				 * this may be a circular reference back
				 * to the container.  If that is NOT the
				 * case, we have a refCount on the object. */
    Tcl_Obj *cwdPtr;            /* If null, path is absolute, else
				 * this points to the cwd object used
				 * for this path.  We have a refCount
				 * on the object. */
    int flags;                  /* Flags to describe interpretation -
                                 * see below. */
    ClientData nativePathPtr;   /* Native representation of this path,
				 * which is filesystem dependent. */
    int filesystemEpoch;        /* Used to ensure the path representation
				 * was generated during the correct
				 * filesystem epoch.  The epoch changes
				 * when filesystem-mounts are changed. */ 
    struct FilesystemRecord *fsRecPtr;
				/* Pointer to the filesystem record 
				 * entry to use for this path. */
} FsPath;

/*
 * Flag values for FsPath->flags.
 */
#define TCLPATH_APPENDED 1

/* 
 * Define some macros to give us convenient access to path-object
 * specific fields.
 */
#define PATHOBJ(pathPtr) (pathPtr->internalRep.otherValuePtr)
#define PATHFLAGS(pathPtr) \
 (((FsPath*)(pathPtr->internalRep.otherValuePtr))->flags)




/*
 *---------------------------------------------------------------------------
 *
 * TclFSNormalizeAbsolutePath --
 *
 * Description:

 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
Tcl_FSGetPathType(pathPtr)
    Tcl_Obj *pathPtr;
{
    return TclFSGetPathType(pathPtr, NULL, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFSGetPathType --
 *

 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclFSGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr)
    Tcl_Obj *pathPtr;
    Tcl_Filesystem **filesystemPtrPtr;
    int *driveNameLengthPtr;
{
    if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {
	return TclGetPathType(pathPtr, filesystemPtrPtr, 
		driveNameLengthPtr, NULL);
    } else {
	FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
	if (fsPathPtr->cwdPtr != NULL) {
	    if (PATHFLAGS(pathPtr) == 0) {
		return TCL_PATH_RELATIVE;
	    }
	    return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, 
		    driveNameLengthPtr);
	} else {
	    return TclGetPathType(pathPtr, filesystemPtrPtr, 
		    driveNameLengthPtr, NULL);
	}
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclPathPart
 *
 *	This procedure calculates the requested part of the the given
 *	path, which can be:
 *	
 *	- the directory above ('file dirname')
 *	- the tail            ('file tail')
 *	- the extension       ('file extension')
 *	- the root            ('file root')
 *	
 *	The 'portion' parameter dictates which of these to calculate.
 *	There are a number of special cases both to be more efficient,
 *	and because the behaviour when given a path with only a single
 *	element is defined to require the expansion of that single
 *	element, where possible.
 *
 *      Should look into integrating 'FileBasename' in tclFCmd.c into
 *      this function.
 *      
 * Results:
 *	NULL if an error occurred, otherwise a Tcl_Obj owned by
 *	the caller (i.e. most likely with refCount 1).
 *
 * Side effects:
 *      None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj*
TclPathPart(interp, pathPtr, portion)
    Tcl_Interp *interp;		/* Used for error reporting */
    Tcl_Obj *pathPtr;           /* Path to take dirname of */
    Tcl_PathPart portion;       /* Requested portion of name */
{
    if (pathPtr->typePtr == &tclFsPathType) {
	FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
	if (PATHFLAGS(pathPtr) != 0) {
	    switch (portion) {
		case TCL_PATH_DIRNAME: {
		    Tcl_IncrRefCount(fsPathPtr->cwdPtr);
		    return fsPathPtr->cwdPtr;
		}
		case TCL_PATH_TAIL: {
		    Tcl_IncrRefCount(fsPathPtr->normPathPtr);
		    return fsPathPtr->normPathPtr;
		}
		case TCL_PATH_EXTENSION: {
		    return GetExtension(fsPathPtr->normPathPtr);
		}
		case TCL_PATH_ROOT: {
		    /* Unimplemented */
		    CONST char *fileName, *extension;
		    int length;
		    fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, 
						    &length);
		    extension = TclGetExtension(fileName);
		    if (extension == NULL) {
			/* 
			 * There is no extension so the root is the
			 * same as the path we were given.
			 */
			Tcl_IncrRefCount(pathPtr);
			return pathPtr;
		    } else {
			/*
			 * Duplicate the object we were given and
			 * then trim off the extension of the
			 * tail component of the path.
			 */
			Tcl_Obj *root;
			FsPath *fsDupPtr;
			root = Tcl_DuplicateObj(pathPtr);
			Tcl_IncrRefCount(root);
			fsDupPtr = (FsPath*) PATHOBJ(root);
			if (Tcl_IsShared(fsDupPtr->normPathPtr)) {
			    Tcl_DecrRefCount(fsDupPtr->normPathPtr);
			    fsDupPtr->normPathPtr = Tcl_NewStringObj(fileName,
					     (int)(length - strlen(extension)));
			    Tcl_IncrRefCount(fsDupPtr->normPathPtr);
			} else {
			    Tcl_SetObjLength(fsDupPtr->normPathPtr, 
					     (int)(length - strlen(extension)));
			}
			return root;
		    }
		}
	    }
	} else if (fsPathPtr->cwdPtr != NULL) {
	    /* Relative path */
	    goto standardPath;
	} else {
	    /* Absolute path */
	    goto standardPath;
	}
    } else {
	int splitElements;
	Tcl_Obj *splitPtr;
	Tcl_Obj *resultPtr = NULL;
      standardPath:

        if (portion == TCL_PATH_EXTENSION) {
	    return GetExtension(pathPtr);
        } else if (portion == TCL_PATH_ROOT) {
	    int length;
	    CONST char *fileName, *extension;
	    
	    fileName = Tcl_GetStringFromObj(pathPtr, &length);
	    extension = TclGetExtension(fileName);
	    if (extension == NULL) {
		Tcl_IncrRefCount(pathPtr);
		return pathPtr;
	    } else {
		Tcl_Obj *root = Tcl_NewStringObj(fileName, 
			(int) (length - strlen(extension)));
		Tcl_IncrRefCount(root);
		return root;
	    }
        }
        
	/* 
	 * The behaviour we want here is slightly different to
	 * the standard Tcl_FSSplitPath in the handling of home
	 * directories; Tcl_FSSplitPath preserves the "~" while 
	 * this code computes the actual full path name, if we
	 * had just a single component.
	 */    
	splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements);
	Tcl_IncrRefCount(splitPtr);
	if ((splitElements == 1) && (Tcl_GetString(pathPtr)[0] == '~')) {
	    Tcl_Obj *norm;
	    
	    Tcl_DecrRefCount(splitPtr);
	    norm = Tcl_FSGetNormalizedPath(interp, pathPtr);
	    if (norm == NULL) {
		return NULL;
	    }
	    splitPtr = Tcl_FSSplitPath(norm, &splitElements);
	    Tcl_IncrRefCount(splitPtr);
	}
	if (portion == TCL_PATH_TAIL) {
	    /*
	     * Return the last component, unless it is the only component,
	     * and it is the root of an absolute path.
	     */

	    if ((splitElements > 0) && ((splitElements > 1)
	      || (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE))) {
		Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &resultPtr);
	    } else {
		resultPtr = Tcl_NewObj();
	    }
	} else {
	    /*
	     * Return all but the last component.  If there is only one
	     * component, return it if the path was non-relative, otherwise
	     * return the current directory.
	     */

	    if (splitElements > 1) {
		resultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1);
	    } else if (splitElements == 0 || 
	      (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) {
		resultPtr = Tcl_NewStringObj(
			((tclPlatform == TCL_PLATFORM_MAC) ? ":" : "."), 1);
	    } else {
		Tcl_ListObjIndex(NULL, splitPtr, 0, &resultPtr);
	    }
	}
	Tcl_IncrRefCount(resultPtr);
	Tcl_DecrRefCount(splitPtr);
	return resultPtr;
    }
}

/*
 * Simple helper function 
 */
static Tcl_Obj*
GetExtension(pathPtr) 
    Tcl_Obj *pathPtr;
{
    CONST char *tail, *extension;
    Tcl_Obj *ret;
    
    tail = Tcl_GetString(pathPtr);
    extension = TclGetExtension(tail);
    if (extension == NULL) {
	ret = Tcl_NewObj();
    } else {
	ret = Tcl_NewStringObj(extension, -1);
    }
    Tcl_IncrRefCount(ret);
    return ret;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSJoinPath --
 *
 *      This function takes the given Tcl_Obj, which should be a valid
 *      list, and returns the path object given by considering the
 *      first 'elements' elements as valid path segments.  If elements < 0,
 *      we use the entire list.
 *      
 *      It is possible that the returned object is actually an element
 *      of the given list, so the caller should be careful to store a
 *      refCount to it before freeing the list.
 *      
 * Results:
 *      Returns object with refCount of zero, (or if non-zero, it has
 *      references elsewhere in Tcl).  Either way, the caller must
 *      increment its refCount before use.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj* 
Tcl_FSJoinPath(listObj, elements)
    Tcl_Obj *listObj;  /* Path elements to join, may have refCount 0 */
    int elements;      /* Number of elements to use (-1 = all) */
{
    Tcl_Obj *res;
    int i;
    Tcl_Filesystem *fsPtr = NULL;
    
    if (elements < 0) {
	if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) {

	 * waste our time joining null elements to the path 
	 */
	if (elements > listTest) {
	    elements = listTest;
	}
    }
    
    res = NULL;
    
    for (i = 0; i < elements; i++) {
	Tcl_Obj *elt;
	int driveNameLength;
	Tcl_PathType type;
	char *strElt;
	int strEltLen;

		str = Tcl_GetStringFromObj(tail,&len);
		if (len == 0) {
		    /* 
		     * This happens if we try to handle the root volume
		     * '/'.  There's no need to return a special path
		     * object, when the base itself is just fine!
		     */
		    if (res != NULL) Tcl_DecrRefCount(res);
		    return elt;
		}
		/* 
		 * If it doesn't begin with '.'  and is a mac or unix
		 * path or it a windows path without backslashes, then we
		 * can be very efficient here.  (In fact even a windows
		 * path with backslashes can be joined efficiently, but
		 * the path object would not have forward slashes only,
		 * and this would therefore contradict our 'file join'
		 * documentation).
		 */
		if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS) 
				      || (strchr(str, '\\') == NULL))) {
		    if (res != NULL) Tcl_DecrRefCount(res);
		    return TclNewFSPathObj(elt, str, len);
		}
		/* 
		 * Otherwise we don't have an easy join, and
		 * we must let the more general code below handle
		 * things
		 */
	    } else {
		if (tclPlatform == TCL_PLATFORM_UNIX) {
		    if (res != NULL) Tcl_DecrRefCount(res);
		    return tail;
		} else {
		    CONST char *str;
		    int len;
		    str = Tcl_GetStringFromObj(tail,&len);
		    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
			if (strchr(str, '\\') == NULL) {
			    if (res != NULL) Tcl_DecrRefCount(res);
			    return tail;
			}
		    } else if (tclPlatform == TCL_PLATFORM_MAC) {
			if (strchr(str, '/') == NULL) {
			    if (res != NULL) Tcl_DecrRefCount(res);
			    return tail;
			}
		    }
		}
	    }
	}
	strElt = Tcl_GetStringFromObj(elt, &strEltLen);
	type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
	if (type != TCL_PATH_RELATIVE) {
	    /* Zero out the current result */
	    if (res != NULL) Tcl_DecrRefCount(res);

	    if (driveName != NULL) {
		/*
		 * We've been given a separate drive-name object,
		 * because the prefix in 'elt' is not in a suitable
		 * format for us (e.g. it may contain irrelevant
		 * multiple separators, like C://///foo).
		 */
		res = Tcl_DuplicateObj(driveName);
		Tcl_DecrRefCount(driveName);
		/* 
		 * Do not set driveName to NULL, because we will check
		 * its value below (but we won't access the contents,
		 * since those have been cleaned-up).
		 */
	    } else {
		res = Tcl_NewStringObj(strElt, driveNameLength);
	    }
	    strElt += driveNameLength;
	}
	
	/* 
	 * Optimisation block: if this is the last element to be
	 * examined, and it is absolute or the only element, and the
	 * drive-prefix was ok (if there is one), it might be that the
	 * path is already in a suitable form to be returned.  Then we
	 * can short-cut the rest of this procedure.
	 */
	if ((driveName == NULL) && (i == (elements - 1)) 
	  && (type != TCL_PATH_RELATIVE || res == NULL)) {
	    /* 
	     * It's the last path segment.  Perform a quick check if
	     * the path is already in a suitable form.
	     */
	    int equal = 1;
	    
	    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
		if (strchr(strElt, '\\') != NULL) {
		    equal = 0;
		}
	    }
	    if (equal && (tclPlatform != TCL_PLATFORM_MAC)) {
		ptr = strElt;
		while (*ptr != '\0') {
		    if (*ptr == '/' && (ptr[1] == '/' || ptr[1] == '\0')) {
			equal = 0;
			break;
		    }
		    ptr++;
		}
	    }
	    if (equal && (tclPlatform == TCL_PLATFORM_MAC)) {
		/*
		 * If it contains any colons, then it mustn't contain
		 * any duplicates.  Otherwise, the path is in unix-form
		 * and is no good.
		 */
		if (strchr(strElt, ':') != NULL) {
		    ptr = strElt;
		    while (*ptr != '\0') {
			if (*ptr == ':' && (ptr[1] == ':' || ptr[1] == '\0')) {
			    equal = 0;
			    break;
			}
			ptr++;
		    }
		} else {
		    equal = 0;
		}
	    }
	    if (equal) {
		if (res != NULL) Tcl_DecrRefCount(res);
		/* 
		 * This element is just what we want to return already -
		 * no further manipulation is requred.
		 */
		return elt;
	    }
	}
	
	if (res == NULL) {
	    res = Tcl_NewObj();
	    ptr = Tcl_GetStringFromObj(res, &length);
	} else {
	    ptr = Tcl_GetStringFromObj(res, &length);
	}
	
	/* 
	 * Strip off any './' before a tilde, unless this is the
	 * beginning of the path.
	 */
	if (length > 0 && strEltLen > 0 
	  && (strElt[0] == '.') && (strElt[1] == '/') && (strElt[2] == '~')) {

	    strElt += 2;

	}

	/* 
	 * A NULL value for fsPtr at this stage basically means
	 * we're trying to join a relative path onto something
	 * which is also relative (or empty).  There's nothing
	 * particularly wrong with that.

 *
 * Side effects:
 *	The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */
int 
Tcl_FSConvertToPathType(interp, pathPtr)
    Tcl_Interp *interp;		/* Interpreter in which to store error
				 * message (if necessary). */
    Tcl_Obj *pathPtr;		/* Object to convert to a valid, current
				 * path type. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    /* 
     * While it is bad practice to examine an object's type directly,
     * this is actually the best thing to do here.  The reason is that
     * if we are converting this object to FsPath type for the first
     * time, we don't need to worry whether the 'cwd' has changed.
     * On the other hand, if this object is already of FsPath type,
     * and is a relative path, we do have to worry about the cwd.
     * If the cwd has changed, we must recompute the path.
     */
    if (pathPtr->typePtr == &tclFsPathType) {
	FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
	if (fsPathPtr->filesystemEpoch != tsdPtr->filesystemEpoch) {
	    if (pathPtr->bytes == NULL) {
		UpdateStringOfFsPath(pathPtr);
	    }
	    FreeFsPathInternalRep(pathPtr);
	    pathPtr->typePtr = NULL;
	    return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
	}
	return TCL_OK;
	/* 

	 * We used to have more complex code here:


	 * 
	 * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) {
	 *     return TCL_OK;
	 * } else {
	 *     if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
	 *         return TCL_OK;
	 *     } else {
	 *         if (pathPtr->bytes == NULL) {
	 *             UpdateStringOfFsPath(pathPtr);

	 *         }
	 *         FreeFsPathInternalRep(pathPtr);
	 *         pathPtr->typePtr = NULL;
	 *         return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);



	 *     }
	 * }
	 * 
	 * But we no longer believe this is necessary.
	 */
    } else {
	return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
    }
}

/* 
 * Helper function for normalization.
 */
static int

}

/*
 *---------------------------------------------------------------------------
 *
 * TclNewFSPathObj --
 *
 *      Creates a path object whose string representation is '[file join
 *      dirPtr addStrRep]', but does so in a way that allows for more
 *      efficient creation and caching of normalized paths, and more
 *      efficient 'file dirname', 'file tail', etc.
 *      
 * Assumptions:
 *      'dirPtr' must be an absolute path.  
 *      'len' may not be zero.
 *      
 * Results:
 *      The new Tcl object, with refCount zero.
 *
 * Side effects:
 *	Memory is allocated.  'dirPtr' gets an additional refCount.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj*
TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len)
{
    FsPath *fsPathPtr;
    Tcl_Obj *pathPtr;
    ThreadSpecificData *tsdPtr;
    
    tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    
    pathPtr = Tcl_NewObj();
    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
    
    if (tclPlatform == TCL_PLATFORM_MAC) { 
	/* 
	 * Mac relative paths may begin with a directory separator ':'. 
	 * If present, we need to skip this ':' because we assume that 
	 * we can join dirPtr and addStrRep by concatenating them as 
	 * strings (and we ensure that dirPtr is terminated by a ':'). 
	 */ 
	if (addStrRep[0] == ':') { 
	    addStrRep++; 
	    len--; 
	} 
    }
    /* Setup the path */
    fsPathPtr->translatedPathPtr = NULL;
    fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);
    Tcl_IncrRefCount(fsPathPtr->normPathPtr);
    fsPathPtr->cwdPtr = dirPtr;
    Tcl_IncrRefCount(dirPtr);
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsRecPtr = NULL;
    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

    PATHOBJ(pathPtr) = (VOID *) fsPathPtr;
    PATHFLAGS(pathPtr) = TCLPATH_APPENDED;
    pathPtr->typePtr = &tclFsPathType;
    pathPtr->bytes = NULL;
    pathPtr->length = 0;

    return pathPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFSMakePathRelative --
 *

 *      Only for internal use.
 *      
 *      Takes a path and a directory, where we _assume_ both path and
 *      directory are absolute, normalized and that the path lies
 *      inside the directory.  Returns a Tcl_Obj representing filename 
 *      of the path relative to the directory.
 *      
 * Results:
 *      NULL on error, otherwise a valid object, typically with
 *      refCount of zero, which it is assumed the caller will
 *      increment.
 *
 * Side effects:
 *	The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj*
TclFSMakePathRelative(interp, pathPtr, cwdPtr)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr;		/* The object we have. */
    Tcl_Obj *cwdPtr;		/* Make it relative to this. */
{
    int cwdLen, len;
    CONST char *tempStr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    
    if (pathPtr->typePtr == &tclFsPathType) {
	FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
	if (PATHFLAGS(pathPtr) != 0 
		&& fsPathPtr->cwdPtr == cwdPtr) {
	    pathPtr = fsPathPtr->normPathPtr;
	    /* Free old representation */
	    if (pathPtr->typePtr != NULL) {
		if (pathPtr->bytes == NULL) {
		    if (pathPtr->typePtr->updateStringProc == NULL) {
			if (interp != NULL) {
			    Tcl_ResetResult(interp);
			    Tcl_AppendResult(interp, "can't find object",
				   "string representation", (char *) NULL);
			}
			return NULL;
		    }
		    pathPtr->typePtr->updateStringProc(pathPtr);
		}
		if ((pathPtr->typePtr->freeIntRepProc) != NULL) {
		    (*pathPtr->typePtr->freeIntRepProc)(pathPtr);
		}
	    }

	    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));

	    /* Circular reference, by design */
	    fsPathPtr->translatedPathPtr = pathPtr;
	    fsPathPtr->normPathPtr = NULL;
	    fsPathPtr->cwdPtr = cwdPtr;
	    Tcl_IncrRefCount(cwdPtr);
	    fsPathPtr->nativePathPtr = NULL;
	    fsPathPtr->fsRecPtr = NULL;
	    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

	    PATHOBJ(pathPtr) = (VOID *) fsPathPtr;
	    PATHFLAGS(pathPtr) = 0;
	    pathPtr->typePtr = &tclFsPathType;

	    return pathPtr;
	}
    }
    /* 
     * We know the cwd is a normalised object which does
     * not end in a directory delimiter, unless the cwd
     * is the name of a volume, in which case it will
     * end in a delimiter!  We handle this situation here.

	    break;
	case TCL_PLATFORM_MAC:
	    if (tempStr[cwdLen-1] != ':') {
		cwdLen++;
	    }
	    break;
    }
    tempStr = Tcl_GetStringFromObj(pathPtr, &len);

    return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
}

/*
 *---------------------------------------------------------------------------
 *

 * Side effects:
 *	The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

int
TclFSMakePathFromNormalized(interp, pathPtr, nativeRep)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr;		/* The object to convert. */
    ClientData nativeRep;	/* The native rep for the object, if known
				 * else NULL. */
{
    FsPath *fsPathPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    if (pathPtr->typePtr == &tclFsPathType) {
	return TCL_OK;
    }
    
    /* Free old representation */
    if (pathPtr->typePtr != NULL) {
	if (pathPtr->bytes == NULL) {
	    if (pathPtr->typePtr->updateStringProc == NULL) {
		if (interp != NULL) {
		    Tcl_ResetResult(interp);
		    Tcl_AppendResult(interp, "can't find object",
				     "string representation", (char *) NULL);
		}
		return TCL_ERROR;
	    }
	    pathPtr->typePtr->updateStringProc(pathPtr);
	}
	if ((pathPtr->typePtr->freeIntRepProc) != NULL) {
	    (*pathPtr->typePtr->freeIntRepProc)(pathPtr);
	}
    }

    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
    /* It's a pure normalized absolute path */
    fsPathPtr->translatedPathPtr = NULL;
    /* Circular reference by design */
    fsPathPtr->normPathPtr = pathPtr;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = nativeRep;
    fsPathPtr->fsRecPtr = NULL;
    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

    PATHOBJ(pathPtr) = (VOID *) fsPathPtr;
    PATHFLAGS(pathPtr) = 0;
    pathPtr->typePtr = &tclFsPathType;

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *

 */

Tcl_Obj *
Tcl_FSNewNativePath(fromFilesystem, clientData)
    Tcl_Filesystem* fromFilesystem;
    ClientData clientData;
{
    Tcl_Obj *pathPtr;
    FsPath *fsPathPtr;

    FilesystemRecord *fsFromPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    
    pathPtr = TclFSInternalToNormalized(fromFilesystem, clientData,
                                       &fsFromPtr);
    if (pathPtr == NULL) {
	return NULL;
    }
    
    /* 
     * Free old representation; shouldn't normally be any,
     * but best to be safe. 
     */
    if (pathPtr->typePtr != NULL) {
	if (pathPtr->bytes == NULL) {
	    if (pathPtr->typePtr->updateStringProc == NULL) {
		return NULL;
	    }
	    pathPtr->typePtr->updateStringProc(pathPtr);
	}
	if ((pathPtr->typePtr->freeIntRepProc) != NULL) {
	    (*pathPtr->typePtr->freeIntRepProc)(pathPtr);
	}
    }
    
    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));

    fsPathPtr->translatedPathPtr = NULL;
    /* Circular reference, by design */
    fsPathPtr->normPathPtr = pathPtr;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = clientData;
    fsPathPtr->fsRecPtr = fsFromPtr;
    fsPathPtr->fsRecPtr->fileRefCount++;
    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;  

    PATHOBJ(pathPtr) = (VOID *) fsPathPtr;
    PATHFLAGS(pathPtr) = 0;
    pathPtr->typePtr = &tclFsPathType;

    return pathPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetTranslatedPath --
 *

 *	New memory may be allocated.  The Tcl 'errno' may be modified
 *      in the process of trying to examine various path possibilities.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj* 
Tcl_FSGetNormalizedPath(interp, pathPtr)
    Tcl_Interp *interp;
    Tcl_Obj* pathPtr;
{

    FsPath *fsPathPtr;

    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
	return NULL;
    }
    fsPathPtr = (FsPath*) PATHOBJ(pathPtr);

    if (PATHFLAGS(pathPtr) != 0) {
	/* 
	 * This is a special path object which is the result of
	 * something like 'file join' 
	 */
	Tcl_Obj *dir, *copy;
	int cwdLen;
	int pathType;
	CONST char *cwdStr;
	ClientData clientData = NULL;
	
	pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
	dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
	if (dir == NULL) {
	    return NULL;
	}
	if (pathPtr->bytes == NULL) {
	    UpdateStringOfFsPath(pathPtr);
	}
	copy = Tcl_DuplicateObj(dir);
	Tcl_IncrRefCount(copy);
	Tcl_IncrRefCount(dir);
	/* We now own a reference on both 'dir' and 'copy' */
	
	cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);

	    fsPathPtr->normPathPtr = copy;
	    /* That's our reference to copy used */
	    Tcl_DecrRefCount(dir);
	}
	if (clientData != NULL) {
	    fsPathPtr->nativePathPtr = clientData;
	}
	PATHFLAGS(pathPtr) = 0;
    }
    /* Ensure cwd hasn't changed */
    if (fsPathPtr->cwdPtr != NULL) {
	if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
	    if (pathPtr->bytes == NULL) {
		UpdateStringOfFsPath(pathPtr);
	    }
	    FreeFsPathInternalRep(pathPtr);
	    pathPtr->typePtr = NULL;
	    if (Tcl_ConvertToType(interp, pathPtr, 
				  &tclFsPathType) != TCL_OK) {
		return NULL;
	    }
	    fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
	} else if (fsPathPtr->normPathPtr == NULL) {
	    int cwdLen;
	    Tcl_Obj *copy;
	    CONST char *cwdStr;
	    ClientData clientData = NULL;
	    
	    copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr);

		case TCL_PLATFORM_MAC:
		    if (cwdStr[cwdLen-1] != ':') {
			Tcl_AppendToObj(copy, ":", 1);
			cwdLen++;
		    }
		    break;
	    }
	    Tcl_AppendObjToObj(copy, pathPtr);
	    /* 
	     * Normalize the combined string, but only starting after
	     * the end of the previously normalized 'dir'.  This should
	     * be much faster!
	     */
	    TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, 
	      (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));

	/* 
	 * We have to be a little bit careful here to avoid infinite loops
	 * we're asking Tcl_FSGetPathType to return the path's type, but
	 * that call can actually result in a lot of other filesystem
	 * action, which might loop back through here.
	 */
	if (path[0] != '\0') {
	    Tcl_PathType type = Tcl_FSGetPathType(pathPtr);
	    if (type == TCL_PATH_RELATIVE) {
		useThisCwd = Tcl_FSGetCwd(interp);

		if (useThisCwd == NULL) return NULL;

		absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
		Tcl_IncrRefCount(absolutePath);

	/* Already has refCount incremented */
	fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, absolutePath, 
		       (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
	if (0 && (clientData != NULL)) {
	    fsPathPtr->nativePathPtr = 
	      (*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData);
	}
	/* 
	 * Check if path is pure normalized (this can only be the case
	 * if it is an absolute path).
	 */
	if (useThisCwd == NULL) {
	    if (!strcmp(Tcl_GetString(fsPathPtr->normPathPtr),
			Tcl_GetString(pathPtr))) {
		/* 
		 * The path was already normalized.  
		 * Get rid of the duplicate.
		 */
		Tcl_DecrRefCount(fsPathPtr->normPathPtr);
		/* 
		 * We do *not* increment the refCount for 
		 * this circular reference 
		 */
		fsPathPtr->normPathPtr = pathPtr;
	    }
	} else {
	    /* 
	     * We just need to free an object we allocated above for
	     * relative paths (this was returned by Tcl_FSJoinToPath
	     * above), and then of course store the cwd.
	     */
	    Tcl_DecrRefCount(absolutePath);
	    fsPathPtr->cwdPtr = useThisCwd;
	}
    }

    return fsPathPtr->normPathPtr;
}

 * Side effects:
 *	An attempt may be made to convert the object.
 *
 *---------------------------------------------------------------------------
 */

ClientData 
Tcl_FSGetInternalRep(pathPtr, fsPtr)
    Tcl_Obj* pathPtr;
    Tcl_Filesystem *fsPtr;
{
    FsPath* srcFsPathPtr;
    
    if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {
	return NULL;
    }
    srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr);
    
    /* 
     * We will only return the native representation for the caller's
     * filesystem.  Otherwise we will simply return NULL. This means
     * that there must be a unique bi-directional mapping between paths
     * and filesystems, and that this mapping will not allow 'remapped'
     * files -- files which are in one filesystem but mapped into

	 * create a string object and pass it to TclpObjStat.  Code
	 * which calls the Tcl_FS..  functions should always have a
	 * filesystem already set.  Whether this code path is legal or
	 * not depends on whether we decide to allow external code to
	 * call the native filesystem directly.  It is at least safer
	 * to allow this sub-optimal routing.
	 */
	Tcl_FSGetFileSystemForPath(pathPtr);
	
	/* 
	 * If we fail through here, then the path is probably not a
	 * valid path in the filesystsem, and is most likely to be a
	 * use of the empty path "" via a direct call to one of the
	 * objectified interfaces (e.g. from the Tcl testsuite).
	 */
	srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr);
	if (srcFsPathPtr->fsRecPtr == NULL) {
	    return NULL;
	}
    }

    if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) {
	/* 
	 * There is still one possibility we should consider; if the
	 * file belongs to a different filesystem, perhaps it is
	 * actually linked through to a file in our own filesystem
	 * which we do care about.  The way we can check for this
	 * is we ask what filesystem this path belongs to.
	 */
	Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr);
	if (actualFs == fsPtr) {
	    return Tcl_FSGetInternalRep(pathPtr, fsPtr);
	}
	return NULL;
    }

    if (srcFsPathPtr->nativePathPtr == NULL) {
	Tcl_FSCreateInternalRepProc *proc;
	proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc;

	if (proc == NULL) {
	    return NULL;
	}
	srcFsPathPtr->nativePathPtr = (*proc)(pathPtr);
    }

    return srcFsPathPtr->nativePathPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFSEnsureEpochOk --
 *
 *      This will ensure the pathPtr is up to date and can be
 *      converted into a "path" type, and that we are able to generate a
 *      complete normalized path which is used to determine the
 *      filesystem match.
 *
 * Results:
 *      Standard Tcl return code.
 *
 * Side effects:
 *	An attempt may be made to convert the object.
 *
 *---------------------------------------------------------------------------
 */

int 
TclFSEnsureEpochOk(pathPtr, fsPtrPtr)
    Tcl_Obj* pathPtr;
    Tcl_Filesystem **fsPtrPtr;
{
    FsPath* srcFsPathPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);




    if (pathPtr->typePtr != &tclFsPathType) {

	return TCL_OK;
    }

    srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr);

    /* 
     * Check if the filesystem has changed in some way since
     * this object's internal representation was calculated.
     */
    if (srcFsPathPtr->filesystemEpoch != tsdPtr->filesystemEpoch) {
	/* 
	 * We have to discard the stale representation and 
	 * recalculate it 
	 */
	if (pathPtr->bytes == NULL) {
	    UpdateStringOfFsPath(pathPtr);
	}
	FreeFsPathInternalRep(pathPtr);
	pathPtr->typePtr = NULL;
	if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
	    return TCL_ERROR;
	}
	srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr);
    }
    /* Check whether the object is already assigned to a fs */
    if (srcFsPathPtr->fsRecPtr != NULL) {
	*fsPtrPtr = srcFsPathPtr->fsRecPtr->fsPtr;
    }

    return TCL_OK;
}

void 
TclFSSetPathDetails(pathPtr, fsRecPtr, clientData) 
    Tcl_Obj *pathPtr;
    FilesystemRecord *fsRecPtr;
    ClientData clientData;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    FsPath* srcFsPathPtr;
    
    /* Make sure pathPtr is of the correct type */
    if (pathPtr->typePtr != &tclFsPathType) {
	if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
	    return;
	}
    }
    
    srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr);
    srcFsPathPtr->fsRecPtr = fsRecPtr;
    srcFsPathPtr->nativePathPtr = clientData;
    srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; 
    fsRecPtr->fileRefCount++;
}

/*

 * Side effects:
 *	The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

static int
SetFsPathFromAny(interp, pathPtr)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr;		/* The object to convert. */
{
    int len;
    FsPath *fsPathPtr;
    Tcl_Obj *transPtr;
    char *name;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    
    if (pathPtr->typePtr == &tclFsPathType) {
	return TCL_OK;
    }
    
    /* 
     * First step is to translate the filename.  This is similar to
     * Tcl_TranslateFilename, but shouldn't convert everything to
     * windows backslashes on that platform.  The current
     * implementation of this piece is a slightly optimised version
     * of the various Tilde/Split/Join stuff to avoid multiple
     * split/join operations.
     * 
     * We remove any trailing directory separator.
     * 
     * However, the split/join routines are quite complex, and
     * one has to make sure not to break anything on Unix, Win
     * or MacOS (fCmd.test, fileName.test and cmdAH.test exercise
     * most of the code).
     */
    name = Tcl_GetStringFromObj(pathPtr,&len);

    /*
     * Handle tilde substitutions, if needed.
     */
    if (name[0] == '~') {
	char *expandedUser;
	Tcl_DString temp;

		 * Make use of Split/Join machinery to get it right.
		 * Assumes all paths beginning with ~ are part of the
		 * native filesystem.
		 */

		int objc;
		Tcl_Obj **objv;
		Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL);
		Tcl_ListObjGetElements(NULL, parts, &objc, &objv);
		/* Skip '~'.  It's replaced by its expansion */
		objc--; objv++;
		while (objc--) {
		    TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++));
		}
		Tcl_DecrRefCount(parts);
	    } else {
		/* 
		 * Simple case. "rest" is relative path.  Just join it. 
		 * The "rest" object will be freed when
		 * Tcl_FSJoinToPath returns (unless something else
		 * claims a refCount on it).
		 */
		Tcl_Obj *joined;
		Tcl_Obj *rest = Tcl_NewStringObj(name+split+1,-1);
		Tcl_IncrRefCount(transPtr);
		joined = Tcl_FSJoinToPath(transPtr, 1, &rest);
		Tcl_DecrRefCount(transPtr);
		transPtr = joined;
	    }
	}
	Tcl_DStringFree(&temp);
    } else {
	transPtr = Tcl_FSJoinToPath(pathPtr,0,NULL);
    }

#if defined(__CYGWIN__) && defined(__WIN32__)
    {
    extern int cygwin_conv_to_win32_path 
	_ANSI_ARGS_((CONST char *, char *));
    char winbuf[MAX_PATH+1];

     * forward slashes on Windows, and will not contain any ~user
     * sequences.
     */
    
    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));

    fsPathPtr->translatedPathPtr = transPtr;
    if (transPtr != pathPtr) {
        Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
    }
    fsPathPtr->normPathPtr = NULL;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsRecPtr = NULL;
    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

    /*
     * Free old representation before installing our new one.
     */
    if (pathPtr->typePtr != NULL && pathPtr->typePtr->freeIntRepProc != NULL) {
	(pathPtr->typePtr->freeIntRepProc)(pathPtr);
    }
    PATHOBJ(pathPtr) = (VOID *) fsPathPtr;
    PATHFLAGS(pathPtr) = 0;
    pathPtr->typePtr = &tclFsPathType;

    return TCL_OK;
}

static void
FreeFsPathInternalRep(pathPtr)
    Tcl_Obj *pathPtr;	/* Path object with internal rep to free. */
{
    FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr);

    if (fsPathPtr->translatedPathPtr != NULL) {
	if (fsPathPtr->translatedPathPtr != pathPtr) {
	    Tcl_DecrRefCount(fsPathPtr->translatedPathPtr);
	}
    }
    if (fsPathPtr->normPathPtr != NULL) {
	if (fsPathPtr->normPathPtr != pathPtr) {
	    Tcl_DecrRefCount(fsPathPtr->normPathPtr);
	}
	fsPathPtr->normPathPtr = NULL;
    }
    if (fsPathPtr->cwdPtr != NULL) {
	Tcl_DecrRefCount(fsPathPtr->cwdPtr);
    }

	    ckfree((char *)fsPathPtr->fsRecPtr);
	}
    }

    ckfree((char*) fsPathPtr);
}


static void
DupFsPathInternalRep(srcPtr, copyPtr)
    Tcl_Obj *srcPtr;		/* Path obj with internal rep to copy. */
    Tcl_Obj *copyPtr;		/* Path obj with internal rep to set. */
{
    FsPath* srcFsPathPtr = (FsPath*) PATHOBJ(srcPtr);
    FsPath* copyFsPathPtr = (FsPath*) ckalloc((unsigned)sizeof(FsPath));

 * Side effects:
 *	Memory may be allocated.
 *
 *---------------------------------------------------------------------------
 */

static void
UpdateStringOfFsPath(pathPtr)
    register Tcl_Obj *pathPtr;	/* path obj with string rep to update. */
{
    FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
    CONST char *cwdStr;
    int cwdLen;
    Tcl_Obj *copy;
    
    if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) {
	Tcl_Panic("Called UpdateStringOfFsPath with invalid object");
    }
    
    copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr);
    Tcl_IncrRefCount(copy);
    
    cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);

	    if (cwdStr[cwdLen-1] != ':') {
		Tcl_AppendToObj(copy, ":", 1);
		cwdLen++;
	    }
	    break;
    }
    Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr);
    pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
    pathPtr->length = cwdLen;
    copy->bytes = tclEmptyStringRep;
    copy->length = 0;
    Tcl_DecrRefCount(copy);
}

/*
 *---------------------------------------------------------------------------

/* 
 * tclStubInit.c --
 *
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStubInit.c,v 1.92 2004/01/21 19:59:33 vincentdarley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * Remove macros that will interfere with the definitions below.

#endif /* __WIN32__ */
#ifdef MAC_TCL
    NULL, /* 9 */
#endif /* MAC_TCL */
    TclCreateProc, /* 10 */
    TclDeleteCompiledLocalVars, /* 11 */
    TclDeleteVars, /* 12 */
    NULL, /* 13 */
    TclDumpMemoryInfo, /* 14 */
    NULL, /* 15 */
    TclExprFloatError, /* 16 */
    NULL, /* 17 */
    NULL, /* 18 */
    NULL, /* 19 */
    NULL, /* 20 */

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Ajuba Solutions.
 * Copyright (c) 2003 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTest.c,v 1.75 2004/01/21 19:59:33 vincentdarley Exp $
 */

#define TCL_TEST
#include "tclInt.h"
#include "tclPort.h"

/*

			    ClientData dummy, Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));

static void             TestReport _ANSI_ARGS_ ((CONST char* cmd, Tcl_Obj* arg1, 
			    Tcl_Obj* arg2));

static Tcl_Obj*         TestReportGetNativePath _ANSI_ARGS_ ((
			    Tcl_Obj* pathPtr));

static int		TestReportStat _ANSI_ARGS_ ((Tcl_Obj *path,
			    Tcl_StatBuf *buf));
static int		TestReportAccess _ANSI_ARGS_ ((Tcl_Obj *path,
			    int mode));
static Tcl_Channel	TestReportOpenFileChannel _ANSI_ARGS_ ((
			    Tcl_Interp *interp, Tcl_Obj *fileName,

}

/* 
 * Simple helper function to extract the native vfs representation of a
 * path object, or NULL if no such representation exists.
 */
static Tcl_Obj* 
TestReportGetNativePath(Tcl_Obj* pathPtr) {
    return (Tcl_Obj*) Tcl_FSGetInternalRep(pathPtr, &testReportingFilesystem);
}

static void 
TestReportFreeInternalRep(ClientData clientData) {
    Tcl_Obj *nativeRep = (Tcl_Obj*)clientData;
    if (nativeRep != NULL) {
	/* Free the path */

/* 
 * tclMacFile.c --
 *
 *      This file implements the channel drivers for Macintosh
 *	files.  It also comtains Macintosh version of other Tcl
 *	functions that deal with the file system.
 *
 * Copyright (c) 1995-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: tclMacFile.c,v 1.29 2004/01/21 19:59:33 vincentdarley Exp $
 */

/*
 * Note: This code eventually needs to support async I/O.  In doing this
 * we will need to keep track of all current async I/O.  If exit to shell
 * is called - we shouldn't exit until all asyc I/O completes.
 */

	}
	return -1;
    }

    return 0;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetNativeCwd --
 *
 *	This function replaces the library version of getcwd().
 *
 * Results:
 *	The input and output are filesystem paths in native form.  The
 *	result is either the given clientData, if the working directory
 *	hasn't changed, or a new clientData (owned by our caller),
 *	giving the new native path, or NULL if the current directory
 *	could not be determined.  If NULL is returned, the caller can
 *	examine the standard posix error codes to determine the cause of
 *	the problem.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
TclpGetNativeCwd(clientData)
    ClientData clientData;
{
    FSSpec theSpec;
    int length;
    Handle pathHandle = NULL;
    OSErr err;
    
    err = FSpGetDefaultDir(&theSpec);
    if (err != noErr) {
	errno = TclMacOSErrorToPosixError(err);
	return NULL;
    }
    err = FSpPathFromLocation(&theSpec, &length, &pathHandle);
    if (err != noErr) {
	errno = TclMacOSErrorToPosixError(err);
	return NULL;
    }
    
    if ((clientData != NULL) 
      && strcmp((CONST char*)(*pathHandle), (CONST char*)clientData) == 0) {
	/* No change to pwd */
	DisposeHandle(pathHandle);	
        return clientData;
    } else {
	char *newCd;
	
	HLock(pathHandle);
	newCd = (char *) ckalloc((unsigned) 
		(strlen((CONST char*)(*pathHandle)) + 1));
	strcpy(newCd, (CONST char*)(*pathHandle));
	HUnlock(pathHandle);
	DisposeHandle(pathHandle);
	return (ClientData) newCd;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetCwd --
 *
 *	This function replaces the library version of getcwd().
 *      (Obsolete function, only retained for old extensions which
 *      may call it directly).
 *
 * Results:
 *	The result is a pointer to a string specifying the current
 *	directory, or NULL if the current directory could not be
 *	determined.  If NULL is returned, an error message is left in the
 *	interp's result.  Storage for the result string is allocated in
 *	bufferPtr; the caller must call Tcl_DStringFree() when the result
 *	is no longer needed.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
















CONST char *
TclpGetCwd(
    Tcl_Interp *interp,		/* If non-NULL, used for error reporting. */
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled
				 * with name of current directory. */
{
    FSSpec theSpec;

 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj*
TclpFilesystemPathType(pathPtr)
    Tcl_Obj* pathPtr;
{
    /* All native paths are of the same type */
    return NULL;
}

/*
 *---------------------------------------------------------------------------

# This file tests the tclFCmd.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: fCmd.test,v 1.36 2004/01/21 19:59:33 vincentdarley Exp $
#

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

    file mkdir td2
    list [catch {file rename -force td2 td1} msg] $msg
} [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]
test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unixOnly notRoot} {
    cleanup /tmp
    createfile tf1
    file rename tf1 /tmp
    glob -nocomplain tf* /tmp/tf1
} {/tmp/tf1}
test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {pcOnly} {
    catch {file delete -force c:/tcl8975@ d:/tcl8975@}
    file mkdir c:/tcl8975@
    if [catch {file rename c:/tcl8975@ d:/}] {
	set msg d:/tcl8975@
    } else {
	set msg [glob c:/tcl8975@ d:/tcl8975@]
	file delete -force d:/tcl8975@
    }
    file delete -force c:/tcl8975@
    set msg
} {d:/tcl8975@}
test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \
	{unixOnly notRoot} {
    cleanup /tmp
    file mkdir td1
    file rename td1 /tmp
    glob -nocomplain td* /tmp/td*
} {/tmp/td1}
test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \
	{unixOnly notRoot} {
    cleanup /tmp
    createfile tf1
    file rename tf1 /tmp
    glob -nocomplain tf* /tmp/tf*
} {/tmp/tf1}
test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} \
	{unixOnly notRoot xdev} {
    cleanup /tmp
    file mkdir td1/td2/td3
    file attributes td1 -permissions 0000
    set msg [list [catch {file rename td1 /tmp} msg] $msg]

# This file tests the filename manipulation routines.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: fileName.test,v 1.35 2004/01/21 19:59:33 vincentdarley Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]]

    testsetplatform windows
    list [catch {testtranslatefilename {c:/foo}} msg] $msg
} {0 {c:\foo}}
test filename-10.3 {Tcl_TranslateFileName} {testsetplatform} {
    testsetplatform windows
    list [catch {testtranslatefilename {c:/\\foo/}} msg] $msg
} {0 {c:\foo}}
test filename-10.3.1 {Tcl_TranslateFileName} {testsetplatform} {
    testsetplatform windows
    list [catch {testtranslatefilename {c://///}} msg] $msg
} {0 c:\\}
test filename-10.4 {Tcl_TranslateFileName} {testsetplatform} {
    testsetplatform mac
    list [catch {testtranslatefilename foo} msg] $msg
} {0 :foo}
test filename-10.5 {Tcl_TranslateFileName} {testsetplatform} {
    testsetplatform mac
    list [catch {testtranslatefilename :~foo} msg] $msg

    }
    catch {
	set tmpd [pwd]
	cd [lindex [file volumes] 0]
	set res2 [glob *]
	cd $tmpd
    }
    set res [expr {$res1 == $res2}]
    if {!$res} {
	lappend res $res1 $res2
    }
    set res
} {1}
test filename-11.46 {Tcl_GlobCmd} {
    list [catch {glob -types abcde -dir foo *} msg] $msg
} {1 {bad argument to "-types": abcde}}
test filename-11.47 {Tcl_GlobCmd} {
    list [catch {glob -types abcde -path foo *} msg] $msg
} {1 {bad argument to "-types": abcde}}

    # is reset... 
    string equal [glob -nocomplain ~wontexist ~blah ~] \
      [glob -nocomplain ~ ~blah ~wontexist]
} {1}
test filename-15.5 {unix specific globbing} {unixOnly nonPortable} {
    glob ~ouster/.csh*
} "/home/ouster/.cshrc"
catch {close [open globTest/odd\\\[\]*?\{\}name w]} 
test filename-15.6 {unix specific globbing} {unixOnly} {
    global env
    set temp $env(HOME)
    set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name
    set result [list [catch {glob ~} msg] $msg]
    set env(HOME) $temp
    set result
} [list 0 [list [lindex [glob ~] 0]/globTest/odd\\\[\]*?\{\}name]]
catch {file delete -force globTest/odd\\\[\]*?\{\}name}
test filename-15.7 {win specific globbing} {winOnly} {
    if {[string index [glob ~] end] == "/"} {
	set res "glob ~ is [glob ~] but shouldn't end in a separator"
    } else {
	set res "ok"
    }
} {ok}
test filename-15.8 {win and unix specific globbing} {unixOrWin} {
    global env
    set temp $env(HOME)
    catch {close [open $env(HOME)/globTest/anyname w]} err
    set env(HOME) $env(HOME)/globTest/anyname
    set result [list [catch {glob ~} msg] $msg]
    set env(HOME) $temp
    catch {file delete -force $env(HOME)/globTest/anyname}
    set result
} [list 0 [list [lindex [glob ~] 0]/globTest/anyname]]

# The following tests are only valid for Windows systems.
set oldDir [pwd]
if {$::tcltest::testConstraints(pcOnly)} {
    cd c:/
    file delete -force globTest
    file mkdir globTest

    set dir [pwd]
    cd C:/
    set res [list [catch {glob c:} err] $err]
    cd $dir
    set res
} {0 c:}
test filename-16.3 {windows specific globbing} {pcOnly} {
    glob -nocomplain c:\\\\
} c:/
test filename-16.4 {windows specific globbing} {pcOnly} {
    glob -nocomplain c:/
} c:/
test filename-16.5 {windows specific globbing} {pcOnly} {
    glob -nocomplain c:*bTest
} c:globTest
test filename-16.6 {windows specific globbing} {pcOnly} {
    glob -nocomplain c:\\\\*bTest
} c:/globTest
test filename-16.7 {windows specific globbing} {pcOnly} {
    glob -nocomplain c:/*bTest
} c:/globTest
test filename-16.8 {windows specific globbing} {pcOnly} {
    lsort [glob -nocomplain c:globTest/*.bat]
} {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
test filename-16.9 {windows specific globbing} {pcOnly} {
    lsort [glob -nocomplain c:/globTest/*.bat]
} {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
test filename-16.10 {windows specific globbing} {pcOnly} {
    lsort [glob -nocomplain c:globTest\\\\*.bat]
} {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
test filename-16.11 {windows specific globbing} {pcOnly} {
    lsort [glob -nocomplain c:\\\\globTest\\\\*.bat]
} {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}

# some tests require a shared C drive

if {[catch {cd //[info hostname]/c}]} {
    set ::tcltest::testConstraints(sharedCdrive) 0
} else {

    expr {[lsearch -exact [glob {{.,*}*}] ".."] != -1}
} {1}
test filename-16.15 {windows specific globbing} {pcOnly} {
    cd [lindex [glob -types d -dir C:/ *] 0]
    glob ..
} {..}
test filename-16.16 {windows specific globbing} {pcOnly} {
    file tail [lindex [glob -nocomplain "[lindex [glob -types d -dir C:/ *] 0]/.."] 0]
} {..}

test filename-17.1 {windows specific special files} {testsetplatform} {
    testsetplatform win
    list [file pathtype com1] [file pathtype con] [file pathtype lpt3] \
      [file pathtype prn] [file pathtype nul] [file pathtype aux] \
      [file pathtype foo]

    -body {
	testfilesystem 1
	set filesystemReport {}
	file exists foo
	testfilesystem 0
	set filesystemReport
    }
    -result {*{access foo}}
}

test filesystem-4.1 {testfilesystem} {
    -constraints Tcltest
    -match glob
    -body {
	testfilesystem 1
	set filesystemReport {}
	catch {file stat foo bar}
	testfilesystem 0
	set filesystemReport
    }
    -result {*{stat foo}}
}

test filesystem-4.2 {testfilesystem} {
    -constraints Tcltest
    -match glob
    -body {
	testfilesystem 1
	set filesystemReport {}
	catch {file lstat foo bar}
	testfilesystem 0
	set filesystemReport
    }
    -result {*{lstat foo}}
}

test filesystem-4.3 {testfilesystem} {
    -constraints Tcltest
    -match glob
    -body {
	testfilesystem 1
	set filesystemReport {}
	catch {glob *}
	testfilesystem 0
	set filesystemReport
    }
    -result {*{matchindirectory *}*}
}

test filesystem-5.1 {cache and ~} {
    -constraints Tcltest
    -match regexp
    -body {
	set orig $env(HOME)

# This file tests the tclWinFCmd.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: winFCmd.test,v 1.26 2004/01/21 19:59:34 vincentdarley Exp $
#

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

} {1 {nul EACCES}}
test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} {pcOnly nt} {
    cleanup
    set res [list [catch {testfile rmdir /} msg] $msg]
    # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
    # decision has been made as to which is correct.
    regsub {E(ACCES|EXIST)} $res "EACCES or EEXIST"
} [list 1 [list / EACCES or EEXIST]]
test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {pcOnly 95} {
    cleanup
    createfile tf1
    set res [catch {testfile rmdir tf1} msg]
    # get rid of path
    set msg [list [file tail [lindex $msg 0]] [lindex $msg 1]]
    list $res $msg

/* 
 * tclUnixFile.c --
 *
 *      This file contains wrappers around UNIX file handling functions.
 *      These wrappers mask differences between Windows and UNIX.
 *
 * Copyright (c) 1995-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: tclUnixFile.c,v 1.37 2004/01/21 19:59:34 vincentdarley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types);

{
    return TclOSlstat(Tcl_FSGetNativePath(pathPtr), bufPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetNativeCwd --
 *
 *	This function replaces the library version of getcwd().
 *
 * Results:
 *	The input and output are filesystem paths in native form.  The
 *	result is either the given clientData, if the working directory
 *	hasn't changed, or a new clientData (owned by our caller),
 *	giving the new native path, or NULL if the current directory
 *	could not be determined.  If NULL is returned, the caller can
 *	examine the standard posix error codes to determine the cause of
 *	the problem.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
TclpGetNativeCwd(clientData)
    ClientData clientData;
{
    char buffer[MAXPATHLEN+1];

#ifdef USEGETWD
    if (getwd(buffer) == NULL) {			/* INTL: Native. */
#else
    if (getcwd(buffer, MAXPATHLEN + 1) == NULL) {	/* INTL: Native. */
#endif
	return NULL;
    }
    if ((clientData != NULL) && strcmp(buffer, (CONST char*)clientData) == 0) {
	/* No change to pwd */
	return clientData;
    } else {
	char *newCd = (char *) ckalloc((unsigned) 
				       (strlen(buffer) + 1));
	strcpy(newCd, buffer);
	return (ClientData) newCd;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetCwd --
 *
 *	This function replaces the library version of getcwd().
 *      (Obsolete function, only retained for old extensions which
 *      may call it directly).
 *      
 * Results:
 *	The result is a pointer to a string specifying the current
 *	directory, or NULL if the current directory could not be
 *	determined.  If NULL is returned, an error message is left in the
 *	interp's result.  Storage for the result string is allocated in
 *	bufferPtr; the caller must call Tcl_DStringFree() when the result
 *	is no longer needed.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

















CONST char *
TclpGetCwd(interp, bufferPtr)
    Tcl_Interp *interp;		/* If non-NULL, used for error reporting. */
    Tcl_DString *bufferPtr;	/* Uninitialized or free DString filled
				 * with name of current directory. */
{
    char buffer[MAXPATHLEN+1];

	 * 
	 * If we're making a hard link, then a relative path is
	 * just converted to absolute relative to the cwd.
	 */
	if ((linkAction & TCL_CREATE_SYMBOLIC_LINK)
	  && (Tcl_FSGetPathType(toPtr) == TCL_PATH_RELATIVE)) {
	    Tcl_Obj *dirPtr, *absPtr;
	    dirPtr = TclPathPart(NULL, pathPtr, TCL_PATH_DIRNAME);
	    if (dirPtr == NULL) {
	        return NULL;
	    }
	    absPtr = Tcl_FSJoinToPath(dirPtr, 1, &toPtr);
	    Tcl_IncrRefCount(absPtr);
	    if (Tcl_FSAccess(absPtr, F_OK) == -1) {
		Tcl_DecrRefCount(absPtr);

 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj*
TclpFilesystemPathType(pathPtr)
    Tcl_Obj* pathPtr;
{
    /* All native paths are of the same type */
    return NULL;
}

/*
 *---------------------------------------------------------------------------

/* 
 * tclWin32Dll.c --
 *
 *	This file contains the DLL entry point.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWin32Dll.c,v 1.32 2004/01/21 19:59:34 vincentdarley Exp $
 */

#include "tclWinInt.h"

/*
 * The following data structures are used when loading the thunking 
 * library for execing child processes under Win32s.

		  (HANDLE (WINAPI *)(CONST TCHAR*, UINT,
		  LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance, 
		  "FindFirstFileExW");
	        tclWinProcs->getVolumeNameForVMPProc = 
		  (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, 
		  DWORD)) GetProcAddress(hInstance, 
		  "GetVolumeNameForVolumeMountPointW");
		tclWinProcs->getLongPathNameProc = 
		  (DWORD (WINAPI *)(CONST TCHAR*, TCHAR*, 
		  DWORD)) GetProcAddress(hInstance, 
		  "GetLongPathNameW");
		FreeLibrary(hInstance);
	    }
	    hInstance = LoadLibraryA("advapi32");
	    if (hInstance != NULL) {
		tclWinProcs->getFileSecurityProc = (BOOL (WINAPI *)(
		  LPCTSTR lpFileName, 
		  SECURITY_INFORMATION RequestedInformation,

		  (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, 
		  LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExA");
		tclWinProcs->createHardLinkProc = 
		  (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, 
		  LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, 
		  "CreateHardLinkA");
		tclWinProcs->findFirstFileExProc = NULL;
		tclWinProcs->getLongPathNameProc = NULL;
		/*
		 * The 'findFirstFileExProc' function exists on some
		 * of 95/98/ME, but it seems not to work as anticipated.
		 * Therefore we don't set this function pointer.  The
		 * relevant code will fall back on a slower approach
		 * using the normal findFirstFileProc.
		 * 

/*
 * tclWinFCmd.c
 *
 *      This file implements the Windows specific 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: tclWinFCmd.c,v 1.40 2004/01/21 19:59:34 vincentdarley Exp $
 */

#include "tclWinInt.h"

/*
 * The following constants specify the type of callback when
 * TraverseWinTree() calls the traverseProc()

    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,   	/* The name of the file. */
    int longShort,		/* 0 to short name, 1 to long name. */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    int pathc, i;
    Tcl_Obj *splitPath;


    splitPath = Tcl_FSSplitPath(fileName, &pathc);
    
    if (splitPath == NULL || pathc == 0) {
	if (interp != NULL) {
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
		"could not read \"", Tcl_GetString(fileName),
		"\": no such file or directory", 
		(char *) NULL);
	}

	goto cleanup;
    }
    
    /*
     * We will decrement this again at the end.  It is safer to
     * do this in case any of the calls below retain a reference
     * to splitPath.
     */
    Tcl_IncrRefCount(splitPath);

    for (i = 0; i < pathc; i++) {
	Tcl_Obj *elt;
	char *pathv;
	int pathLen;
	Tcl_ListObjIndex(NULL, splitPath, i, &elt);
	
	pathv = Tcl_GetStringFromObj(elt, &pathLen);

	    }

	    if (handle == INVALID_HANDLE_VALUE) {
		Tcl_DStringFree(&ds);
		if (interp != NULL) {
		    StatError(interp, fileName);
		}

		goto cleanup;
	    }
	    if (tclWinProcs->useWide) {
		nativeName = (TCHAR *) data.w.cAlternateFileName;
		if (longShort) {
		    if (data.w.cFileName[0] != '\0') {
			nativeName = (TCHAR *) data.w.cFileName;

	    Tcl_DStringFree(&ds);
	    Tcl_DStringFree(&dsTemp);
	    FindClose(handle);
	}
    }

    *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);
    
    if (splitPath != NULL) {
	/* 
	 * Unfortunately, the object we will return may have its only
	 * refCount as part of the list splitPath.  This means if
	 * we free splitPath, the object will disappear.  So, we
	 * have to be very careful here.  Unfortunately this means
	 * we must manipulate the object's refCount directly.
	 */
	Tcl_IncrRefCount(*attributePtrPtr);
	Tcl_DecrRefCount(splitPath);
	--(*attributePtrPtr)->refCount;
    }
    return TCL_OK;

  cleanup:
    if (splitPath != NULL) {
	Tcl_DecrRefCount(splitPath);
    }
  
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * GetWinFileLongName --
 *

/* 
 * tclWinFile.c --
 *
 *      This file contains temporary wrappers around UNIX file handling
 *      functions. These wrappers map the UNIX functions to Win32 HANDLE-style
 *      files, which can be manipulated through the Win32 console redirection
 *      interfaces.
 *
 * Copyright (c) 1995-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: tclWinFile.c,v 1.59 2004/01/21 19:59:34 vincentdarley Exp $
 */

//#define _WIN32_WINNT  0x0500

#include "tclWinInt.h"
#include <winioctl.h>
#include <sys/stat.h>


/*
 *----------------------------------------------------------------------
 *
 * TclpGetCwd --
 *
 *	This function replaces the library version of getcwd().
 *      (Obsolete function, only retained for old extensions which
 *      may call it directly).
 *
 * Results:
 *	The result is a pointer to a string specifying the current
 *	directory, or NULL if the current directory could not be
 *	determined.  If NULL is returned, an error message is left in the
 *	interp's result.  Storage for the result string is allocated in
 *	bufferPtr; the caller must call Tcl_DStringFree() when the result

	Tcl_DStringAppend(bufferPtr, realFileName, -1);
	return 1;
    }
    return 0;
}
#endif

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetNativeCwd --
 *
 *	This function replaces the library version of getcwd().
 *
 * Results:
 *	The input and output are filesystem paths in native form.  The
 *	result is either the given clientData, if the working directory
 *	hasn't changed, or a new clientData (owned by our caller),
 *	giving the new native path, or NULL if the current directory
 *	could not be determined.  If NULL is returned, the caller can
 *	examine the standard posix error codes to determine the cause of
 *	the problem.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
TclpGetNativeCwd(clientData)
    ClientData clientData;
{
    WCHAR buffer[MAX_PATH];
    
    if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
	TclWinConvertError(GetLastError());
	return NULL;
    }



    if (clientData != NULL) {
        if (tclWinProcs->useWide) {
	    /* unicode representation when running on NT/2K/XP */
	    if (wcscmp((CONST WCHAR*)clientData, 
		       (CONST WCHAR*)buffer) == 0) {
		return clientData;
	    }
	} else {
	    /* ansi representation when running on 95/98/ME */
	    if (strcmp((CONST char*)clientData, 
		       (CONST char*)buffer) == 0) {
		return clientData;
	    }
	}
    }
    
    return TclNativeDupInternalRep((ClientData)buffer);
}

int 
TclpObjAccess(pathPtr, mode)
    Tcl_Obj *pathPtr;
    int mode;
{

TclpObjLink(pathPtr, toPtr, linkAction)
    Tcl_Obj *pathPtr;
    Tcl_Obj *toPtr;
    int linkAction;
{
    if (toPtr != NULL) {
	int res;
#if 0
	TCHAR* LinkTarget = (TCHAR*)Tcl_FSGetNativePath(toPtr);
#else
	TCHAR* LinkTarget = (TCHAR*)Tcl_FSGetNativePath(Tcl_FSGetNormalizedPath(NULL,toPtr));
#endif
	TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);
	if (LinkSource == NULL || LinkTarget == NULL) {
	    return NULL;
	}
	res = WinLink(LinkSource, LinkTarget, linkAction);
	if (res == 0) {
	    return toPtr;

 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj*
TclpFilesystemPathType(pathPtr)
    Tcl_Obj* pathPtr;
{
#define VOL_BUF_SIZE 32
    int found;
    char volType[VOL_BUF_SIZE];
    char* firstSeparator;
    CONST char *path;
    
    Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (normPath == NULL) return NULL;
    path = Tcl_GetString(normPath);
    if (path == NULL) return NULL;
    
    firstSeparator = strchr(path, '/');
    if (firstSeparator == NULL) {
	found = tclWinProcs->getVolumeInformationProc(
		Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL, 
		NULL, (WCHAR *)volType, VOL_BUF_SIZE);
    } else {
	Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);
	Tcl_IncrRefCount(driveName);
	found = tclWinProcs->getVolumeInformationProc(
		Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, 
		NULL, (WCHAR *)volType, VOL_BUF_SIZE);

	Tcl_WinTCharToUtf(volType, -1, &ds);
	objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
	Tcl_DStringFree(&ds);
	return objPtr;
    }
#undef VOL_BUF_SIZE
}
/* 
 * This define can be turned on to experiment with a different way of
 * normalizing paths (using a different Windows API).  Unfortunately the
 * new path seems to take almost exactly the same amount of time as the
 * old path!  The primary time taken by normalization is in
 * GetFileAttributesEx/FindFirstFile or
 * GetFileAttributesEx/GetLongPathName.  Conversion to/from native is
 * not a significant factor at all.
 * 
 * Also, since we have to check for symbolic links (reparse points)
 * then we have to call GetFileAttributes on each path segment anyway,
 * so there's no benefit to doing anything clever there.
 */
/* #define TclNORM_LONG_PATH */

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjNormalizePath --
 *
 *	This function scans through a path specification and replaces it,

 *
 * Side effects:
 *	The pathPtr string, which must contain a valid path, is
 *	possibly modified in place.
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
    Tcl_Interp *interp;
    Tcl_Obj *pathPtr;
    int nextCheckpoint;
{
    char *lastValidPathEnd = NULL;

	    currentPathEndPosition++;
	}
    } else {
	/* We're on WinNT or 2000 or XP */
	Tcl_Obj *temp = NULL;
	int isDrive = 1;
	Tcl_DString ds;
	
	currentPathEndPosition = path + nextCheckpoint;
	if (*currentPathEndPosition == '/') {
	    currentPathEndPosition++;
	}
	while (1) {
	    char cur = *currentPathEndPosition;
	    if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {

		 * Check for symlinks, except at last component
		 * of path (we don't follow final symlinks). Also
		 * a drive (C:/) for example, may sometimes have
		 * the reparse flag set for some reason I don't
		 * understand.  We therefore don't perform this
		 * check for drives.
		 */
		if (cur != 0 && !isDrive 
		  && (data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT)) {
		    Tcl_Obj *to = WinReadLinkDirectory(nativePath);
		    if (to != NULL) {
			/* Read the reparse point ok */
			/* Tcl_GetStringFromObj(to, &pathLen); */
			nextCheckpoint = 0; /* pathLen */
			Tcl_AppendToObj(to, currentPathEndPosition, -1);
			/* Convert link to forward slashes */

			isDrive = 1;
			Tcl_DStringFree(&dsNorm);
			Tcl_DStringInit(&dsNorm);
			Tcl_DStringFree(&ds);
			continue;
		    }
		}
#ifndef TclNORM_LONG_PATH
		/*
		 * Now we convert the tail of the current path to its
		 * 'long form', and append it to 'dsNorm' which holds
		 * the current normalized path
		 */
		if (isDrive) {
		    WCHAR drive = ((WCHAR*)nativePath)[0];

			FindClose(handle);
			Tcl_DStringAppend(&dsNorm,(CONST char*)L"/", 
					  sizeof(WCHAR));
			Tcl_DStringAppend(&dsNorm,(TCHAR*)nativeName, 
					  (int) (wcslen(nativeName)*sizeof(WCHAR)));
		    }
		}
#endif
		Tcl_DStringFree(&ds);
		lastValidPathEnd = currentPathEndPosition;
		if (cur == 0) {
		    break;
		}
		/* 
		 * If we get here, we've got past one directory
		 * delimiter, so we know it is no longer a drive 
		 */
		isDrive = 0;
	    }
	    currentPathEndPosition++;
	}
#ifdef TclNORM_LONG_PATH
	/* 
	 * Convert the entire known path to long form.
	 */
	if (1) {
	    WCHAR wpath[MAX_PATH];
	    DWORD wpathlen;
	    CONST char *nativePath = Tcl_WinUtfToTChar(path, 
					lastValidPathEnd - path, &ds);
	    wpathlen = (*tclWinProcs->getLongPathNameProc)(nativePath, 
							   (TCHAR*)wpath, 
							   MAX_PATH);
	    /* We have to make the drive letter uppercase */
	    if (wpath[0] >= L'a') {
		wpath[0] -= (L'a' - L'A');
	    }
	    Tcl_DStringAppend(&dsNorm, (TCHAR*)wpath, wpathlen*sizeof(WCHAR));
	    Tcl_DStringFree(&ds);
	}
#endif
    }
    /* Common code path for all Windows platforms */
    nextCheckpoint = currentPathEndPosition - path;
    if (lastValidPathEnd != NULL) {
	/* 
	 * Concatenate the normalized string in dsNorm with the
	 * tail of the path which we didn't recognise.  The

/*
 * tclWinInt.h --
 *
 *	Declarations of Windows-specific shared variables and procedures.
 *
 * Copyright (c) 1994-1996 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: tclWinInt.h,v 1.24 2004/01/21 19:59:34 vincentdarley Exp $
 */

#ifndef _TCLWININT
#define _TCLWININT

#ifndef _TCLINT
#include "tclInt.h"

    
    INT (__cdecl *utimeProc)(CONST TCHAR*, struct _utimbuf *);
    /* These two are also NULL at start; see comment above */
    HANDLE (WINAPI *findFirstFileExProc)(CONST TCHAR*, UINT,
					 LPVOID, UINT,
					 LPVOID, DWORD);
    BOOL (WINAPI *getVolumeNameForVMPProc)(CONST TCHAR*, TCHAR*, DWORD);
    DWORD (WINAPI *getLongPathNameProc)(CONST TCHAR*, TCHAR*, DWORD);
    /* 
     * These six are for the security sdk to get correct file
     * permissions on NT, 2000, XP, etc.  On 95,98,ME they are
     * always null.
     */
    BOOL (WINAPI *getFileSecurityProc)(LPCTSTR lpFileName,
		     SECURITY_INFORMATION RequestedInformation,