2001-07-31  Vince Darley <vincentdarley@users.sourceforge.net>

        Changes from TIP#17 "Redo Tcl's filesystem"
	The following files were impacted:
	* doc/Access.3: 
	* doc/FileSystem.3: 
	* doc/OpenFileChnl.3: 
	* doc/file.n: 
	* doc/glob.n: 
	* generic/tcl.decls: 
	* generic/tcl.h: 
	* generic/tclCmdAH.c: 
	* generic/tclCmdIL.c: 
	* generic/tclCmdMZ.c: 
	* generic/tclDate.c: 
	* generic/tclDecls.h: 
	* generic/tclEncoding.c: 
	* generic/tclFCmd.c: 
	* generic/tclFileName.c: 
	* generic/tclGetDate.y: 
	* generic/tclIO.c: 
	* generic/tclIOCmd.c: 
	* generic/tclIOUtil.c: 
	* generic/tclInt.decls: 
	* generic/tclInt.h: 
	* generic/tclIntDecls.h: 
	* generic/tclLoad.c: 
	* generic/tclStubInit.c: 
	* generic/tclTest.c: 
	* generic/tclUtil.c: 
	* library/init.tcl: 
	* mac/tclMacFCmd.c: 
	* mac/tclMacFile.c: 
	* mac/tclMacInit.c: 
	* mac/tclMacPort.h: 
	* mac/tclMacResource.c: 
	* mac/tclMacTime.c: 
	* tests/cmdAH.test: 
	* tests/event.test: 
	* tests/fCmd.test: 
	* tests/fileName.test: 
	* tests/io.test: 
	* tests/ioCmd.test: 
	* tests/proc-old.test: 
	* tests/registry.test: 
	* tests/unixFCmd.test: 
	* tests/winDde.test: 
	* tests/winFCmd.test: 
	* unix/mkLinks: 
	* unix/tclUnixFCmd.c: 
	* unix/tclUnixFile.c: 
	* unix/tclUnixInit.c: 
	* unix/tclUnixPipe.c: 
	* win/tclWinFCmd.c: 
	* win/tclWinFile.c: 
	* win/tclWinInit.c: 
	* win/tclWinPipe.c

2001-07-24  Mo DeJong  <mdejong@redhat.com>

	* win/tclWinThrd.c (Tcl_CreateThread): Close Windows
	HANDLE returned by _beginthreadex. The MS documentation
	states that this handle is not closed by a later call to
	_endthreadex.

'\"
'\" Copyright (c) 1998-1999 Scriptics Corportation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: Access.3,v 1.4 2001/07/31 19:12:05 vincentdarley Exp $
'\" 
.so man.macros
.TH Tcl_Access 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_Access, Tcl_Stat \- check file permissions and other attributes
.SH SYNOPSIS

write and  execute  permissions, respectively.  F_OK just requests
checking for the existence of the file.
.AP stat *statPtr out
The structure that contains the result.
.BE

.SH DESCRIPTION
.PP
As of Tcl 8.4, the object-based APIs \fBTcl_FSAccess\fR and
\fBTcl_FSStat\fR should be used in preference to \fBTcl_Access\fR and
\fBTcl_Stat\fR, wherever possible.
.PP
There are two reasons for calling \fBTcl_Access\fR and \fBTcl_Stat\fR
rather than calling system level functions \fBaccess\fR and \fBstat\fR
directly.  First, the Windows implementation of both functions fixes
some bugs in the system level calls.  Second, both \fBTcl_Access\fR
and \fBTcl_Stat\fR (as well as \fBTcl_OpenFileChannelProc\fR) hook
into a linked list of functions.  This allows the possibity to reroute

'\"
'\" Copyright (c) 1996-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: OpenFileChnl.3,v 1.10 2001/07/31 19:12:05 vincentdarley Exp $
.so man.macros
.TH Tcl_OpenFileChannel 3 8.3 Tcl "Tcl Library Procedures"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_OpenFileChannel, Tcl_OpenCommandChannel, Tcl_MakeFileChannel, Tcl_GetChannel, Tcl_GetChannelNames, Tcl_GetChannelNamesEx, Tcl_RegisterChannel, Tcl_UnregisterChannel, Tcl_DetachChannel, Tcl_IsStandardChannel, Tcl_Close, Tcl_ReadChars, Tcl_Read, Tcl_GetsObj, Tcl_Gets, Tcl_WriteObj, Tcl_WriteChars, Tcl_Write, Tcl_Flush, Tcl_Seek, Tcl_Tell, Tcl_GetChannelOption, Tcl_SetChannelOption, Tcl_Eof, Tcl_InputBlocked, Tcl_InputBuffered, Tcl_Ungets \- buffered I/O facilities using channels
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
typedef ... Tcl_Channel;
.sp
Tcl_Channel

.sp
void
\fBTcl_RegisterChannel\fR(\fIinterp, channel\fR)
.sp
int
\fBTcl_UnregisterChannel\fR(\fIinterp, channel\fR)
.sp
int
\fBTcl_DetachChannel\fR(\fIinterp, channel\fR)
.sp
int
\fBTcl_IsStandardChannel\fR(\fIchannel\fR)
.sp
int
\fBTcl_Close\fR(\fIinterp, channel\fR)
.sp
.VS 8.1
int
\fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR)
.sp

the Unix standard I/O library.
The syntax and meaning of all arguments is similar to those
given in the Tcl \fBopen\fR command when opening a file.
If an error occurs while opening the channel, \fBTcl_OpenFileChannel\fR
returns NULL and records a POSIX error code that can be
retrieved with \fBTcl_GetErrno\fR.
In addition, if \fIinterp\fR is non-NULL, \fBTcl_OpenFileChannel\fR
leaves an error message in \fIinterp\fR's result after any error.  
As of Tcl 8.4, the object-based API \fBTcl_FSOpenFileChannel\fR should 
be used in preference to \fBTcl_OpenFileChannel\fR wherever possible.
.PP

.PP
The newly created channel is not registered in the supplied interpreter; to
register it, use \fBTcl_RegisterChannel\fR, described below.
If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
previously closed, the act of creating the new channel also assigns it as a
replacement for the standard channel.

able to use the channel's name to refer to the channel in that interpreter.
If this operation removed the last registration of the channel in any
interpreter, the channel is also closed and destroyed.
.PP
Code not associated with a Tcl interpreter can call
\fBTcl_UnregisterChannel\fR with \fIinterp\fR as NULL, to indicate to Tcl
that it no longer holds a reference to that channel. If this is the last
reference to the channel, it will now be closed.  \fBTcl_UnregisterChannel\fR
is very similar to \fBTcl_DetachChannel\fR except that it will also
close the channel if no further references to it exist.

.SH TCL_DETACHCHANNEL
.PP
\fBTcl_DetachChannel\fR removes a channel from the set of channels
accessible in \fIinterp\fR. After this call, Tcl programs will no longer be
able to use the channel's name to refer to the channel in that interpreter.
Beyond that, this command has no further effect.  It cannot be used on
the standard channels (stdout, stderr, stdin), and will return
TCL_ERROR if passed one of those channels.
.PP
Code not associated with a Tcl interpreter can call
\fBTcl_DetachChannel\fR with \fIinterp\fR as NULL, to indicate to Tcl
that it no longer holds a reference to that channel. If this is the last
reference to the channel, unlike \fBTcl_UnregisterChannel\fR, 
it will not be closed.

.SH TCL_ISSTANDARDCHANNEL
.PP
\fBTcl_IsStandardChannel\fR tests whether a channel is one of the
three standard channels, stdin, stdout or stderr.  If so, it returns
1, otherwise 0.
.PP
No attempt is made to check whether the given channel or the standard 
channels are initialized or otherwise valid.

.SH TCL_CLOSE
.PP
\fBTcl_Close\fR destroys the channel \fIchannel\fR, which must denote a
currently open channel. The channel should not be registered in any
interpreter when \fBTcl_Close\fR is called. Buffered output is flushed to
the channel's output device prior to destroying the channel, and any

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" 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: file.n,v 1.7 2001/07/31 19:12:06 vincentdarley Exp $
'\" 
.so man.macros
.TH file n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
file \- Manipulate file names and attributes

.TP
\fBfile nativename \fIname\fR
.
Returns the platform-specific name of the file. This is useful if the
filename is needed to pass to a platform-specific call, such as exec
under Windows or AppleScript on the Macintosh.
.TP
\fBfile normalize \fIname\fR
.
Returns a unique normalised path representation for the file, whose string
value can be used as a unique identifier for the it.  A normalized path is
one which has all '../', './' removed.  Also it is one which is in the
'standard' format for the native platform.  On MacOS, Unix, this means the
path must be free of symbolic links/aliases, and on Windows it means we want
the long form, with the long form's case-dependence (which gives us a
unique, case-dependent path).
.TP
\fBfile owned \fIname\fR 
.
Returns \fB1\fR if file \fIname\fR is owned by the current user, \fB0\fR
otherwise.
.TP
\fBfile pathtype \fIname\fR
.

.RE
.TP
\fBfile rootname \fIname\fR
.
Returns all of the characters in \fIname\fR up to but not including the
last ``.'' character in the last component of name.  If the last
component of \fIname\fR doesn't contain a dot, then returns \fIname\fR.
.TP
\fBfile separator ?\fIname\fR?
.
If no argument is given, returns the character which is used to separate 
path segments for native files on this platform.  If a path is given,
the filesystem responsible for that path is asked to return its
separator character.  If no file system accepts \fIname\fR, an error
is generated.
.TP
\fBfile size \fIname\fR
.
Returns a decimal string giving the size of file \fIname\fR in bytes.  If
the file doesn't exist or its size cannot be queried then an error is
generated.
.TP

\fBuid\fR.  Each element except \fBtype\fR is a decimal string with the
value of the corresponding field from the \fBstat\fR return structure;
see the manual entry for \fBstat\fR for details on the meanings of the
values.  The \fBtype\fR element gives the type of the file in the same
form returned by the command \fBfile type\fR.  This command returns an
empty string.
.TP
\fBfile system \fIname\fR
.
Returns a list of two elements, the first of which is the name of the
filesystem to use for the file, and the second the type of the file
within that filesystem.  If a filesystem only supports one type of
file, the second element may be null.  For example the native files
have a first element 'native', and a second element which is a
platform-specific type name for the file (e.g. 'networked'), or
possibly the empty string.  A generic virtual file system might return
the list 'vfs ftp' to represent a file on a remote ftp site mounted as
a virtual filesystem through an extension called 'vfs'.  If the file
does not belong to any filesystem, an error is generated.
.TP
\fBfile tail \fIname\fR
.
Returns all of the characters in \fIname\fR after the last directory
separator.  If \fIname\fR contains no separators then returns
\fIname\fR.
.TP
\fBfile type \fIname\fR

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" 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: glob.n,v 1.9 2001/07/31 19:12:06 vincentdarley Exp $
'\" 
.so man.macros
.TH glob n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
glob \- Return names of files that match patterns

\fB\-path\fR \fIpathPrefix\fR
Search for files with the given \fIpathPrefix\fR where the rest of the name
matches the given patterns.  This allows searching for files with names
similar to a given file even when the names contain glob-sensitive
characters.  This option may not be used in conjunction with
\fB\-directory\fR.
.TP
\fB\-tails\fR
Only return the part of each file found which follows the last directory
named in any \fB\-directory\fR or \fB\-path\fR path specification.  
Thus \fBglob -tails -dir $dir *\fR is equivalent to 
\fBset pwd [pwd] ; cd $dir ; glob *; cd $pwd\fR.  For 
\fB\-path\fR specifications, the returned names will include the last
path segment, so \fBglob -tails -path /usr/loc */*\fR will return paths
like \fBlocal/bin local/lib\fR etc.
.TP
\fB\-types\fR \fItypeList\fR
Only list files or directories which match \fItypeList\fR, where the items
in the list have two forms.  The first form is like the \-type option of
the Unix find command:
\fIb\fR (block special file),
\fIc\fR (character special file),
\fId\fR (directory),

.TP 10
\fB\e\fIx\fR
Matches the character \fIx\fR.
.TP 10
\fB{\fIa\fB,\fIb\fB,\fI...\fR}
Matches any of the strings \fIa\fR, \fIb\fR, etc.
.LP
On Unix, as with csh, a ``.'' at the beginning of a file's name or just
after a ``/'' must be matched explicitly or with a {} construct,
unless the ``-types hidden'' flag is given (since ``.'' at the beginning 
of a file's name indicates that it is hidden).  On other platforms,
files beginning with a ``.'' are handled no differently to any others,
except the special directories ``.'' and ``..'' which must be matched
explicitly (this is to avoid a recursive pattern like ``glob -join * *
* *'' from recursing up the directory hierarchy as well as down).
In addition, all ``/'' characters must be matched explicitly.
.LP
If the first character in a \fIpattern\fR is ``~'' then it refers
to the home directory for the user whose name follows the ``~''.
If the ``~'' is followed immediately by ``/'' then the value of
the HOME environment variable is used.
.LP

# 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.
# 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.51 2001/07/31 19:12:06 vincentdarley Exp $

library tcl

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

}
declare 432 generic {
    int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length)
}
declare 433 generic {
    Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel)
}

# introduced in 8.4a3
declare 434 generic {
    Tcl_UniChar * Tcl_GetUnicodeFromObj (Tcl_Obj *objPtr, int *lengthPtr)
}
declare 435 generic {
    int Tcl_GetMathFuncInfo(Tcl_Interp *interp, CONST char *name,
	int *numArgsPtr, Tcl_ValueType **argTypesPtr,
	Tcl_MathProc **procPtr, ClientData *clientDataPtr)
}
declare 436 generic {
    Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp, CONST char *pattern)
}
declare 437 generic {
    Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}
declare 438 generic {
    int Tcl_DetachChannel(Tcl_Interp* interp, Tcl_Channel channel)
}
declare 439 generic {
    int Tcl_IsStandardChannel(Tcl_Channel channel)
}
declare 440 generic {
    int	Tcl_FSCopyFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
}
declare 441 generic {
    int	Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr, \
			    Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr)
}
declare 442 generic {
    int	Tcl_FSCreateDirectory(Tcl_Obj *pathPtr)
}
declare 443 generic {
    int	Tcl_FSDeleteFile(Tcl_Obj *pathPtr)
}
declare 444 generic {
    int	Tcl_FSLoadFile(Tcl_Interp * interp, \
		    Tcl_Obj *pathPtr, char * sym1, char * sym2, \
		    Tcl_PackageInitProc ** proc1Ptr, \
		    Tcl_PackageInitProc ** proc2Ptr, \
		    ClientData * clientDataPtr, \
		    Tcl_FSUnloadFileProc **unloadProcPtr)
}
declare 445 generic {
    int	Tcl_FSMatchInDirectory(Tcl_Interp *interp, Tcl_Obj * result, \
		    Tcl_Obj *pathPtr, \
		    char * pattern, Tcl_GlobTypeData * types)
}
declare 446 generic {
    Tcl_Obj*	Tcl_FSReadlink(Tcl_Obj *pathPtr)
}
declare 447 generic {
    int	Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr, \
		    int recursive, Tcl_Obj **errorPtr)
}
declare 448 generic {
    int	Tcl_FSRenameFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
}
declare 449 generic {
    int	Tcl_FSLstat(Tcl_Obj *pathPtr, struct stat *buf)
}
declare 450 generic {
    int Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval)
}
declare 451 generic {
    int Tcl_FSFileAttrsGet(Tcl_Interp *interp, \
			    int index, Tcl_Obj *pathPtr, \
			    Tcl_Obj **objPtrRef)
}
declare 452 generic {
    int Tcl_FSFileAttrsSet(Tcl_Interp *interp, \
			    int index, Tcl_Obj *pathPtr, \
			    Tcl_Obj *objPtr)
}
declare 453 generic {
    char** Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef)
}
declare 454 generic {
    int Tcl_FSStat(Tcl_Obj *pathPtr, struct stat *buf)
}
declare 455 generic {
    int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode)
}
declare 456 generic {
    Tcl_Channel Tcl_FSOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr, \
	    char *modeString, int permissions)
}
declare 457 generic {
    Tcl_Obj*  Tcl_FSGetCwd(Tcl_Interp *interp)
}
declare 458 generic {
    int Tcl_FSChdir(Tcl_Obj *pathPtr)
}
declare 459 generic {
    int Tcl_FSConvertToPathType(Tcl_Interp *interp, Tcl_Obj *pathPtr)
}
declare 460 generic {
    Tcl_Obj* Tcl_FSJoinPath(Tcl_Obj *listObj, int elements)
}
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* pathObjPtr)
}
declare 464 generic {
    Tcl_Obj* Tcl_FSJoinToPath(Tcl_Obj *basePtr, int objc, Tcl_Obj *CONST objv[])
}
declare 465 generic {
    ClientData Tcl_FSGetInternalRep(Tcl_Obj* pathObjPtr, Tcl_Filesystem *fsPtr)
}
declare 466 generic {
    char* 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_Obj* fromFilesystem, ClientData clientData)
}
declare 469 generic {
    char* Tcl_FSGetNativePath(Tcl_Obj* pathObjPtr)
}
declare 470 generic {
    Tcl_Obj* Tcl_FSFileSystemInfo(Tcl_Obj* pathObjPtr)
}
declare 471 generic {
    Tcl_Obj* Tcl_FSPathSeparator(Tcl_Obj* pathObjPtr)
}
declare 472 generic {
    int	Tcl_FSListVolumes(Tcl_Interp *interp)
}
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)
}

##############################################################################

# Define the platform specific public Tcl interface.  These functions are
# only available on the designated platform.

interface tclPlat

 * Copyright (c) 1993-1996 Lucent Technologies.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 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: tcl.h,v 1.94 2001/07/31 19:12:06 vincentdarley Exp $
 */

#ifndef _TCL
#define _TCL

/*
 * For C++ compilers, use extern "C"

typedef enum Tcl_PathType {
    TCL_PATH_ABSOLUTE,
    TCL_PATH_RELATIVE,
    TCL_PATH_VOLUME_RELATIVE
} Tcl_PathType;

/* 
 * The following structure is used to pass glob type data amongst
 * the various glob routines and Tcl_FSMatchInDirectory.
 */
typedef struct Tcl_GlobTypeData {
    /* Corresponds to bcdpfls as in 'find -t' */
    int type;
    /* Corresponds to file permissions */
    int perm;
    /* Acceptable mac type */
    Tcl_Obj* macType;
    /* Acceptable mac creator */
    Tcl_Obj* macCreator;
} Tcl_GlobTypeData;

/*
 * type and permission definitions for glob command
 */
#define TCL_GLOB_TYPE_BLOCK		(1<<0)
#define TCL_GLOB_TYPE_CHAR		(1<<1)
#define TCL_GLOB_TYPE_DIR		(1<<2)
#define TCL_GLOB_TYPE_PIPE		(1<<3)
#define TCL_GLOB_TYPE_FILE		(1<<4)
#define TCL_GLOB_TYPE_LINK		(1<<5)
#define TCL_GLOB_TYPE_SOCK		(1<<6)

#define TCL_GLOB_PERM_RONLY		(1<<0)
#define TCL_GLOB_PERM_HIDDEN		(1<<1)
#define TCL_GLOB_PERM_R			(1<<2)
#define TCL_GLOB_PERM_W			(1<<3)
#define TCL_GLOB_PERM_X			(1<<4)

/*
 * Typedefs for the various filesystem operations:
 */

typedef int (Tcl_FSStatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, struct stat *buf));
typedef int (Tcl_FSAccessProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode));
typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) 
	_ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, 
	char *modeString, int permissions));
typedef int (Tcl_FSMatchInDirectoryProc) _ANSI_ARGS_((Tcl_Interp* interp, 
	Tcl_Obj *result, Tcl_Obj *pathPtr, char *pattern, 
	Tcl_GlobTypeData * types));
typedef Tcl_Obj* (Tcl_FSGetCwdProc) _ANSI_ARGS_((Tcl_Interp *interp));
typedef int (Tcl_FSChdirProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
typedef int (Tcl_FSLstatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, 
					   struct stat *buf));
typedef int (Tcl_FSCreateDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
typedef int (Tcl_FSDeleteFileProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
typedef int (Tcl_FSCopyDirectoryProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
	   Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr));
typedef int (Tcl_FSCopyFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
			    Tcl_Obj *destPathPtr));
typedef int (Tcl_FSRemoveDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
			    int recursive, Tcl_Obj **errorPtr));
typedef int (Tcl_FSRenameFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
			    Tcl_Obj *destPathPtr));
typedef void (Tcl_FSUnloadFileProc) _ANSI_ARGS_((ClientData clientData));
typedef int (Tcl_FSListVolumesProc) _ANSI_ARGS_((Tcl_Interp *interp));
/* We have to declare the utime structure here. */
struct utimbuf;
typedef int (Tcl_FSUtimeProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, 
					   struct utimbuf *tval));
typedef int (Tcl_FSNormalizePathProc) _ANSI_ARGS_((Tcl_Interp *interp, 
			 Tcl_Obj *pathPtr, int nextCheckpoint));
typedef int (Tcl_FSFileAttrsGetProc) _ANSI_ARGS_((Tcl_Interp *interp,
			    int index, Tcl_Obj *pathPtr,
			    Tcl_Obj **objPtrRef));
typedef char** (Tcl_FSFileAttrStringsProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, 
			    Tcl_Obj** objPtrRef));
typedef int (Tcl_FSFileAttrsSetProc) _ANSI_ARGS_((Tcl_Interp *interp,
			    int index, Tcl_Obj *pathPtr,
			    Tcl_Obj *objPtr));
typedef Tcl_Obj* (Tcl_FSReadlinkProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
typedef int (Tcl_FSLoadFileProc) _ANSI_ARGS_((Tcl_Interp * interp, 
			    Tcl_Obj *pathPtr, char * sym1, char * sym2, 
			    Tcl_PackageInitProc ** proc1Ptr, 
			    Tcl_PackageInitProc ** proc2Ptr, 
			    ClientData * clientDataPtr));
typedef int (Tcl_FSPathInFilesystemProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, 
			    ClientData *clientDataPtr));
typedef Tcl_Obj* (Tcl_FSFilesystemPathTypeProc) 
			    _ANSI_ARGS_((Tcl_Obj *pathPtr));
typedef Tcl_Obj* (Tcl_FSFilesystemSeparatorProc) 
			    _ANSI_ARGS_((Tcl_Obj *pathPtr));
typedef void (Tcl_FSFreeInternalRepProc) _ANSI_ARGS_((ClientData clientData));
typedef ClientData (Tcl_FSDupInternalRepProc) 
			    _ANSI_ARGS_((ClientData clientData));
typedef Tcl_Obj* (Tcl_FSInternalToNormalizedProc) 
			    _ANSI_ARGS_((ClientData clientData));
typedef ClientData (Tcl_FSCreateInternalRepProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));

typedef struct Tcl_FSVersion_ *Tcl_FSVersion;

/*
 *----------------------------------------------------------------
 * Data structures related to hooking into the filesystem
 *----------------------------------------------------------------
 */

/*
 * Filesystem version tag.  This was introduced in 8.4.
 */

#define TCL_FILESYSTEM_VERSION_1	((Tcl_FSVersion) 0x1)

/*
 * struct Tcl_Filesystem:
 *
 * One such structure exists for each type (kind) of filesystem.
 * It collects together in one place all the functions that are
 * part of the specific filesystem.  Tcl always accesses the
 * filesystem through one of these structures.
 * 
 * Not all entries need be non-NULL; any which are NULL are simply
 * ignored.  However, a complete filesystem should provide all of
 * these functions.  The explanations in the structure show
 * the importance of each function.
 */

typedef struct Tcl_Filesystem {
    CONST char *typeName;   /* The name of the filesystem. */
    int structureLength;    /* Length of this structure, so future
			     * binary compatibility can be assured. */
    Tcl_FSVersion version;  
			    /* Version of the filesystem type. */
    Tcl_FSPathInFilesystemProc *pathInFilesystemProc;
			    /* Function to check whether a path is in 
			     * this filesystem.  This is the most
			     * important filesystem procedure. */
    Tcl_FSDupInternalRepProc *dupInternalRepProc;
			    /* Function to duplicate internal fs rep.  May
			     * be NULL (but then fs is less efficient). */ 
    Tcl_FSFreeInternalRepProc *freeInternalRepProc;
			    /* Function to free internal fs rep.  Must
			     * be implemented, if internal representations
			     * need freeing, otherwise it can be NULL. */ 
    Tcl_FSInternalToNormalizedProc *internalToNormalizedProc;
			    /* Function to convert internal representation
			     * to a normalized path.  Only required if
			     * the fs creates pure path objects with no
			     * string/path representation. */
    Tcl_FSCreateInternalRepProc *createInternalRepProc;
			    /* Function to create a filesystem-specific
			     * internal representation.  May be NULL
			     * if paths have no internal representation, 
			     * or if the Tcl_FSPathInFilesystemProc
			     * for this filesystem always immediately 
			     * creates an internal representation for 
			     * paths it accepts. */
    Tcl_FSNormalizePathProc *normalizePathProc;       
			    /* Function to normalize a path.  Should
			     * be implemented for all filesystems
			     * which can have multiple string 
			     * representations for the same path 
			     * object. */
    Tcl_FSFilesystemPathTypeProc *filesystemPathTypeProc;
			    /* Function to determine the type of a 
			     * path in this filesystem.  May be NULL. */
    Tcl_FSFilesystemSeparatorProc *filesystemSeparatorProc;
			    /* Function to return the separator 
			     * character(s) for this filesystem.  Must
			     * be implemented. */
    Tcl_FSStatProc *statProc; 
			    /* 
			     * Function to process a 'Tcl_FSStat()'
			     * call.  Must be implemented for any
			     * reasonable filesystem.
			     */
    Tcl_FSAccessProc *accessProc;	    
			    /* 
			     * Function to process a 'Tcl_FSAccess()'
			     * call.  Must be implemented for any
			     * reasonable filesystem.
			     */
    Tcl_FSOpenFileChannelProc *openFileChannelProc; 
			    /* 
			     * Function to process a
			     * 'Tcl_FSOpenFileChannel()' call.  Must be
			     * implemented for any reasonable
			     * filesystem.
			     */
    Tcl_FSMatchInDirectoryProc *matchInDirectoryProc;  
			    /* Function to process a 
			     * 'Tcl_FSMatchInDirectory()'.  If not
			     * implemented, then glob and recursive
			     * copy functionality will be lacking in
			     * the filesystem. */
    Tcl_FSUtimeProc *utimeProc;       
			    /* Function to process a 
			     * 'Tcl_FSUtime()' call.  Required to
			     * allow setting (not reading) of times 
			     * with 'file mtime', 'file atime' and
			     * the open-r/open-w/fcopy implementation
			     * of 'file copy'. */
    Tcl_FSReadlinkProc *readlinkProc; 
			    /* Function to process a 
			     * 'Tcl_FSReadlink()' call.  Should be
			     * implemented only if the filesystem supports
			     * links. */
    Tcl_FSListVolumesProc *listVolumesProc;	    
			    /* Function to list any filesystem volumes 
			     * added by this filesystem.  Should be
			     * implemented only if the filesystem adds
			     * volumes at the head of the filesystem. */
    Tcl_FSFileAttrStringsProc *fileAttrStringsProc;
			    /* Function to list all attributes strings 
			     * which are valid for this filesystem.  
			     * If not implemented the filesystem will
			     * not support the 'file attributes' command.
			     * This allows arbitrary additional information
			     * to be attached to files in the filesystem. */
    Tcl_FSFileAttrsGetProc *fileAttrsGetProc;
			    /* Function to process a 
			     * 'Tcl_FSFileAttrsGet()' call, used by
			     * 'file attributes'. */
    Tcl_FSFileAttrsSetProc *fileAttrsSetProc;
			    /* Function to process a 
			     * 'Tcl_FSFileAttrsSet()' call, used by
			     * 'file attributes'.  */
    Tcl_FSCreateDirectoryProc *createDirectoryProc;	    
			    /* Function to process a 
			     * 'Tcl_FSCreateDirectory()' call. Should
			     * be implemented unless the FS is
			     * read-only. */
    Tcl_FSRemoveDirectoryProc *removeDirectoryProc;	    
			    /* Function to process a 
			     * 'Tcl_FSRemoveDirectory()' call. Should
			     * be implemented unless the FS is
			     * read-only. */
    Tcl_FSDeleteFileProc *deleteFileProc;	    
			    /* Function to process a 
			     * 'Tcl_FSDeleteFile()' call.  Should
			     * be implemented unless the FS is
			     * read-only. */
    Tcl_FSLstatProc *lstatProc;	    
			    /* Function to process a 
			     * 'Tcl_FSLstat()' call.  If not implemented,
			     * Tcl will attempt to use the 'statProc'
			     * defined above instead. */
    Tcl_FSCopyFileProc *copyFileProc; 
			    /* Function to process a 
			     * 'Tcl_FSCopyFile()' call.  If not
			     * implemented Tcl will fall back
			     * on open-r, open-w and fcopy as
			     * a copying mechanism. */
    Tcl_FSRenameFileProc *renameFileProc;	    
			    /* Function to process a 
			     * 'Tcl_FSRenameFile()' call.  If not
			     * implemented, Tcl will fall back on
			     * a copy and delete mechanism. */
    Tcl_FSCopyDirectoryProc *copyDirectoryProc;	    
			    /* Function to process a 
			     * 'Tcl_FSCopyDirectory()' call.  If
			     * not implemented, Tcl will fall back
			     * on a recursive create-dir, file copy
			     * mechanism. */
    Tcl_FSLoadFileProc *loadFileProc; 
			    /* Function to process a 
			     * 'Tcl_FSLoadFile()' call.  If not
			     * implemented, Tcl will fall back on
			     * a copy to native-temp followed by a 
			     * Tcl_FSLoadFile on that temporary copy. */
    Tcl_FSUnloadFileProc *unloadFileProc;	    
			    /* Function to unload a previously 
			     * successfully loaded file.  If load was
			     * implemented, then this should also be
			     * implemented, if there is any cleanup
			     * action required. */
    Tcl_FSGetCwdProc *getCwdProc;     
			    /* 
			     * Function to process a 'Tcl_FSGetCwd()'
			     * call.  Most filesystems need not
			     * implement this.  It will usually only be
			     * called once, if 'getcwd' is called
			     * before 'chdir'.  May be NULL.
			     */
    Tcl_FSChdirProc *chdirProc;	    
			    /* 
			     * Function to process a 'Tcl_FSChdir()'
			     * call.  If filesystems do not implement
			     * this, it will be emulated by a series of
			     * directory access checks.  Otherwise,
			     * virtual filesystems which do implement
			     * it need only respond with a positive
			     * return result if the dirName is a valid
			     * directory in their filesystem.  They
			     * need not remember the result, since that
			     * will be automatically remembered for use
			     * by GetCwd.  Real filesystems should
			     * carry out the correct action (i.e. call
			     * the correct system 'chdir' api).  If not
			     * implemented, then 'cd' and 'pwd' will
			     * fail inside the filesystem.
			     */
} Tcl_Filesystem;

/*
 * The following structure represents the Notifier functions that
 * you can override with the Tcl_SetNotifier call.
 */

typedef struct Tcl_NotifierProcs {
    Tcl_SetTimerProc *setTimerProc;

/* 
 * 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.13 2001/07/31 19:12:06 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 *objPtr, int mode));
static int		GetStatBuf _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_FSStatProc *statProc,
			    struct stat *statPtr));
static char *		GetTypeFromMode _ANSI_ARGS_((int mode));
static int		SplitPath _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr, int *argcPtr, char ***argvPtr));
static int		StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
			    char *varName, struct stat *statPtr));



/*
 *----------------------------------------------------------------------
 *
 * Tcl_BreakObjCmd --
 *
 *	This procedure is invoked to process the "break" Tcl command.

int
Tcl_CdObjCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    Tcl_Obj *dir;

    int result;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?dirName?");
	return TCL_ERROR;
    }

    if (objc == 2) {
	dir = objv[1];
    } else {
	dir = Tcl_NewStringObj("~",1);
	Tcl_IncrRefCount(dir);
    }
    if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) {
	result = TCL_ERROR;

    } else {
	result = Tcl_FSChdir(dir);


	if (result != TCL_OK) {
	    Tcl_AppendResult(interp, "couldn't change working directory to \"",
		    Tcl_GetString(dir), "\": ", Tcl_PosixError(interp), (char *) NULL);
	    result = TCL_ERROR;
	}
    }
    if (objc != 2) {
	Tcl_DecrRefCount(dir);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConcatObjCmd --
 *

 *
 * Tcl_FileObjCmd --
 *
 *	This procedure is invoked to process the "file" Tcl command.
 *	See the user documentation for details on what it does.
 *	PLEASE NOTE THAT THIS FAILS WITH FILENAMES AND PATHS WITH
 *	EMBEDDED NULLS, WHICH COULD THEORETICALLY HAPPEN ON A MAC.
 *      With the object-based Tcl_FS APIs, the above NOTE may no
 *      longer be true.  In any case this assertion should be tested.
 *      
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------

 */

    static char *fileOptions[] = {
	"atime",	"attributes",	"channels",	"copy",
	"delete",
	"dirname",	"executable",	"exists",	"extension",
	"isdirectory",	"isfile",	"join",		"lstat",
	"mtime",	"mkdir",	"nativename",	
	"normalize",    "owned",
	"pathtype",	"readable",	"readlink",	"rename",
	"rootname",	"separator",    "size",		"split",	
	"stat",         "system", 
	"tail",		"type",		"volumes",	"writable",
	(char *) NULL
    };
    enum options {
	FILE_ATIME,	FILE_ATTRIBUTES, FILE_CHANNELS,	FILE_COPY,
	FILE_DELETE,
	FILE_DIRNAME,	FILE_EXECUTABLE, FILE_EXISTS,	FILE_EXTENSION,
	FILE_ISDIRECTORY, FILE_ISFILE,	FILE_JOIN,	FILE_LSTAT,
	FILE_MTIME,	FILE_MKDIR,	FILE_NATIVENAME, 
	FILE_NORMALIZE, FILE_OWNED,
	FILE_PATHTYPE,	FILE_READABLE,	FILE_READLINK,	FILE_RENAME,
	FILE_ROOTNAME,	FILE_SEPARATOR, FILE_SIZE,	FILE_SPLIT,	
	FILE_STAT,      FILE_SYSTEM, 
	FILE_TAIL,	FILE_TYPE,	FILE_VOLUMES,	FILE_WRITABLE
    };

    if (objc < 2) {
    	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
        return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], fileOptions, "option", 0,
	    &index) != TCL_OK) {
    	return TCL_ERROR;
    }

    resultPtr = Tcl_GetObjResult(interp);
    switch ((enum options) index) {
    	case FILE_ATIME: {
	    struct stat buf;

	    struct utimbuf tval;

	    if ((objc < 3) || (objc > 4)) {
		Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
		return TCL_ERROR;
	    }
	    if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (objc == 4) {
		if (Tcl_GetLongFromObj(interp, objv[3],
			(long*)(&buf.st_atime)) != TCL_OK) {
		    return TCL_ERROR;
		}
		tval.actime = buf.st_atime;
		tval.modtime = buf.st_mtime;

		if (Tcl_FSUtime(objv[2], &tval) != 0) {
		    Tcl_AppendStringsToObj(resultPtr,
			    "could not set access time for file \"",
			    Tcl_GetString(objv[2]), "\": ",
			    Tcl_PosixError(interp), (char *) NULL);
		    return TCL_ERROR;
		}
		/*
		 * Do another stat to ensure that the we return the
		 * new recognized atime - hopefully the same as the
		 * one we sent in.  However, fs's like FAT don't
		 * even know what atime is.
		 */
		if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    Tcl_SetLongObj(resultPtr, (long) buf.st_atime);
	    return TCL_OK;
	}
	case FILE_ATTRIBUTES: {
            return TclFileAttrsCmd(interp, objc, objv);
	}
	case FILE_CHANNELS: {
	    if ((objc < 2) || (objc > 3)) {
		Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
		return TCL_ERROR;
	    }
	    return Tcl_GetChannelNamesEx(interp,
		    ((objc == 2) ? NULL : Tcl_GetString(objv[2])));
	}
	case FILE_COPY: {




	    return TclFileCopyCmd(interp, objc, objv);


	}	    
	case FILE_DELETE: {




	    return TclFileDeleteCmd(interp, objc, objv);


	}
    	case FILE_DIRNAME: {
    	    int argc;
	    char ** argv;

	    if (objc != 3) {
		goto only3Args;
	    }
	    if (SplitPath(interp, objv[2], &argc, &argv) != TCL_OK) {
		return TCL_ERROR;
	    }

	    int value;
	    struct stat buf;

	    if (objc != 3) {
		goto only3Args;
	    }
	    value = 0;
	    if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
		value = S_ISDIR(buf.st_mode);
	    }
	    Tcl_SetBooleanObj(resultPtr, value);
	    return TCL_OK;
	}
    	case FILE_ISFILE: {
	    int value;
	    struct stat buf;
	    
    	    if (objc != 3) {
    	    	goto only3Args;
    	    }
	    value = 0;
	    if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
		value = S_ISREG(buf.st_mode);
	    }
	    Tcl_SetBooleanObj(resultPtr, value);
	    return TCL_OK;
	}
	case FILE_JOIN: {

	    Tcl_Obj *resObj;

	    if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
		return TCL_ERROR;
	    }
	    resObj = Tcl_FSJoinToPath(NULL, objc - 2, objv + 2);


	    Tcl_SetObjResult(interp, resObj);



	    return TCL_OK;
	}
    	case FILE_LSTAT: {
	    char *varName;
	    struct stat 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;
	    }
	    varName = Tcl_GetString(objv[3]);
	    return StoreStatData(interp, varName, &buf);
	}
	case FILE_MTIME: {
	    struct stat buf;

	    struct utimbuf tval;

	    if ((objc < 3) || (objc > 4)) {
		Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
		return TCL_ERROR;
	    }
	    if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (objc == 4) {
		if (Tcl_GetLongFromObj(interp, objv[3],
			(long*)(&buf.st_mtime)) != TCL_OK) {
		    return TCL_ERROR;
		}
		tval.actime = buf.st_atime;
		tval.modtime = buf.st_mtime;

		if (Tcl_FSUtime(objv[2], &tval) != 0) {
		    Tcl_AppendStringsToObj(resultPtr,
			    "could not set modification time for file \"",
			    Tcl_GetString(objv[2]), "\": ",
			    Tcl_PosixError(interp), (char *) NULL);
		    return TCL_ERROR;
		}
		/*
		 * Do another stat to ensure that the we return the
		 * new recognized atime - hopefully the same as the
		 * one we sent in.  However, fs's like FAT don't
		 * even know what atime is.
		 */
		if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    Tcl_SetLongObj(resultPtr, (long) buf.st_mtime);
	    return TCL_OK;
	}
	case FILE_MKDIR: {



	    if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
		return TCL_ERROR;
	    }

	    return TclFileMakeDirsCmd(interp, objc, objv);


	}
	case FILE_NATIVENAME: {
	    char *fileName;
	    Tcl_DString ds;

	    if (objc != 3) {
		goto only3Args;
	    }
	    fileName = Tcl_GetString(objv[2]);
	    fileName = Tcl_TranslateFileName(interp, fileName, &ds);
	    if (fileName == NULL) {
		return TCL_ERROR;
	    }
	    Tcl_SetStringObj(resultPtr, fileName, Tcl_DStringLength(&ds));
	    Tcl_DStringFree(&ds);
	    return TCL_OK;
	}
	case FILE_NORMALIZE: {
	    Tcl_Obj *fileName;

	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "filename");
		return TCL_ERROR;
	    }

	    fileName = Tcl_FSGetNormalizedPath(interp, objv[2]);
	    Tcl_SetObjResult(interp, fileName);
	    return TCL_OK;
	}
	case FILE_OWNED: {
	    int value;
	    struct stat buf;
	    
	    if (objc != 3) {
		goto only3Args;
	    }
	    value = 0;
	    if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
		/*
		 * For Windows and Macintosh, there are no user ids 
		 * associated with a file, so we always return 1.
		 */

#if (defined(__WIN32__) || defined(MAC_TCL))
		value = 1;

    	case FILE_READABLE: {
	    if (objc != 3) {
		goto only3Args;
	    }
	    return CheckAccess(interp, objv[2], R_OK);
	}
	case FILE_READLINK: {
	    Tcl_Obj *contents;

		
	    if (objc != 3) {
		goto only3Args;
	    }
	    
	    if (Tcl_FSConvertToPathType(interp, objv[2]) != TCL_OK) {


		return TCL_ERROR;
	    }










	    contents = Tcl_FSReadlink(objv[2]);






	    if (contents == NULL) {
	    	Tcl_AppendResult(interp, "could not readlink \"", 
	    		Tcl_GetString(objv[2]), "\": ", 
	    		Tcl_PosixError(interp), (char *) NULL);
	    	return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, contents);
	    Tcl_DecrRefCount(contents);
	    return TCL_OK;
	}
	case FILE_RENAME: {




	    return TclFileRenameCmd(interp, objc, objv);


	}
	case FILE_ROOTNAME: {
	    int length;
	    char *fileName, *extension;
	    
	    if (objc != 3) {
		goto only3Args;
	    }
	    fileName = Tcl_GetStringFromObj(objv[2], &length);
	    extension = TclGetExtension(fileName);
	    if (extension == NULL) {
	    	Tcl_SetObjResult(interp, objv[2]);
	    } else {
	        Tcl_SetStringObj(resultPtr, fileName,
			(int) (length - strlen(extension)));
	    }
	    return TCL_OK;
	}
	case FILE_SEPARATOR: {
	    if ((objc < 2) || (objc > 3)) {
		Tcl_WrongNumArgs(interp, 2, objv, "?name?");
		return TCL_ERROR;
	    }
	    if (objc == 2) {
	        char *separator = NULL; /* lint */
		switch (tclPlatform) {
		    case TCL_PLATFORM_UNIX:
			separator = "/";
			break;
		    case TCL_PLATFORM_WINDOWS:
			separator = "\\";
			break;
		    case TCL_PLATFORM_MAC:
			separator = ":";
			break;
		}
		Tcl_SetObjResult(interp, Tcl_NewStringObj(separator,1));
	    } else {
		Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[2]);
		if (separatorObj != NULL) {
		    Tcl_SetObjResult(interp, separatorObj);
		} else {
		    Tcl_SetObjResult(interp, 
				     Tcl_NewStringObj("Unrecognised path",-1));
		    return TCL_ERROR;
		}
	    }
	    return TCL_OK;
	}
	case FILE_SIZE: {
	    struct stat buf;
	    
	    if (objc != 3) {
		goto only3Args;
	    }
	    if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_SetLongObj(resultPtr, (long) buf.st_size);
	    return TCL_OK;
	}
	case FILE_SPLIT: {





	    if (objc != 3) {
		goto only3Args;
	    }
	    Tcl_SetObjResult(interp, Tcl_FSSplitPath(objv[2], NULL));






	    return TCL_OK;
	}
	case FILE_STAT: {
	    char *varName;
	    struct stat 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;
	    }
	    varName = Tcl_GetString(objv[3]);
	    return StoreStatData(interp, varName, &buf);
	}
	case FILE_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 FILE_TAIL: {
	    int argc;
	    char **argv;

	    if (objc != 3) {
		goto only3Args;

	}
	case FILE_TYPE: {
	    struct stat buf;

	    if (objc != 3) {
	    	goto only3Args;
	    }
	    if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_SetStringObj(resultPtr, 
		    GetTypeFromMode((unsigned short) buf.st_mode), -1);
	    return TCL_OK;
	}
	case FILE_VOLUMES: {
	    if (objc != 2) {
		Tcl_WrongNumArgs(interp, 2, objv, NULL);
		return TCL_ERROR;
	    }
	    return Tcl_FSListVolumes(interp);
	}
	case FILE_WRITABLE: {
	    if (objc != 3) {
	    	goto only3Args;
	    }
	    return CheckAccess(interp, objv[2], W_OK);
	}

    Tcl_Interp *interp;		/* Interp for status return.  Must not be
				 * NULL. */
    Tcl_Obj *objPtr;		/* Name of file to check. */
    int mode;			/* Attribute to check; passed as argument to
				 * access(). */
{
    int value;


    
    if (Tcl_FSConvertToPathType(interp, objPtr) != TCL_OK) {


	value = 0;
    } else {
	value = (Tcl_FSAccess(objPtr, mode) == 0);

    }
    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);

    return TCL_OK;
}

/*

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

static int
GetStatBuf(interp, objPtr, statProc, statPtr)
    Tcl_Interp *interp;		/* Interp for error return.  May be NULL. */
    Tcl_Obj *objPtr;		/* Path name to examine. */
    Tcl_FSStatProc *statProc;	/* Either stat() or lstat() depending on
				 * desired behavior. */
    struct stat *statPtr;	/* Filled with info about file obtained by
				 * calling (*statProc)(). */
{


    int status;
    
    if (Tcl_FSConvertToPathType(interp, objPtr) != TCL_OK) {


	return TCL_ERROR;
    }

    status = (*statProc)(objPtr, statPtr);

    
    if (status < 0) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "could not read \"",
		    Tcl_GetString(objPtr), "\": ",
		    Tcl_PosixError(interp), (char *) NULL);
	}

    fmtError:
    if(dst != staticBuf) {
        ckfree(dst);
    }
    Tcl_DecrRefCount(resultPtr);
    return TCL_ERROR;
}

 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-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: tclCmdIL.c,v 1.33 2001/07/31 19:12:06 vincentdarley Exp $
 */

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

    Interp *iPtr = (Interp *) interp;
    if ((objc != 2) && (objc != 3)) {
        Tcl_WrongNumArgs(interp, 2, objv, "?filename?");
        return TCL_ERROR;
    }

    if (objc == 3) {



	if (iPtr->scriptFile != NULL) {
	    Tcl_DecrRefCount(iPtr->scriptFile);
	}
	iPtr->scriptFile = objv[2];
	Tcl_IncrRefCount(iPtr->scriptFile);
    }
    if (iPtr->scriptFile != NULL) {
        Tcl_SetObjResult(interp, iPtr->scriptFile);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 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: tclCmdMZ.c,v 1.42 2001/07/31 19:12:06 vincentdarley Exp $
 */

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

int
Tcl_PwdObjCmd(dummy, interp, objc, objv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    Tcl_Obj *retVal;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    retVal = Tcl_FSGetCwd(interp);
    if (retVal == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, retVal);
    Tcl_DecrRefCount(retVal);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_RegexpObjCmd --

int
Tcl_SourceObjCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{



    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "fileName");
	return TCL_ERROR;
    }


    return Tcl_FSEvalFile(interp, objv[1]);

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SplitObjCmd --
 *

/* 
 * tclDate.c --
 *
 *	This file is generated from a yacc grammar defined in
 *	the file tclGetDate.y.  It should not be edited directly.
 *
 * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995-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: tclDate.c,v 1.19 2001/07/31 19:12:06 vincentdarley Exp $
 */

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

#if defined(MAC_TCL) && !defined(TCL_MAC_USE_MSL_EPOCH)
#   define EPOCH           1904
#   define START_OF_TIME   1904
#   define END_OF_TIME     2039
#else
#   define EPOCH           1970
#   define START_OF_TIME   1902
#   define END_OF_TIME     2037

/*
 * 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.53 2001/07/31 19:12:06 vincentdarley Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

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

				ClientData * clientDataPtr));
/* 436 */
EXTERN Tcl_Obj *	Tcl_ListMathFuncs _ANSI_ARGS_((Tcl_Interp * interp, 
				CONST char * pattern));
/* 437 */
EXTERN Tcl_Obj *	Tcl_SubstObj _ANSI_ARGS_((Tcl_Interp * interp, 
				Tcl_Obj * objPtr, int flags));
/* 438 */
EXTERN int		Tcl_DetachChannel _ANSI_ARGS_((Tcl_Interp* interp, 
				Tcl_Channel channel));
/* 439 */
EXTERN int		Tcl_IsStandardChannel _ANSI_ARGS_((
				Tcl_Channel channel));
/* 440 */
EXTERN int		Tcl_FSCopyFile _ANSI_ARGS_((Tcl_Obj * srcPathPtr, 
				Tcl_Obj * destPathPtr));
/* 441 */
EXTERN int		Tcl_FSCopyDirectory _ANSI_ARGS_((
				Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr, 
				Tcl_Obj ** errorPtr));
/* 442 */
EXTERN int		Tcl_FSCreateDirectory _ANSI_ARGS_((Tcl_Obj * pathPtr));
/* 443 */
EXTERN int		Tcl_FSDeleteFile _ANSI_ARGS_((Tcl_Obj * pathPtr));
/* 444 */
EXTERN int		Tcl_FSLoadFile _ANSI_ARGS_((Tcl_Interp * interp, 
				Tcl_Obj * pathPtr, char * sym1, char * sym2, 
				Tcl_PackageInitProc ** proc1Ptr, 
				Tcl_PackageInitProc ** proc2Ptr, 
				ClientData * clientDataPtr, 
				Tcl_FSUnloadFileProc ** unloadProcPtr));
/* 445 */
EXTERN int		Tcl_FSMatchInDirectory _ANSI_ARGS_((
				Tcl_Interp * interp, Tcl_Obj * result, 
				Tcl_Obj * pathPtr, char * pattern, 
				Tcl_GlobTypeData * types));
/* 446 */
EXTERN Tcl_Obj*		Tcl_FSReadlink _ANSI_ARGS_((Tcl_Obj * pathPtr));
/* 447 */
EXTERN int		Tcl_FSRemoveDirectory _ANSI_ARGS_((Tcl_Obj * pathPtr, 
				int recursive, Tcl_Obj ** errorPtr));
/* 448 */
EXTERN int		Tcl_FSRenameFile _ANSI_ARGS_((Tcl_Obj * srcPathPtr, 
				Tcl_Obj * destPathPtr));
/* 449 */
EXTERN int		Tcl_FSLstat _ANSI_ARGS_((Tcl_Obj * pathPtr, 
				struct stat * buf));
/* 450 */
EXTERN int		Tcl_FSUtime _ANSI_ARGS_((Tcl_Obj * pathPtr, 
				struct utimbuf * tval));
/* 451 */
EXTERN int		Tcl_FSFileAttrsGet _ANSI_ARGS_((Tcl_Interp * interp, 
				int index, Tcl_Obj * pathPtr, 
				Tcl_Obj ** objPtrRef));
/* 452 */
EXTERN int		Tcl_FSFileAttrsSet _ANSI_ARGS_((Tcl_Interp * interp, 
				int index, Tcl_Obj * pathPtr, 
				Tcl_Obj * objPtr));
/* 453 */
EXTERN char**		Tcl_FSFileAttrStrings _ANSI_ARGS_((Tcl_Obj * pathPtr, 
				Tcl_Obj ** objPtrRef));
/* 454 */
EXTERN int		Tcl_FSStat _ANSI_ARGS_((Tcl_Obj * pathPtr, 
				struct stat * buf));
/* 455 */
EXTERN int		Tcl_FSAccess _ANSI_ARGS_((Tcl_Obj * pathPtr, 
				int mode));
/* 456 */
EXTERN Tcl_Channel	Tcl_FSOpenFileChannel _ANSI_ARGS_((
				Tcl_Interp * interp, Tcl_Obj * pathPtr, 
				char * modeString, int permissions));
/* 457 */
EXTERN Tcl_Obj*		Tcl_FSGetCwd _ANSI_ARGS_((Tcl_Interp * interp));
/* 458 */
EXTERN int		Tcl_FSChdir _ANSI_ARGS_((Tcl_Obj * pathPtr));
/* 459 */
EXTERN int		Tcl_FSConvertToPathType _ANSI_ARGS_((
				Tcl_Interp * interp, Tcl_Obj * pathPtr));
/* 460 */
EXTERN Tcl_Obj*		Tcl_FSJoinPath _ANSI_ARGS_((Tcl_Obj * listObj, 
				int elements));
/* 461 */
EXTERN Tcl_Obj*		Tcl_FSSplitPath _ANSI_ARGS_((Tcl_Obj* pathPtr, 
				int * lenPtr));
/* 462 */
EXTERN int		Tcl_FSEqualPaths _ANSI_ARGS_((Tcl_Obj* firstPtr, 
				Tcl_Obj* secondPtr));
/* 463 */
EXTERN Tcl_Obj*		Tcl_FSGetNormalizedPath _ANSI_ARGS_((
				Tcl_Interp * interp, Tcl_Obj* pathObjPtr));
/* 464 */
EXTERN Tcl_Obj*		Tcl_FSJoinToPath _ANSI_ARGS_((Tcl_Obj * basePtr, 
				int objc, Tcl_Obj *CONST objv[]));
/* 465 */
EXTERN ClientData	Tcl_FSGetInternalRep _ANSI_ARGS_((
				Tcl_Obj* pathObjPtr, Tcl_Filesystem * fsPtr));
/* 466 */
EXTERN char*		Tcl_FSGetTranslatedPath _ANSI_ARGS_((
				Tcl_Interp * interp, Tcl_Obj* pathPtr));
/* 467 */
EXTERN int		Tcl_FSEvalFile _ANSI_ARGS_((Tcl_Interp * interp, 
				Tcl_Obj * fileName));
/* 468 */
EXTERN Tcl_Obj*		Tcl_FSNewNativePath _ANSI_ARGS_((
				Tcl_Obj* fromFilesystem, 
				ClientData clientData));
/* 469 */
EXTERN char*		Tcl_FSGetNativePath _ANSI_ARGS_((Tcl_Obj* pathObjPtr));
/* 470 */
EXTERN Tcl_Obj*		Tcl_FSFileSystemInfo _ANSI_ARGS_((
				Tcl_Obj* pathObjPtr));
/* 471 */
EXTERN Tcl_Obj*		Tcl_FSPathSeparator _ANSI_ARGS_((Tcl_Obj* pathObjPtr));
/* 472 */
EXTERN int		Tcl_FSListVolumes _ANSI_ARGS_((Tcl_Interp * interp));
/* 473 */
EXTERN int		Tcl_FSRegister _ANSI_ARGS_((ClientData clientData, 
				Tcl_Filesystem * fsPtr));
/* 474 */
EXTERN int		Tcl_FSUnregister _ANSI_ARGS_((Tcl_Filesystem * fsPtr));
/* 475 */
EXTERN ClientData	Tcl_FSData _ANSI_ARGS_((Tcl_Filesystem * fsPtr));

typedef struct TclStubHooks {
    struct TclPlatStubs *tclPlatStubs;
    struct TclIntStubs *tclIntStubs;
    struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

    char * (*tcl_AttemptDbCkrealloc) _ANSI_ARGS_((char * ptr, unsigned int size, char * file, int line)); /* 431 */
    int (*tcl_AttemptSetObjLength) _ANSI_ARGS_((Tcl_Obj * objPtr, int length)); /* 432 */
    Tcl_ThreadId (*tcl_GetChannelThread) _ANSI_ARGS_((Tcl_Channel channel)); /* 433 */
    Tcl_UniChar * (*tcl_GetUnicodeFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 434 */
    int (*tcl_GetMathFuncInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, int * numArgsPtr, Tcl_ValueType ** argTypesPtr, Tcl_MathProc ** procPtr, ClientData * clientDataPtr)); /* 435 */
    Tcl_Obj * (*tcl_ListMathFuncs) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pattern)); /* 436 */
    Tcl_Obj * (*tcl_SubstObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int flags)); /* 437 */
    int (*tcl_DetachChannel) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Channel channel)); /* 438 */
    int (*tcl_IsStandardChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 439 */
    int (*tcl_FSCopyFile) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 440 */
    int (*tcl_FSCopyDirectory) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr, Tcl_Obj ** errorPtr)); /* 441 */
    int (*tcl_FSCreateDirectory) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 442 */
    int (*tcl_FSDeleteFile) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 443 */
    int (*tcl_FSLoadFile) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, char * sym1, char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr, ClientData * clientDataPtr, Tcl_FSUnloadFileProc ** unloadProcPtr)); /* 444 */
    int (*tcl_FSMatchInDirectory) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * result, Tcl_Obj * pathPtr, char * pattern, Tcl_GlobTypeData * types)); /* 445 */
    Tcl_Obj* (*tcl_FSReadlink) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 446 */
    int (*tcl_FSRemoveDirectory) _ANSI_ARGS_((Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr)); /* 447 */
    int (*tcl_FSRenameFile) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 448 */
    int (*tcl_FSLstat) _ANSI_ARGS_((Tcl_Obj * pathPtr, struct stat * buf)); /* 449 */
    int (*tcl_FSUtime) _ANSI_ARGS_((Tcl_Obj * pathPtr, struct utimbuf * tval)); /* 450 */
    int (*tcl_FSFileAttrsGet) _ANSI_ARGS_((Tcl_Interp * interp, int index, Tcl_Obj * pathPtr, Tcl_Obj ** objPtrRef)); /* 451 */
    int (*tcl_FSFileAttrsSet) _ANSI_ARGS_((Tcl_Interp * interp, int index, Tcl_Obj * pathPtr, Tcl_Obj * objPtr)); /* 452 */
    char** (*tcl_FSFileAttrStrings) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj ** objPtrRef)); /* 453 */
    int (*tcl_FSStat) _ANSI_ARGS_((Tcl_Obj * pathPtr, struct stat * buf)); /* 454 */
    int (*tcl_FSAccess) _ANSI_ARGS_((Tcl_Obj * pathPtr, int mode)); /* 455 */
    Tcl_Channel (*tcl_FSOpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, 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* pathObjPtr)); /* 463 */
    Tcl_Obj* (*tcl_FSJoinToPath) _ANSI_ARGS_((Tcl_Obj * basePtr, int objc, Tcl_Obj *CONST objv[])); /* 464 */
    ClientData (*tcl_FSGetInternalRep) _ANSI_ARGS_((Tcl_Obj* pathObjPtr, Tcl_Filesystem * fsPtr)); /* 465 */
    char* (*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_Obj* fromFilesystem, ClientData clientData)); /* 468 */
    char* (*tcl_FSGetNativePath) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 469 */
    Tcl_Obj* (*tcl_FSFileSystemInfo) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 470 */
    Tcl_Obj* (*tcl_FSPathSeparator) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 471 */
    int (*tcl_FSListVolumes) _ANSI_ARGS_((Tcl_Interp * interp)); /* 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 */
} TclStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern TclStubs *tclStubsPtr;
#ifdef __cplusplus

#define Tcl_ListMathFuncs \
	(tclStubsPtr->tcl_ListMathFuncs) /* 436 */
#endif
#ifndef Tcl_SubstObj
#define Tcl_SubstObj \
	(tclStubsPtr->tcl_SubstObj) /* 437 */
#endif
#ifndef Tcl_DetachChannel
#define Tcl_DetachChannel \
	(tclStubsPtr->tcl_DetachChannel) /* 438 */
#endif
#ifndef Tcl_IsStandardChannel
#define Tcl_IsStandardChannel \
	(tclStubsPtr->tcl_IsStandardChannel) /* 439 */
#endif
#ifndef Tcl_FSCopyFile
#define Tcl_FSCopyFile \
	(tclStubsPtr->tcl_FSCopyFile) /* 440 */
#endif
#ifndef Tcl_FSCopyDirectory
#define Tcl_FSCopyDirectory \
	(tclStubsPtr->tcl_FSCopyDirectory) /* 441 */
#endif
#ifndef Tcl_FSCreateDirectory
#define Tcl_FSCreateDirectory \
	(tclStubsPtr->tcl_FSCreateDirectory) /* 442 */
#endif
#ifndef Tcl_FSDeleteFile
#define Tcl_FSDeleteFile \
	(tclStubsPtr->tcl_FSDeleteFile) /* 443 */
#endif
#ifndef Tcl_FSLoadFile
#define Tcl_FSLoadFile \
	(tclStubsPtr->tcl_FSLoadFile) /* 444 */
#endif
#ifndef Tcl_FSMatchInDirectory
#define Tcl_FSMatchInDirectory \
	(tclStubsPtr->tcl_FSMatchInDirectory) /* 445 */
#endif
#ifndef Tcl_FSReadlink
#define Tcl_FSReadlink \
	(tclStubsPtr->tcl_FSReadlink) /* 446 */
#endif
#ifndef Tcl_FSRemoveDirectory
#define Tcl_FSRemoveDirectory \
	(tclStubsPtr->tcl_FSRemoveDirectory) /* 447 */
#endif
#ifndef Tcl_FSRenameFile
#define Tcl_FSRenameFile \
	(tclStubsPtr->tcl_FSRenameFile) /* 448 */
#endif
#ifndef Tcl_FSLstat
#define Tcl_FSLstat \
	(tclStubsPtr->tcl_FSLstat) /* 449 */
#endif
#ifndef Tcl_FSUtime
#define Tcl_FSUtime \
	(tclStubsPtr->tcl_FSUtime) /* 450 */
#endif
#ifndef Tcl_FSFileAttrsGet
#define Tcl_FSFileAttrsGet \
	(tclStubsPtr->tcl_FSFileAttrsGet) /* 451 */
#endif
#ifndef Tcl_FSFileAttrsSet
#define Tcl_FSFileAttrsSet \
	(tclStubsPtr->tcl_FSFileAttrsSet) /* 452 */
#endif
#ifndef Tcl_FSFileAttrStrings
#define Tcl_FSFileAttrStrings \
	(tclStubsPtr->tcl_FSFileAttrStrings) /* 453 */
#endif
#ifndef Tcl_FSStat
#define Tcl_FSStat \
	(tclStubsPtr->tcl_FSStat) /* 454 */
#endif
#ifndef Tcl_FSAccess
#define Tcl_FSAccess \
	(tclStubsPtr->tcl_FSAccess) /* 455 */
#endif
#ifndef Tcl_FSOpenFileChannel
#define Tcl_FSOpenFileChannel \
	(tclStubsPtr->tcl_FSOpenFileChannel) /* 456 */
#endif
#ifndef Tcl_FSGetCwd
#define Tcl_FSGetCwd \
	(tclStubsPtr->tcl_FSGetCwd) /* 457 */
#endif
#ifndef Tcl_FSChdir
#define Tcl_FSChdir \
	(tclStubsPtr->tcl_FSChdir) /* 458 */
#endif
#ifndef Tcl_FSConvertToPathType
#define Tcl_FSConvertToPathType \
	(tclStubsPtr->tcl_FSConvertToPathType) /* 459 */
#endif
#ifndef Tcl_FSJoinPath
#define Tcl_FSJoinPath \
	(tclStubsPtr->tcl_FSJoinPath) /* 460 */
#endif
#ifndef Tcl_FSSplitPath
#define Tcl_FSSplitPath \
	(tclStubsPtr->tcl_FSSplitPath) /* 461 */
#endif
#ifndef Tcl_FSEqualPaths
#define Tcl_FSEqualPaths \
	(tclStubsPtr->tcl_FSEqualPaths) /* 462 */
#endif
#ifndef Tcl_FSGetNormalizedPath
#define Tcl_FSGetNormalizedPath \
	(tclStubsPtr->tcl_FSGetNormalizedPath) /* 463 */
#endif
#ifndef Tcl_FSJoinToPath
#define Tcl_FSJoinToPath \
	(tclStubsPtr->tcl_FSJoinToPath) /* 464 */
#endif
#ifndef Tcl_FSGetInternalRep
#define Tcl_FSGetInternalRep \
	(tclStubsPtr->tcl_FSGetInternalRep) /* 465 */
#endif
#ifndef Tcl_FSGetTranslatedPath
#define Tcl_FSGetTranslatedPath \
	(tclStubsPtr->tcl_FSGetTranslatedPath) /* 466 */
#endif
#ifndef Tcl_FSEvalFile
#define Tcl_FSEvalFile \
	(tclStubsPtr->tcl_FSEvalFile) /* 467 */
#endif
#ifndef Tcl_FSNewNativePath
#define Tcl_FSNewNativePath \
	(tclStubsPtr->tcl_FSNewNativePath) /* 468 */
#endif
#ifndef Tcl_FSGetNativePath
#define Tcl_FSGetNativePath \
	(tclStubsPtr->tcl_FSGetNativePath) /* 469 */
#endif
#ifndef Tcl_FSFileSystemInfo
#define Tcl_FSFileSystemInfo \
	(tclStubsPtr->tcl_FSFileSystemInfo) /* 470 */
#endif
#ifndef Tcl_FSPathSeparator
#define Tcl_FSPathSeparator \
	(tclStubsPtr->tcl_FSPathSeparator) /* 471 */
#endif
#ifndef Tcl_FSListVolumes
#define Tcl_FSListVolumes \
	(tclStubsPtr->tcl_FSListVolumes) /* 472 */
#endif
#ifndef Tcl_FSRegister
#define Tcl_FSRegister \
	(tclStubsPtr->tcl_FSRegister) /* 473 */
#endif
#ifndef Tcl_FSUnregister
#define Tcl_FSUnregister \
	(tclStubsPtr->tcl_FSUnregister) /* 474 */
#endif
#ifndef Tcl_FSData
#define Tcl_FSData \
	(tclStubsPtr->tcl_FSData) /* 475 */
#endif

#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#endif /* _TCLDECLS */

/*
 * tclEncoding.c --
 *
 *	Contains the implementation of the encoding conversion package.
 *
 * 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: tclEncoding.c,v 1.7 2001/07/31 19:12:06 vincentdarley Exp $
 */

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

typedef size_t (LengthProc)_ANSI_ARGS_((CONST char *src));

    }
    Tcl_MutexUnlock(&encodingMutex);

    pathPtr = TclGetLibraryPath();
    if (pathPtr != NULL) {
	int i, objc;
	Tcl_Obj **objv;

	char globArgString[10];
	Tcl_Obj* encodingObj = Tcl_NewStringObj("encoding",-1);
	Tcl_IncrRefCount(encodingObj);
	
	objc = 0;
	Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);



	for (i = 0; i < objc; i++) {


	    Tcl_Obj *searchIn;
	    
	    /* 
	     * Construct the path from the element of pathPtr,
	     * joined with 'encoding'.
	     */
	    searchIn = Tcl_FSJoinToPath(objv[i],1,&encodingObj);
	    Tcl_IncrRefCount(searchIn);
	    Tcl_ResetResult(interp);

	    /*
	     * TclGlob() changes the contents of globArgString, which causes
	     * a segfault if we pass in a pointer to non-writeable memory.
	     * TclGlob() puts its results directly into interp.
	     */

	    strcpy(globArgString, "*.enc");

	    /* 
	     * The GLOBMODE_TAILS flag returns just the tail of each file
	     * which is the encoding name with a .enc extension 
	     */
	    if ((TclGlob(interp, globArgString, searchIn, 
			 TCL_GLOBMODE_TAILS, NULL) == TCL_OK)) {
		int objc2 = 0;
		Tcl_Obj **objv2;
		int j;

		Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), &objc2,
			&objv2);

		for (j = 0; j < objc2; j++) {
		    int length;
		    char *string;
		    string = Tcl_GetStringFromObj(objv2[j], &length);
		    length -= 4;
		    if (length > 0) {
			string[length] = '\0';
			Tcl_CreateHashEntry(&table, string, &dummy);
			string[length] = '.';
		    }
		}
	    }
	    Tcl_DecrRefCount(searchIn);
	}
	Tcl_DecrRefCount(encodingObj);
    }

    /*
     * Clear any values placed in the result by globbing.
     */

    Tcl_ResetResult(interp);

    CONST char *name;

{
    char *argv[3];
    Tcl_DString pathString;
    char *path;
    Tcl_Channel chan;
    Tcl_Obj *pathPtr;
    
    argv[0] = (char *) dir;
    argv[1] = "encoding";
    argv[2] = (char *) name;

    Tcl_DStringInit(&pathString);
    Tcl_JoinPath(3, argv, &pathString);
    path = Tcl_DStringAppend(&pathString, ".enc", -1);
    pathPtr = Tcl_NewStringObj(path,-1);

    Tcl_IncrRefCount(pathPtr);
    chan = Tcl_FSOpenFileChannel(NULL, pathPtr, "r", 0);
    Tcl_DecrRefCount(pathPtr);

    Tcl_DStringFree(&pathString);

    return chan;
}

/*
 *-------------------------------------------------------------------------

/*
 * 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.7 2001/07/31 19:12:06 vincentdarley Exp $
 */

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

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

static int		CopyRenameOneFile _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, 
			    int copyFlag, int force));
static Tcl_Obj *	FileBasename _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *pathPtr));
static int		FileCopyRename _ANSI_ARGS_((Tcl_Interp *interp,
			    int objc, Tcl_Obj *CONST objv[], int copyFlag));
static int		FileForceOption _ANSI_ARGS_((Tcl_Interp *interp,
			    int objc, Tcl_Obj *CONST objv[], int *forcePtr));

/*
 *---------------------------------------------------------------------------
 *
 * TclFileRenameCmd
 *
 *	This procedure implements the "rename" subcommand of the "file"

 * Side effects:
 *	See the user documentation.
 *
 *---------------------------------------------------------------------------
 */

int
TclFileRenameCmd(interp, objc, objv)
    Tcl_Interp *interp;		/* Interp for error reporting. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument strings passed to Tcl_FileCmd. */
{
    return FileCopyRename(interp, objc, objv, 0);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFileCopyCmd
 *

 * Side effects:
 *	See the user documentation.
 *
 *---------------------------------------------------------------------------
 */

int
TclFileCopyCmd(interp, objc, objv)
    Tcl_Interp *interp;		/* Used for error reporting */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument strings passed to Tcl_FileCmd. */
{
    return FileCopyRename(interp, objc, objv, 1);
}

/*
 *---------------------------------------------------------------------------
 *
 * FileCopyRename --
 *
 *	Performs the work of TclFileRenameCmd and TclFileCopyCmd.
 *	See comments for those procedures.
 *
 * Results:
 *	See above.
 *
 * Side effects:
 *	See above.
 *
 *---------------------------------------------------------------------------
 */

static int
FileCopyRename(interp, objc, objv, copyFlag)
    Tcl_Interp *interp;		/* Used for error reporting. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument strings passed to Tcl_FileCmd. */
    int copyFlag;		/* If non-zero, copy source(s).  Otherwise,
				 * rename them. */
{
    int i, result, force;
    struct stat statBuf; 

    Tcl_Obj *target;

    i = FileForceOption(interp, objc - 2, objv + 2, &force);
    if (i < 0) {
	return TCL_ERROR;
    }
    i += 2;
    if ((objc - i) < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", 
		Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]), 
		" ?options? source ?source ...? target\"", 
		(char *) NULL);
	return TCL_ERROR;
    }

    /*
     * If target doesn't exist or isn't a directory, try the copy/rename.
     * More than 2 arguments is only valid if the target is an existing
     * directory.
     */


    target = objv[objc - 1];
    if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {
	return TCL_ERROR;
    }

    result = TCL_OK;

    /*
     * Call Tcl_FSStat() so that if target is a symlink that points to a
     * directory we will put the sources in that directory instead of
     * overwriting the symlink.
     */

    if ((Tcl_FSStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
	if ((objc - i) > 2) {
	    errno = ENOTDIR;
	    Tcl_PosixError(interp);
	    Tcl_AppendResult(interp, "error ",
		    ((copyFlag) ? "copying" : "renaming"), ": target \"",
		    Tcl_GetString(target), "\" is not a directory", 
		    (char *) NULL);
	    result = TCL_ERROR;
	} else {
	    /*
	     * Even though already have target == translated(objv[i+1]),
	     * pass the original argument down, so if there's an error, the
	     * error message will reflect the original arguments.
	     */

	    result = CopyRenameOneFile(interp, objv[i], objv[i + 1], copyFlag,
		    force);
	}

	return result;
    }
    
    /*
     * Move each source file into target directory.  Extract the basename
     * from each source, and append it to the end of the target path.
     */

    for ( ; i < objc - 1; i++) {
	Tcl_Obj *jargv[2];
	Tcl_Obj *source, *newFileName;
	Tcl_Obj *temp;
	
	source = FileBasename(interp, objv[i]);
	if (source == NULL) {
	    result = TCL_ERROR;
	    break;
	}
	jargv[0] = objv[objc - 1];
	jargv[1] = source;
	temp = Tcl_NewListObj(2, jargv);
	newFileName = Tcl_FSJoinPath(temp, -1);
	Tcl_IncrRefCount(newFileName);
	Tcl_DecrRefCount(temp);
	
	result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag,
		force);


	Tcl_DecrRefCount(newFileName);
	if (result == TCL_ERROR) {
	    break;
	}
    }

    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFileMakeDirsCmd

 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
int
TclFileMakeDirsCmd(interp, objc, objv)
    Tcl_Interp *interp;		/* Used for error reporting. */
    int objc;			/* Number of arguments */
    Tcl_Obj *CONST objv[];	/* Argument strings passed to Tcl_FileCmd. */
{

    Tcl_Obj *errfile;
    int result, i, j, pobjc;
    Tcl_Obj *split = NULL;
    Tcl_Obj *target = NULL;
    struct stat statBuf;


    errfile = NULL;



    result = TCL_OK;
    for (i = 2; i < objc; i++) {

	if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
	    result = TCL_ERROR;
	    break;
	}

	split = Tcl_FSSplitPath(objv[i],&pobjc);
	if (pobjc == 0) {
	    errno = ENOENT;
	    errfile = objv[i];
	    break;
	}
	for (j = 0; j < pobjc; j++) {
	    target = Tcl_FSJoinPath(split, j + 1);
	    Tcl_IncrRefCount(target);
	    /*
	     * Call Tcl_Stat() so that if target is a symlink that points
	     * to a directory we will create subdirectories in that
	     * directory.
	     */

	    if (Tcl_FSStat(target, &statBuf) == 0) {
		if (!S_ISDIR(statBuf.st_mode)) {
		    errno = EEXIST;
		    errfile = target;
		    goto done;
		}
	    } else if ((errno != ENOENT)
		    || (Tcl_FSCreateDirectory(target) != TCL_OK)) {
		errfile = target;
		goto done;
	    }
	    /* Forget about this sub-path */
	    Tcl_DecrRefCount(target);
	    target = NULL;
	}

	Tcl_DecrRefCount(split);
	split = NULL;

    }
	
    done:
    if (errfile != NULL) {
	Tcl_AppendResult(interp, "can't create directory \"",
		Tcl_GetString(errfile), "\": ", Tcl_PosixError(interp), 
		(char *) NULL);
	result = TCL_ERROR;
    }
    if (split != NULL) {
	Tcl_DecrRefCount(split);
    }


    if (target != NULL) {
	Tcl_DecrRefCount(target);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *

 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
TclFileDeleteCmd(interp, objc, objv)
    Tcl_Interp *interp;		/* Used for error reporting */
    int objc;			/* Number of arguments */
    Tcl_Obj *CONST objv[];	/* Argument strings passed to Tcl_FileCmd. */
{

    int i, force, result;
    Tcl_Obj *errfile;
    
    i = FileForceOption(interp, objc - 2, objv + 2, &force);
    if (i < 0) {
	return TCL_ERROR;
    }
    i += 2;
    if ((objc - i) < 1) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", 
		Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]), 
		" ?options? file ?file ...?\"", (char *) NULL);
	return TCL_ERROR;
    }

    errfile = NULL;
    result = TCL_OK;



    for ( ; i < objc; i++) {
	struct stat statBuf;


	errfile = objv[i];


	if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}

	/*
	 * Call lstat() to get info so can delete symbolic link itself.
	 */

	if (Tcl_FSLstat(objv[i], &statBuf) != 0) {
	    /*
	     * Trying to delete a file that does not exist is not
	     * considered an error, just a no-op
	     */

	    if (errno != ENOENT) {
		result = TCL_ERROR;
	    }
	} else if (S_ISDIR(statBuf.st_mode)) {
	    Tcl_Obj *errorBuffer = NULL;
	    result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer);
	    if (result != TCL_OK) {
		if ((force == 0) && (errno == EEXIST)) {
		    Tcl_AppendResult(interp, "error deleting \"", 
			    Tcl_GetString(objv[i]),
			    "\": directory not empty", (char *) NULL);
		    Tcl_PosixError(interp);
		    goto done;
		}

		/* 
		 * If possible, use the untranslated name for the file.
		 */
		 
		errfile = errorBuffer;
		/* FS supposed to check between translated objv and errfile */
		if (Tcl_FSEqualPaths(objv[i], errfile)) {
		    errfile = objv[i];
		}
	    }
	} else {
	    result = Tcl_FSDeleteFile(objv[i]);
	}
	
	if (result == TCL_ERROR) {
	    break;
	}
    }
    if (result != TCL_OK) {
	if (errfile == NULL) {
	    /* 
	     * We try to accomodate poor error results from our 
	     * Tcl_FS calls 
	     */
	    Tcl_AppendResult(interp, "error deleting unknown file: ", 
		    Tcl_PosixError(interp), (char *) NULL);
	} else {
	    Tcl_AppendResult(interp, "error deleting \"", 
		    Tcl_GetString(errfile), "\": ", 
		    Tcl_PosixError(interp), (char *) NULL);
	}
    } 
    done:


    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * CopyRenameOneFile

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

static int
CopyRenameOneFile(interp, source, target, copyFlag, force) 
    Tcl_Interp *interp;		/* Used for error reporting. */
    Tcl_Obj *source;		/* Pathname of file to copy.  May need to
				 * be translated. */
    Tcl_Obj *target;		/* Pathname of file to create/overwrite.
				 * May need to be translated. */
    int copyFlag;		/* If non-zero, copy files.  Otherwise,
				 * rename them. */
    int force;			/* If non-zero, overwrite target file if it
				 * exists.  Otherwise, error if target already
				 * exists. */
{
    int result;

    Tcl_Obj *errfile, *errorBuffer;
    struct stat sourceStatBuf, targetStatBuf;


    if (Tcl_FSConvertToPathType(interp, source) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {


	return TCL_ERROR;
    }
    
    errfile = NULL;
    errorBuffer = NULL;
    result = TCL_ERROR;

    
    /*
     * We want to copy/rename links and not the files they point to, so we
     * use lstat(). If target is a link, we also want to replace the 
     * link and not the file it points to, so we also use lstat() on the
     * target.
     */

    if (Tcl_FSLstat(source, &sourceStatBuf) != 0) {
	errfile = source;
	goto done;
    }
    if (Tcl_FSLstat(target, &targetStatBuf) != 0) {
	if (errno != ENOENT) {
	    errfile = target;
	    goto done;
	}
    } else {
	if (force == 0) {
	    errno = EEXIST;

	 * existing implementations of copy and rename on all platforms
	 * also prevent this.
	 */

	if (S_ISDIR(sourceStatBuf.st_mode)
                && !S_ISDIR(targetStatBuf.st_mode)) {
	    errno = EISDIR;
	    Tcl_AppendResult(interp, "can't overwrite file \"", 
		    Tcl_GetString(target), "\" with directory \"", 
		    Tcl_GetString(source), "\"", (char *) NULL);
	    goto done;
	}
	if (!S_ISDIR(sourceStatBuf.st_mode)
	        && S_ISDIR(targetStatBuf.st_mode)) {
	    errno = EISDIR;
	    Tcl_AppendResult(interp, "can't overwrite directory \"", 
		    Tcl_GetString(target), "\" with file \"", 
		    Tcl_GetString(source), "\"", (char *) NULL);
	    goto done;
	}
    }

    if (copyFlag == 0) {
	result = Tcl_FSRenameFile(source, target);
	if (result == TCL_OK) {
	    goto done;
	}
	    
	if (errno == EINVAL) {
	    Tcl_AppendResult(interp, "error renaming \"", 
		    Tcl_GetString(source), "\" to \"",
		    Tcl_GetString(target), "\": trying to rename a volume or ",
		    "move a directory into itself", (char *) NULL);
	    goto done;
	} else if (errno != EXDEV) {
	    errfile = target;
	    goto done;
	}
	
	/*
	 * The rename failed because the move was across file systems.
	 * Fall through to copy file and then remove original.  Note that
	 * the low-level TclpRenameFile is allowed to implement
	 * cross-filesystem moves itself.
	 */
    }

    if (S_ISDIR(sourceStatBuf.st_mode)) {
	result = Tcl_FSCopyDirectory(source, target, &errorBuffer);
	if (result != TCL_OK) {
	    if (errno == EXDEV) {
		/* 
		 * The copy failed because we're trying to do a
		 * cross-filesystem copy.  We do this through our Tcl
		 * library.
		 */
		Tcl_SavedResult savedResult;
		Tcl_Obj *copyCommand = Tcl_NewListObj(0,NULL);
		Tcl_IncrRefCount(copyCommand);
		Tcl_ListObjAppendElement(interp, copyCommand, 
			Tcl_NewStringObj("::tcl::CopyDirectory",-1));
		if (copyFlag) {
		    Tcl_ListObjAppendElement(interp, copyCommand, 
					     Tcl_NewStringObj("copying",-1));
		} else {
		    Tcl_ListObjAppendElement(interp, copyCommand, 
					     Tcl_NewStringObj("renaming",-1));
		}
		Tcl_ListObjAppendElement(interp, copyCommand, source);
		Tcl_ListObjAppendElement(interp, copyCommand, target);
		Tcl_SaveResult(interp, &savedResult);
		result = Tcl_EvalObjEx(interp, copyCommand, 
				       TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
		Tcl_DecrRefCount(copyCommand);
		if (result != TCL_OK) {
		    /* 
		     * There was an error in the Tcl-level copy.
		     * We will pass on the Tcl error message and
		     * can ensure this by setting errfile to NULL
		     */
		    Tcl_DiscardResult(&savedResult);
		    errfile = NULL;
		} else {
		    /* The copy was successful */
		    Tcl_RestoreResult(interp, &savedResult);
		}
	    } else {
		errfile = errorBuffer;
		if (Tcl_FSEqualPaths(errfile, source)) {
		    errfile = source;
		} else if (Tcl_FSEqualPaths(errfile, target)) {
		    errfile = target;
		}
	    }
	}
    } else {
	result = Tcl_FSCopyFile(source, target);
	if ((result != TCL_OK) && (errno == EXDEV)) {
	    /*
	     * Well, there really shouldn't be a problem with source,
	     * because up there we checked to see if it was ok to copy it.

	     * 
	     * Either there is a problem with target, or we're trying
	     * to do a cross-filesystem copy.  We open the target for
	     * writing to decide between those two cases.
	     */
	    int prot = 0666;
	    Tcl_Channel out = Tcl_FSOpenFileChannel(interp, target, "w", prot);
	    if (out == NULL) {
		/* There was a problem with the target */
	        errfile = target;
	    } else {
		/* It looks like we can copy it over */
		Tcl_Channel in = Tcl_FSOpenFileChannel(interp, source, 
						     "r", prot);
		if (in == NULL) {
		    /* This is very strange, we checked this above */
		    Tcl_Close(interp, out);
		    errfile = source;
		} else {
		    struct utimbuf tval;
		    /* 
		     * Copy it synchronously.  We might wish to add an
		     * asynchronous option to support vfs's which are
		     * slow (e.g. network sockets).
		     */
		    Tcl_SetChannelOption(interp, in, "-translation", "binary");
		    Tcl_SetChannelOption(interp, out, "-translation", "binary");
		    
		    if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
			result = TCL_OK;
		    }
		    /* 
		     * If the copy failed, assume that copy channel left
		     * a good error message.
		     */
		    Tcl_Close(interp, in);
		    Tcl_Close(interp, out);
		    /* Set modification date of copied file */
		    tval.actime = sourceStatBuf.st_atime;
		    tval.modtime = sourceStatBuf.st_mtime;
		    Tcl_FSUtime(source, &tval);
		}
	    }
	}
    }
    if ((copyFlag == 0) && (result == TCL_OK)) {
	if (S_ISDIR(sourceStatBuf.st_mode)) {
	    result = Tcl_FSRemoveDirectory(source, 1, &errorBuffer);
	    if (result != TCL_OK) {

		if (Tcl_FSEqualPaths(errfile, source) == 0) {
		    errfile = source;
		}
	    }
	} else {
	    result = Tcl_FSDeleteFile(source);
	    if (result != TCL_OK) {
		errfile = source;
	    }
	}
	if (result != TCL_OK) {
	    Tcl_AppendResult(interp, "can't unlink \"", 
		Tcl_GetString(errfile), "\": ",
		Tcl_PosixError(interp), (char *) NULL);
	    errfile = NULL;
	}
    }
    
    done:
    if (errfile != NULL) {
	Tcl_AppendResult(interp, 
		((copyFlag) ? "error copying \"" : "error renaming \""),
		 Tcl_GetString(source), (char *) NULL);
	if (errfile != source) {
	    Tcl_AppendResult(interp, "\" to \"", Tcl_GetString(target), 
			     (char *) NULL);
	    if (errfile != target) {
		Tcl_AppendResult(interp, "\": \"", Tcl_GetString(errfile), 
				 (char *) NULL);
	    }
	}
	Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp),
		(char *) NULL);
    }
    if (errorBuffer != NULL) {
        Tcl_DecrRefCount(errorBuffer);

    }
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * FileForceOption --

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

static int
FileForceOption(interp, objc, objv, forcePtr)
    Tcl_Interp *interp;		/* Interp, for error return. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument strings.  First command line
				 * option, if it exists, begins at 0. */
    int *forcePtr;		/* If the "-force" was specified, *forcePtr
				 * is filled with 1, otherwise with 0. */
{
    int force, i;
    
    force = 0;
    for (i = 0; i < objc; i++) {
	if (Tcl_GetString(objv[i])[0] != '-') {
	    break;
	}
	if (strcmp(Tcl_GetString(objv[i]), "-force") == 0) {
	    force = 1;
	} else if (strcmp(Tcl_GetString(objv[i]), "--") == 0) {
	    i++;
	    break;
	} else {
	    Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[i]), 
		    "\": should be -force or --", (char *)NULL);
	    return -1;
	}
    }
    *forcePtr = force;
    return i;
}

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

static Tcl_Obj *
FileBasename(interp, pathPtr)
    Tcl_Interp *interp;		/* Interp, for error return. */
    Tcl_Obj *pathPtr;		/* Path whose basename to extract. */


{
    int objc;
    Tcl_Obj *split;
    Tcl_Obj *resPtr = NULL;
    
    split = Tcl_FSSplitPath(pathPtr, &objc);

    if (objc != 0) {


	if ((objc == 1) && (*Tcl_GetString(pathPtr) == '~')) {

	    

	    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {

		Tcl_DecrRefCount(split);
		return NULL;
	    }
	    Tcl_DecrRefCount(split);
	    split = Tcl_FSSplitPath(pathPtr, &objc);

	}


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

	if (objc > 0) {
	    if (objc > 1) {
		Tcl_ListObjIndex(NULL, split, objc-1, &resPtr);
	    } else {
		Tcl_Obj *temp;
		Tcl_ListObjIndex(NULL, split, 0, &temp);
		if (Tcl_GetPathType(Tcl_GetString(temp)) == TCL_PATH_RELATIVE) {

		    Tcl_ListObjIndex(NULL, split, objc-1, &resPtr);
		}
	    }
	}
    }
    if (resPtr == NULL) {
	resPtr = Tcl_NewStringObj("",0);
    }
    Tcl_IncrRefCount(resPtr);
    Tcl_DecrRefCount(split);
    return resPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFileAttrsCmd --
 *
 *      Sets or gets the platform-specific attributes of a file.  The
 *      objc-objv points to the file name with the rest of the command
 *      line following.  This routine uses platform-specific tables of
 *      option strings and callbacks.  The callback to get the
 *      attributes take three parameters:
 *	    Tcl_Interp *interp;	    The interp to report errors with.
 *				    Since this is an object-based API,
 *				    the object form of the result should 
 *				    be used.
 *	    CONST char *fileName;   This is extracted using
 *				    Tcl_TranslateFileName.
 *	    TclObj **attrObjPtrPtr; A new object to hold the attribute
 *				    is allocated and put here.
 *	The first two parameters of the callback used to write out the
 *	attributes are the same. The third parameter is:
 *	    CONST *attrObjPtr;	    A pointer to the object that has

int
TclFileAttrsCmd(interp, objc, objv)
    Tcl_Interp *interp;		/* The interpreter for error reporting. */
    int objc;			/* Number of command line arguments. */
    Tcl_Obj *CONST objv[];	/* The command line objects. */
{

    int result;
    char ** attributeStrings;
    Tcl_Obj* objStrings = NULL;
    int numObjStrings = -1;
    Tcl_Obj *filePtr;
    
    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 2, objv,
		"name ?option? ?value? ?option value ...?");
	return TCL_ERROR;
    }

    filePtr = objv[2];
    if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) {

    	return TCL_ERROR;
    }
    
    objc -= 3;
    objv += 3;
    result = TCL_ERROR;
    attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings);
    if (attributeStrings == NULL) {
	int index;
	Tcl_Obj *objPtr;
	if (objStrings == NULL) {
	    goto end;
	}
	/* We own the object now */
	Tcl_IncrRefCount(objStrings);
        /* Use objStrings as a list object */
	if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
	    goto end;
	}
	attributeStrings = (char**)ckalloc((1+numObjStrings)*sizeof(char*));
	for (index = 0; index < numObjStrings; index++) {
	    Tcl_ListObjIndex(interp, objStrings, index, &objPtr);
	    attributeStrings[index] = Tcl_GetString(objPtr);
	}
	attributeStrings[index] = NULL;
    }
    if (objc == 0) {
	/*
	 * Get all attributes.
	 */

	int index;
	Tcl_Obj *listPtr;
	 
	listPtr = Tcl_NewListObj(0, NULL);
	for (index = 0; attributeStrings[index] != NULL; index++) {
	    Tcl_Obj *objPtr = Tcl_NewStringObj(attributeStrings[index], -1);
	    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
	    /* We now forget about objPtr, it is in the list */
	    objPtr = NULL;
	    if (Tcl_FSFileAttrsGet(interp, index, filePtr,
		    &objPtr) != TCL_OK) {
		Tcl_DecrRefCount(listPtr);
		goto end;
	    }
	    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
	}
    	Tcl_SetObjResult(interp, listPtr);
    } else if (objc == 1) {
	/*
	 * Get one attribute.
	 */

	int index;
	Tcl_Obj *objPtr = NULL;

	if (numObjStrings == 0) {
	    Tcl_AppendResult(interp, "bad option \"",
		    Tcl_GetString(objv[0]), "\", there are no file attributes"
			     " in this filesystem.", (char *) NULL);
	    goto end;
	}

	if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings,
		"option", 0, &index) != TCL_OK) {
	    goto end;
	}
	if (Tcl_FSFileAttrsGet(interp, index, filePtr,
		&objPtr) != TCL_OK) {
	    goto end;
	}
	Tcl_SetObjResult(interp, objPtr);
    } else {
	/*
	 * Set option/value pairs.
	 */

	int i, index;
        
	if (numObjStrings == 0) {
	    Tcl_AppendResult(interp, "bad option \"",
		    Tcl_GetString(objv[0]), "\", there are no file attributes"
			     " in this filesystem.", (char *) NULL);
	    goto end;
	}

    	for (i = 0; i < objc ; i += 2) {
    	    if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
		    "option", 0, &index) != TCL_OK) {
		goto end;
    	    }
	    if (i + 1 == objc) {
		Tcl_AppendResult(interp, "value for \"",
			Tcl_GetString(objv[i]), "\" missing",
			(char *) NULL);
		goto end;
	    }
    	    if (Tcl_FSFileAttrsSet(interp, index, filePtr,
    	    	    objv[i + 1]) != TCL_OK) {
		goto end;
    	    }
    	}
    }
    result = TCL_OK;

    end:
    if (numObjStrings != -1) {
	/* Free up the array we allocated */
	ckfree((char*)attributeStrings);
	/* 
	 * We don't need this object that was passed to us
	 * any more.
	 */
	if (objStrings != NULL) {
	    Tcl_DecrRefCount(objStrings);
	}
    }
    return result;
}

/* 
 * 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.15 2001/07/31 19:12:06 vincentdarley Exp $
 */

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

/*

/*
 * The following variable is set in the TclPlatformInit call to one
 * of: TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, or TCL_PLATFORM_WINDOWS.
 */

TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;










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

static 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 void		FileNameCleanup _ANSI_ARGS_((ClientData clientData));
static void		FileNameInit _ANSI_ARGS_((void));
static int		SkipToChar _ANSI_ARGS_((char **stringPtr,
			    char *match));
static char *		SplitMacPath _ANSI_ARGS_((CONST char *path,
			    Tcl_DString *bufPtr));
static char *		SplitWinPath _ANSI_ARGS_((CONST char *path,

		(VOID)ExtractWinRoot(path, &ds, 0, &type);
		Tcl_DStringFree(&ds);
	    }
	    break;
    }
    return type;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSSplitPath --
 *
 *      This function takes the given Tcl_Obj, which should be a valid
 *      path, and returns a Tcl List object containing each segment
 *      of that path as an element.
 *
 *      Note this function currently calls the older Tcl_SplitPath
 *      routine, which therefore requires more memory allocation and
 *      deallocation than necessary.  We could easily rewrite this for
 *      greater efficiency.
 *      
 * Results:
 *      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 list.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj* 
Tcl_FSSplitPath(Tcl_Obj* pathPtr, int *lenPtr) {
    int argc, i;
    char** argv;
    Tcl_Obj* res;
    
    Tcl_SplitPath(Tcl_GetString(pathPtr),&argc,&argv);
    if (lenPtr != NULL) {
	*lenPtr = argc;
    }
    res = Tcl_NewListObj(0,NULL);
    for (i=0;i<argc;i++) {
	Tcl_ListObjAppendElement(NULL, res, Tcl_NewStringObj(argv[i],-1));
    }
    ckfree((char*)argv);
    return res;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SplitPath --
 *
 *	Split a path into a list of path components.  The first element

	    if (*p++ == '\0') {
		break;
	    }
	}
    }
    return Tcl_DStringValue(bufPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * 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.
 *
 * Results:
 *      Returns object with refCount of zero
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj* 
Tcl_FSJoinToPath(basePtr, objc, objv)
    Tcl_Obj *basePtr;
    int objc;
    Tcl_Obj *CONST objv[];
{
    int i;
    Tcl_Obj *lobj, *ret;

    if (basePtr == NULL) {
	lobj = Tcl_NewListObj(0,NULL);
    } else {
	lobj = Tcl_NewListObj(1,&basePtr);
    }
    
    for (i = 0; i<objc;i++) {
	Tcl_ListObjAppendElement(NULL, lobj, objv[i]);
    }
    ret = Tcl_FSJoinPath(lobj,-1);
    Tcl_DecrRefCount(lobj);
    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.
 *      
 *      Note this function currently calls the older Tcl_JoinPath
 *      routine, which therefore requires more memory allocation and
 *      deallocation than necessary.  We could easily rewrite this for
 *      greater efficiency.
 *
 * Results:
 *      Returns object with refCount of zero.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj* 
Tcl_FSJoinPath(listObj, elements)
    Tcl_Obj *listObj;
    int elements;
{
    char ** argv;
    int count;
    Tcl_DString ds;
    Tcl_Obj *res;
    if (elements < 0) {
	if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) {
	    return NULL;
	}
    } else {
	/* Just make sure it is a valid list */
	int listTest;
	if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) {
	    return NULL;
	}
	/* 
	 * It doesn't actually matter if 'elements' is greater
	 * than the actual number of elements. 
	 */
    }
    argv = (char **)ckalloc(elements*sizeof(char*));
    
    for (count = 0; count < elements; count++) {
	Tcl_Obj* elt;
	Tcl_ListObjIndex(NULL, listObj,count,&elt);
	argv[count] = Tcl_GetString(elt);
    }
    Tcl_DStringInit(&ds);
    res = Tcl_NewStringObj(Tcl_JoinPath(elements, argv, &ds),-1);
    Tcl_DStringFree(&ds);
    ckfree((char*)argv);
    return res;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_JoinPath --
 *
 *	Combine a list of paths in a platform specific manner.

    char *name;			/* File name, which may begin with "~" (to
				 * indicate current user's home directory) or
				 * "~<user>" (to indicate any user's home
				 * directory). */
    Tcl_DString *bufferPtr;	/* Uninitialized or free DString filled
				 * with name after tilde substitution. */
{


    /*
     * Handle tilde substitutions, if needed.
     */

    if (name[0] == '~') {
	int argc, length;
	char **argv;
	Tcl_DString temp;

	Tcl_SplitPath(name, &argc, (char ***) &argv);
	

	argv[0] = DoTildeSubst(interp, argv[0]+1, &temp);
	if (argv[0] == NULL) {
	    Tcl_DStringFree(&temp);
	    ckfree((char *)argv);
	    return NULL;
	}
	Tcl_DStringInit(bufferPtr);
	Tcl_JoinPath(argc, argv, bufferPtr);
	Tcl_DStringFree(&temp);
	ckfree((char*)argv);
    } else {
	Tcl_DStringInit(bufferPtr);
	Tcl_JoinPath(1, &name, bufferPtr);
    }

    /*
     * Convert forward slashes to backslashes in Windows paths because
     * some system interfaces don't accept forward slashes.
     */

    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
	register char *p;
	for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
	    if (*p == '/') {
		*p = '\\';
	    }
	}
    }
    return Tcl_DStringValue(bufferPtr);

int
Tcl_GlobObjCmd(dummy, interp, objc, objv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    int index, i, globFlags, length, join, dir, result;
    char *string, *separators;
    Tcl_Obj *typePtr, *resultPtr, *look;
    Tcl_Obj *pathOrDir = NULL;
    Tcl_DString prefix;
    static char *options[] = {
	"-directory", "-join", "-nocomplain", "-path", "-tails", 
	"-types", "--", NULL
    };
    enum options {
	GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS, 
	GLOB_TYPE, GLOB_LAST
    };
    enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1};
    Tcl_GlobTypeData *globTypes = NULL;

    globFlags = 0;
    join = 0;
    dir = PATH_NONE;

    typePtr = NULL;
    resultPtr = Tcl_GetObjResult(interp);
    for (i = 1; i < objc; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
		!= TCL_OK) {
	    string = Tcl_GetStringFromObj(objv[i], &length);
	    if (string[0] == '-') {

		 */
		Tcl_ResetResult(interp);
		break;
	    }
	}
	switch (index) {
	    case GLOB_NOCOMPLAIN:			/* -nocomplain */
	        globFlags |= TCL_GLOBMODE_NO_COMPLAIN;
		break;
	    case GLOB_DIR:				/* -dir */
		if (i == (objc-1)) {
		    Tcl_AppendToObj(resultPtr,
			    "missing argument to \"-directory\"", -1);
		    return TCL_ERROR;
		}
		if (dir != PATH_NONE) {
		    Tcl_AppendToObj(resultPtr,
			    "\"-directory\" cannot be used with \"-path\"",
			    -1);
		    return TCL_ERROR;
		}
		dir = PATH_DIR;
		globFlags |= TCL_GLOBMODE_DIR;
		pathOrDir = objv[i+1];
		i++;
		break;
	    case GLOB_JOIN:				/* -join */
		join = 1;
		break;
	    case GLOB_TAILS:				/* -tails */
	        globFlags |= TCL_GLOBMODE_TAILS;
		break;
	    case GLOB_PATH:				/* -path */
	        if (i == (objc-1)) {
		    Tcl_AppendToObj(resultPtr,
			    "missing argument to \"-path\"", -1);
		    return TCL_ERROR;
		}
		if (dir != PATH_NONE) {
		    Tcl_AppendToObj(resultPtr,
			    "\"-path\" cannot be used with \"-directory\"",
			    -1);
		    return TCL_ERROR;
		}
		dir = PATH_GENERAL;
		pathOrDir = objv[i+1];
		i++;
		break;
	    case GLOB_TYPE:				/* -types */
	        if (i == (objc-1)) {
		    Tcl_AppendToObj(resultPtr,
			    "missing argument to \"-types\"", -1);
		    return TCL_ERROR;

	}
    }
    endOfForLoop:
    if (objc - i < 1) {
        Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?");
	return TCL_ERROR;
    }
    if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
	Tcl_AppendToObj(resultPtr,
	  "\"-tails\" must be used with either \"-directory\" or \"-path\"",
	  -1);
	return TCL_ERROR;
    }
    
    separators = NULL;		/* lint. */
    switch (tclPlatform) {
	case TCL_PLATFORM_UNIX:
	    separators = "/";
	    break;
	case TCL_PLATFORM_WINDOWS:
	    separators = "/\\:";
	    break;
	case TCL_PLATFORM_MAC:
	    separators = ":";
	    break;
    }
    if (dir == PATH_GENERAL) {
	int pathlength;
	char *last;
	char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);

	/*
	 * Find the last path separator in the path
	 */
	last = first + pathlength;
	for (; last != first; last--) {
	    if (strchr(separators, *(last-1)) != NULL) {
		break;
	    }
	}
	if (last == first + pathlength) {
	    /* 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 */
		Tcl_DStringAppend(&pref, first, -1);
		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' */
	    Tcl_DStringInit(&prefix);
	    search = Tcl_DStringValue(&pref);
	    while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) {
	        Tcl_DStringAppend(&prefix, search, find-search);
	        Tcl_DStringAppend(&prefix, "\\", 1);
	        Tcl_DStringAppend(&prefix, find, 1);
	        search = find+1;
	        if (*search == '\0') {
	            break;
	        }
	    }
	    if (*search != '\0') {
		Tcl_DStringAppend(&prefix, search, -1);
	    }
	    Tcl_DStringFree(&pref);
	}
    }
    
    if (typePtr != NULL) {
	/* 
	 * The rest of the possible type arguments (except 'd') are
	 * platform specific.  We don't complain when they are used
	 * on an incompatible platform.
	 */
	Tcl_ListObjLength(interp, typePtr, &length);
	globTypes = (Tcl_GlobTypeData*) ckalloc(sizeof(Tcl_GlobTypeData));
	globTypes->type = 0;
	globTypes->perm = 0;
	globTypes->macType = NULL;
	globTypes->macCreator = NULL;
	while(--length >= 0) {
	    int len;
	    char *str;

		badTypesArg:
		Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
		Tcl_AppendObjToObj(resultPtr, look);
		result = TCL_ERROR;
		goto endOfGlob;
		badMacTypesArg:
		Tcl_AppendToObj(resultPtr,
		   "only one MacOS type or creator argument"
		   " to \"-types\" allowed", -1);
		result = TCL_ERROR;
		goto endOfGlob;
	    }
	}
    }

    if (pathOrDir != NULL) {
        Tcl_IncrRefCount(pathOrDir);
    }
    
    /* 
     * Now we perform the actual glob below.  This may involve joining
     * together the pattern arguments, dealing with particular file types
     * etc.  We use a 'goto' to ensure we free any memory allocated along
     * the way.
     */
    objc -= i;

			globFlags, globTypes) != TCL_OK) {
		    result = TCL_ERROR;
		    goto endOfGlob;
		}
	    }
	}
    }
    if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) {
	if (Tcl_ListObjLength(interp, Tcl_GetObjResult(interp),
		&length) != TCL_OK) {
	    /* This should never happen.  Maybe we should be more dramatic */
	    result = TCL_ERROR;
	    goto endOfGlob;
	}
	if (length == 0) {

	    Tcl_AppendResult(interp, "\"", (char *) NULL);
	    result = TCL_ERROR;
	}
    }
  endOfGlob:
    if (join || (dir == PATH_GENERAL)) {
	Tcl_DStringFree(&prefix);


    }
    if (pathOrDir != NULL) {
	Tcl_DecrRefCount(pathOrDir);
    }
    if (globTypes != NULL) {
	if (globTypes->macType != NULL) {
	    Tcl_DecrRefCount(globTypes->macType);
	}
	if (globTypes->macCreator != NULL) {
	    Tcl_DecrRefCount(globTypes->macCreator);

 *	It sets the separator string based on the platform, performs
 *      tilde substitution, and calls TclDoGlob.
 *
 * 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 TclDoGlob) holds all of the file names
 *	given by the pattern and unquotedPrefix arguments.  After an 
 *	error the result in interp will hold an error message.
 *
 * Side effects:
 *	The 'pattern' is written to.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
TclGlob(interp, pattern, unquotedPrefix, 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 *unquotedPrefix;	/* 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;
    char *head, *tail, *start;
    char c;
    int result, prefixLen;
    Tcl_DString buffer;

    separators = NULL;		/* lint. */
    switch (tclPlatform) {
	case TCL_PLATFORM_UNIX:
	    separators = "/";
	    break;

		separators = ":";
	    }
	    break;
    }

    Tcl_DStringInit(&buffer);
    if (unquotedPrefix != NULL) {
	start = Tcl_GetString(unquotedPrefix);
    } else {
	start = pattern;
    }

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

		}
	    } else if (strchr(separators, *tail) != NULL) {
		break;
	    }
	}

	/*
	 * Determine the home directory for the specified user.  

	 */
	
	c = *tail;
	*tail = '\0';






	head = DoTildeSubst(interp, start+1, &buffer);













	*tail = c;
	if (head == NULL) {
	    if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
		/*
		 * We should in fact pass down the nocomplain flag 
		 * or save the interp result or use another mechanism
		 * so the interp result is not mangled on errors in that case.
		 * but that would a bigger change than reasonable for a patch
		 * release.
		 * (see fileName.test 15.2-15.4 for expected behaviour)

	if (unquotedPrefix != NULL) {
	    Tcl_DStringAppend(&buffer, tail, -1);
	    tail = pattern;
	}
    } else {
	tail = pattern;
	if (unquotedPrefix != NULL) {
	    Tcl_DStringAppend(&buffer,Tcl_GetString(unquotedPrefix),-1);
	}
    }
    
    /* 
     * We want to remember the length of the current prefix,
     * in case we are using TCL_GLOBMODE_TAILS.  Also if we
     * are using TCL_GLOBMODE_DIR, we must make sure the
     * prefix ends in a directory separator.

     */
    prefixLen = Tcl_DStringLength(&buffer);

    if (prefixLen > 0) {
	c = Tcl_DStringValue(&buffer)[prefixLen-1];
	if (strchr(separators, c) == NULL) {
	    /* 
	     * If the prefix is a directory, make sure it ends in a
	     * directory separator.
	     */
	    if (globFlags & TCL_GLOBMODE_DIR) {
		Tcl_DStringAppend(&buffer,separators,1);
	    }
	    prefixLen++;
	}
    }

    result = TclDoGlob(interp, separators, &buffer, tail, types);
    Tcl_DStringFree(&buffer);
    
    if (result != TCL_OK) {
	if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
	    Tcl_ResetResult(interp);
	    return TCL_OK;
	}
    } else {
	/* 
	 * 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
	 * TclDoGlob, 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.
	 */
	if (globFlags & TCL_GLOBMODE_TAILS) {
	    int objc, i;
	    Tcl_Obj **objv;
	    Tcl_Obj *tailResult;
	    Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), 
				   &objc, &objv);
	    tailResult = Tcl_NewListObj(0,NULL);
	    for (i = 0; i< objc; i++) {
		int len;
		char *oldStr = Tcl_GetStringFromObj(objv[i],&len);
		Tcl_Obj* str;
		if (len == prefixLen) {
		    if ((pattern[0] == '\0')
			|| (strchr(separators, pattern[0]) == NULL)) {
			str = Tcl_NewStringObj(".",1);
		    } else {
			str = Tcl_NewStringObj("/",1);
		    }
		} else {
		    str = Tcl_NewStringObj(oldStr + prefixLen, 
						len - prefixLen);
		}
		Tcl_ListObjAppendElement(interp, tailResult, str);
	    }
	    Tcl_SetObjResult(interp, tailResult);
	}
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *

				 * (e.g. unmatched brace). */
    char *separators;		/* String containing separator characters
				 * that should be used to identify globbing
				 * boundaries. */
    Tcl_DString *headPtr;	/* Completely expanded prefix. */
    char *tail;			/* The unexpanded remainder of the path.
				 * 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, savedChar;
    char lastChar = 0;
    
    int length = Tcl_DStringLength(headPtr);

	    p++;
	    element = p;
	    SkipToChar(&p, ",");
	    Tcl_DStringSetLength(headPtr, length);
	    Tcl_DStringSetLength(&newName, baseLength);
	    Tcl_DStringAppend(&newName, element, p-element);
	    Tcl_DStringAppend(&newName, closeBrace+1, -1);
	    result = TclDoGlob(interp, separators, headPtr, 
			       Tcl_DStringValue(&newName), types);
	    if (result != TCL_OK) {
		break;
	    }
	}
	*closeBrace = '}';
	Tcl_DStringFree(&newName);
	return result;

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

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

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

    if (firstSpecialChar != NULL) {
	int ret;
	Tcl_Obj *head = Tcl_NewStringObj(Tcl_DStringValue(headPtr),-1);
	Tcl_IncrRefCount(head);
	/*
	 * Look for matching files in the given directory.  The
	 * implementation of this function is platform 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), 
					 head, tail, 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, 
					 head, tail, &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_DString ds;
			Tcl_ListObjIndex(interp, resultPtr, i, &elt);
			Tcl_DStringInit(&ds);
			Tcl_DStringAppend(&ds, Tcl_GetString(elt), -1);
			if(tclPlatform == TCL_PLATFORM_MAC) {
			Tcl_DStringAppend(&ds, ":",1);
			} else {			
			Tcl_DStringAppend(&ds, "/",1);
			}
			ret = TclDoGlob(interp, separators, &ds, p+1, types);
			Tcl_DStringFree(&ds);
			if (ret != TCL_OK) {
			    break;
			}
		    }
		}
	    }
	    Tcl_DecrRefCount(resultPtr);
	}
	Tcl_DecrRefCount(head);
	return ret;
    }
    Tcl_DStringAppend(headPtr, tail, p-tail);
    if (*p != '\0') {
	return TclDoGlob(interp, separators, headPtr, p, types);
    }

    /*
     * There are no more wildcards in the pattern and no more unprocessed
     * characters in the tail, so now we can construct the path and verify
     * the existence of the file.
     */

    switch (tclPlatform) {
	case TCL_PLATFORM_MAC: {
	    if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) {
		Tcl_DStringAppend(headPtr, ":", 1);
	    }
	    name = Tcl_DStringValue(headPtr);
	    if (Tcl_Access(name, F_OK) == 0) {
		if ((name[1] != '\0') && (strchr(name+1, ':') == NULL)) {
		    Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), 
					     Tcl_NewStringObj(name + 1,-1));
		} else {
		    Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), 
					     Tcl_NewStringObj(name,-1));
		}
	    }
	    break;
	}
	case TCL_PLATFORM_WINDOWS: {
	    int exists;
	    
	    /*
	     * We need to convert slashes to backslashes before checking
	     * for the existence of the file.  Once we are done, we need
	     * to convert the slashes back.
	     * 
	     * This backslash/forward slash conversion may no longer
	     * be necessary, since we have dropped Win3.1 support.
	     */

	    if (Tcl_DStringLength(headPtr) == 0) {
		if (((*name == '\\') && (name[1] == '/' || name[1] == '\\'))
			|| (*name == '/')) {
		    Tcl_DStringAppend(headPtr, "\\", 1);
		} else {
		    Tcl_DStringAppend(headPtr, ".", 1);
		}
	    } else {
		for (p = Tcl_DStringValue(headPtr); *p != '\0'; p++) {
		    if (*p == '/') {
			*p = '\\';
		    }
		}
	    }
	    name = Tcl_DStringValue(headPtr);
	    exists = (Tcl_Access(name, F_OK) == 0);

	    for (p = name; *p != '\0'; p++) {
		if (*p == '\\') {
		    *p = '/';
		}
	    }
	    if (exists) {

		if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
		    Tcl_DStringAppend(headPtr, "/", 1);
		} else {
		    Tcl_DStringAppend(headPtr, ".", 1);
		}
	    }
	    name = Tcl_DStringValue(headPtr);
	    if (Tcl_Access(name, F_OK) == 0) {
		Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), 
					 Tcl_NewStringObj(name,-1));
	    }
	    break;
	}
    }

    return TCL_OK;
}

/* 
 * tclGetDate.y --
 *
 *	Contains yacc grammar for parsing date and time strings.
 *	The output of this file should be the file tclDate.c which
 *	is used directly in the Tcl sources.
 *
 * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995-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: tclGetDate.y,v 1.17 2001/07/31 19:12:06 vincentdarley Exp $
 */

%{
/* 
 * tclDate.c --
 *
 *	This file is generated from a yacc grammar defined in

 *
 * SCCSID
 */

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

#if defined(MAC_TCL) && !defined(TCL_MAC_USE_MSL_EPOCH)
#   define EPOCH           1904
#   define START_OF_TIME   1904
#   define END_OF_TIME     2039
#else
#   define EPOCH           1970
#   define START_OF_TIME   1902
#   define END_OF_TIME     2037

/* 
 * tclIO.c --
 *
 *	This file provides the generic portions (those that are the same on
 *	all platforms and for all channel types) of Tcl's IO facilities.
 *
 * Copyright (c) 1998-2000 Ajuba Solutions
 * Copyright (c) 1995-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: tclIO.c,v 1.33 2001/07/31 19:12:06 vincentdarley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclIO.h"
#include <assert.h>

static void		CreateScriptRecord _ANSI_ARGS_((
				Tcl_Interp *interp, Channel *chanPtr,
				int mask, Tcl_Obj *scriptPtr));
static void		DeleteChannelTable _ANSI_ARGS_((
				ClientData clientData, Tcl_Interp *interp));
static void		DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
				Channel *chanPtr, int mask));
static int              DetachChannel _ANSI_ARGS_((Tcl_Interp *interp,
				Tcl_Channel chan));
static void		DiscardInputQueued _ANSI_ARGS_((ChannelState *statePtr,
				int discardSavedBuffers));
static void		DiscardOutputQueued _ANSI_ARGS_((
				ChannelState *chanPtr));
static int		DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
				int slen));
static int		DoWrite _ANSI_ARGS_((Channel *chanPtr, char *src,

        }
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IsStandardChannel --
 *
 *	Test if the given channel is a standard channel.  No attempt
 *	is made to check if the channel or the standard channels
 *	are initialized or otherwise valid.
 *
 * Results:
 *	Returns 1 if true, 0 if false.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
int 
Tcl_IsStandardChannel(chan)
    Tcl_Channel chan;		/* Channel to check. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if ((chan == tsdPtr->stdinChannel) 
	|| (chan == tsdPtr->stdoutChannel)
	|| (chan == tsdPtr->stderrChannel)) {
	return 1;
    } else {
	return 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_RegisterChannel --
 *
 *	Adds an already-open channel to the channel table of an interpreter.
 *	If the interpreter passed as argument is NULL, it only increments
 *	the channel refCount.
 *
 * Results:

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UnregisterChannel --
 *
 *	Deletes the hash entry for a channel associated with an interpreter.
 *	If the interpreter given as argument is NULL, it only decrements the
 *	reference count.  (This all happens in the Tcl_DetachChannel helper
 *	function).
 *	
 *	Finally, if the reference count of the channel drops to zero,
 *	it is deleted.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Calls Tcl_DetachChannel which deletes the hash entry for a channel 
 *	associated with an interpreter.
 *	
 *	May delete the channel, which can have a variety of consequences,
 *	especially if we are forced to close the channel.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UnregisterChannel(interp, chan)
    Tcl_Interp *interp;		/* Interpreter in which channel is defined. */
    Tcl_Channel chan;		/* Channel to delete. */
{



    ChannelState *statePtr;	/* State of the real channel. */








    if (DetachChannel(interp, chan) != TCL_OK) {



        return TCL_OK;
    }



    




    statePtr = ((Channel *) chan)->state->bottomChanPtr->state;













    /*
     * Perform special handling for standard channels being closed. If the
     * refCount is now 1 it means that the last reference to the standard
     * channel is being explicitly closed, so bump the refCount down
     * artificially to 0. This will ensure that the channel is actually
     * closed, below. Also set the static pointer to NULL for the channel.
     */

         */

        if ((statePtr->curOutPtr != NULL) &&
                (statePtr->curOutPtr->nextAdded >
                        statePtr->curOutPtr->nextRemoved)) {
            statePtr->flags |= BUFFER_READY;
        }
	Tcl_Preserve((ClientData)statePtr);
        if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
	    /* We don't want to re-enter Tcl_Close */
	    if (!(statePtr->flags & CHANNEL_CLOSED)) {
		if (Tcl_Close(interp, chan) != TCL_OK) {
		    statePtr->flags |= CHANNEL_CLOSED;
		    Tcl_Release((ClientData)statePtr);
		    return TCL_ERROR;
		}
	    }
        }
        statePtr->flags |= CHANNEL_CLOSED;
	Tcl_Release((ClientData)statePtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DetachChannel --
 *
 *	Deletes the hash entry for a channel associated with an interpreter.
 *	If the interpreter given as argument is NULL, it only decrements the
 *	reference count.  Even if the ref count drops to zero, the 
 *	channel is NOT closed or cleaned up.  This allows a channel to
 *	be detached from an interpreter and left in the same state it
 *	was in when it was originally returned by 'Tcl_OpenFileChannel',
 *	for example.
 *	
 *	This function cannot be used on the standard channels, and
 *	will return TCL_ERROR if that is attempted.
 *	
 *	This function should only be necessary for special purposes
 *	in which you need to generate a pristine channel from one
 *	that has already been used.  All ordinary purposes will almost
 *	always want to use Tcl_UnregisterChannel instead.
 *
 * Results:
 *	A standard Tcl result.  If the channel is not currently registered
 *	with the given interpreter, TCL_ERROR is returned, otherwise
 *	TCL_OK.  However no error messages are left in the interp's result.
 *
 * Side effects:
 *	Deletes the hash entry for a channel associated with an 
 *	interpreter.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_DetachChannel(interp, chan)
    Tcl_Interp *interp;		/* Interpreter in which channel is defined. */
    Tcl_Channel chan;		/* Channel to delete. */
{
    if (Tcl_IsStandardChannel(chan)) {
        return TCL_ERROR;
    }
    
    return DetachChannel(interp, chan);
}

/*
 *----------------------------------------------------------------------
 *
 * DetachChannel --
 *
 *	Deletes the hash entry for a channel associated with an interpreter.
 *	If the interpreter given as argument is NULL, it only decrements the
 *	reference count.  Even if the ref count drops to zero, the 
 *	channel is NOT closed or cleaned up.  This allows a channel to
 *	be detached from an interpreter and left in the same state it
 *	was in when it was originally returned by 'Tcl_OpenFileChannel',
 *	for example.
 *
 * Results:
 *	A standard Tcl result.  If the channel is not currently registered
 *	with the given interpreter, TCL_ERROR is returned, otherwise
 *	TCL_OK.  However no error messages are left in the interp's result.
 *
 * Side effects:
 *	Deletes the hash entry for a channel associated with an 
 *	interpreter.
 *
 *----------------------------------------------------------------------
 */

int
DetachChannel(interp, chan)
    Tcl_Interp *interp;		/* Interpreter in which channel is defined. */
    Tcl_Channel chan;		/* Channel to delete. */
{
    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
    Tcl_HashEntry *hPtr;	/* Search variable. */
    Channel *chanPtr;		/* The real IO channel. */
    ChannelState *statePtr;	/* State of the real channel. */

    /*
     * Always (un)register bottom-most channel in the stack.  This makes
     * management of the channel list easier because no manipulation is
     * necessary during (un)stack operation.
     */
    chanPtr = ((Channel *) chan)->state->bottomChanPtr;
    statePtr = chanPtr->state;

    if (interp != (Tcl_Interp *) NULL) {
	hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
	if (hTblPtr == (Tcl_HashTable *) NULL) {
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
	if (hPtr == (Tcl_HashEntry *) NULL) {
	    return TCL_ERROR;
	}
	if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
	    return TCL_ERROR;
	}
	Tcl_DeleteHashEntry(hPtr);

	/*
	 * Remove channel handlers that refer to this interpreter, so that they
	 * will not be present if the actual close is delayed and more events
	 * happen on the channel. This may occur if the channel is shared
	 * between several interpreters, or if the channel has async
	 * flushing active.
	 */
    
	CleanupChannelHandlers(interp, chanPtr);
    }

    statePtr->refCount--;
    
    return TCL_OK;
}


/*
 *---------------------------------------------------------------------------
 *
 * Tcl_GetChannel --
 *
 *	Finds an existing Tcl_Channel structure by name in a given

/* 
 * tclIOCmd.c --
 *
 *	Contains the definitions of most of the Tcl commands relating to IO.
 *
 * Copyright (c) 1995-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: tclIOCmd.c,v 1.8 2001/07/31 19:12:06 vincentdarley Exp $
 */

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

/*
 * Callback structure for accept callback in a TCP server.

    }

    /*
     * Open the file or create a process pipeline.
     */

    if (!pipeline) {
        chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
    } else {
#ifdef MAC_TCL
	Tcl_AppendResult(interp,
		"command pipelines not supported on Macintosh OS",
		(char *)NULL);
	return TCL_ERROR;
#else

/* 
 * tclIOUtil.c --
 *
 *	This file contains the implementation of Tcl's generic
 *	filesystem code, which supports a pluggable filesystem
 *	architecture allowing both platform specific filesystems and
 *	'virtual filesystems'.  All filesystem access should go through
 *	the functions defined in this file.  Most of this code was
 *	contributed by Vince Darley.
 *
 *	Parts of this file are based on code contributed by Karl
 *	Lehenbauer, Mark Diekhans and Peter da Silva.
 *
 * 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.12 2001/07/31 19:12:06 vincentdarley Exp $
 */

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

/*
 * Prototypes for procedures defined later in this file.  The last
 * of these could perhaps be exported in the future, if extensions
 * require it.
 */

static void		DupFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr));
static void		FreeFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
static int		SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr));
static Tcl_Obj*         FSNormalizeAbsolutePath 
                            _ANSI_ARGS_((Tcl_Interp* interp, char *path));
static int              TclNormalizeToUniquePath 
                            _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr));
static int		SetFsPathFromAbsoluteNormalized 
                            _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr));
static int 		FindSplitPos _ANSI_ARGS_((char *path, char *separator));
static Tcl_Filesystem*  Tcl_FSGetFileSystemForPath 
			    _ANSI_ARGS_((Tcl_Obj* pathObjPtr));

/*
 * Define the 'path' object type, which Tcl uses to represent
 * file paths internally.
 */
Tcl_ObjType tclFsPathType = {
    "path",				/* name */
    FreeFsPathInternalRep,		/* freeIntRepProc */
    DupFsPathInternalRep,	        /* dupIntRepProc */
    NULL,				/* updateStringProc */
    SetFsPathFromAny			/* setFromAnyProc */
};

/* 
 * These form part of the native filesystem support.  They are needed
 * here because we have a few native filesystem functions (which are
 * the same for mac/win/unix) in this file.  There is no need to place
 * them in tclInt.h, because they are not (and should not be) used
 * anywhere else.
 */
extern char *			tclpFileAttrStrings[];
extern CONST TclFileAttrProcs	tclpFileAttrProcs[];

/* 
 * The following functions are obsolete string based APIs, and should
 * be removed in a future release.
 */

/* Obsolete */
int
TclStat(path, buf)
    CONST char *path;		/* Path of file to stat (in current CP). */
    struct stat *buf;		/* Filled with results of stat call. */
{
    return Tcl_Stat(path,buf);
}

/* Obsolete */
int
TclAccess(path, mode)
    CONST char *path;		/* Path of file to access (in current CP). */
    int mode;                   /* Permission setting. */
{
    return Tcl_Access(path, mode);
}

/* Obsolete */
int
Tcl_Stat(path, buf)
    CONST char *path;		/* Path of file to stat (in current CP). */
    struct stat *buf;		/* Filled with results of stat call. */
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSStat(pathPtr,buf);
    Tcl_DecrRefCount(pathPtr);
    return ret;
}

/* Obsolete */
int
Tcl_Access(path, mode)
    CONST char *path;		/* Path of file to access (in current CP). */
    int mode;                   /* Permission setting. */
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSAccess(pathPtr,mode);
    Tcl_DecrRefCount(pathPtr);
    return ret;
}

/* Obsolete */
Tcl_Channel
Tcl_OpenFileChannel(interp, path, modeString, permissions)
    Tcl_Interp *interp;                 /* Interpreter for error reporting;
					 * can be NULL. */
    char *path;                         /* Name of file to open. */
    char *modeString;                   /* A list of POSIX open modes or
					 * a string such as "rw". */
    int permissions;                    /* If the open involves creating a
					 * file, with what modes to create
					 * it? */
{
    Tcl_Channel ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions);
    Tcl_DecrRefCount(pathPtr);
    return ret;

}

/* Obsolete */
int
Tcl_Chdir(dirName)
    CONST char *dirName;
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1);
    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSChdir(pathPtr);
    Tcl_DecrRefCount(pathPtr);
    return ret;
}

/* Obsolete */
char *
Tcl_GetCwd(interp, cwdPtr)
    Tcl_Interp *interp;
    Tcl_DString *cwdPtr;
{
    Tcl_Obj *cwd;
    cwd = Tcl_FSGetCwd(interp);
    if (cwd == NULL) {
	return NULL;
    } else {
	Tcl_DStringInit(cwdPtr);
	Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
	Tcl_DecrRefCount(cwd);
	return Tcl_DStringValue(cwdPtr);
    }
}

/* Obsolete */
int
Tcl_EvalFile(interp, fileName)
    Tcl_Interp *interp;		/* Interpreter in which to process file. */
    char *fileName;		/* Name of file to process.  Tilde-substitution
				 * will be performed on this name. */
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSEvalFile(interp, pathPtr);
    Tcl_DecrRefCount(pathPtr);
    return ret;
}


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


#ifdef USE_OBSOLETE_FS_HOOKS
/*
 * The following typedef declarations allow for hooking into the chain
 * of functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' &
 * 'Tcl_OpenFileChannel(...)'.  Basically for each hookable function
 * a linked list is defined.
 */

				     * 'Tcl_OpenFileChannel()' call */
    struct OpenFileChannelProc *nextPtr;
				    /* The next 'Tcl_OpenFileChannel()'
				     * function to call */
} OpenFileChannelProc;

/*
 * For each type of (obsolete) hookable function, a static node is
 * declared to hold the function pointer for the "built-in" routine
 * (e.g. 'TclpStat(...)') and the respective list is initialized as a
 * pointer to that node.
 * 
 * The "delete" functions (e.g. 'TclStatDeleteProc(...)') ensure that
 * these statically declared list entry cannot be inadvertently removed.
 *
 * This method avoids the need to call any sort of "initialization"
 * function.
 *
 * All three lists are protected by a global obsoleteFsHookMutex.
 */

static StatProc *statProcList = NULL;
static AccessProc *accessProcList = NULL;
static OpenFileChannelProc *openFileChannelProcList = NULL;

TCL_DECLARE_MUTEX(obsoleteFsHookMutex)

#endif /* USE_OBSOLETE_FS_HOOKS */

/* 
 * A filesystem record is used to keep track of each
 * filesystem currently registered with the core,
 * in a linked list.
 */
typedef struct FilesystemRecord {
    ClientData	     clientData;  /* Client specific data for the new
				   * filesystem (can be NULL) */
    Tcl_Filesystem *fsPtr;        /* Pointer to filesystem dispatch
                                   * table. */
    int refCount;                 /* How many Tcl_Obj's use this
                                   * filesystem. */
    struct FilesystemRecord *nextPtr;  
                                  /* The next filesystem registered
                                   * to Tcl, or NULL if no more. */
} FilesystemRecord;

/* 
 * Declare the native filesystem support.  These functions should
 * be considered private to Tcl, and should really not be called
 * directly by any code other than this file (i.e. neither by
 * Tcl's core nor by extensions).  Similarly, the old string-based
 * Tclp... native filesystem functions should not be called.
 * 
 * The correct API to use now is the Tcl_FS... set of functions,
 * 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_FSPathInFilesystemProc NativePathInFilesystem;
static Tcl_FSFilesystemPathTypeProc NativeFilesystemPathType;
static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;
static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;
static Tcl_FSDupInternalRepProc NativeDupInternalRep;
static Tcl_FSCreateInternalRepProc NativeCreateNativeRep;
static Tcl_FSFileAttrStringsProc NativeFileAttrStrings;
static Tcl_FSFileAttrsGetProc NativeFileAttrsGet;
static Tcl_FSFileAttrsSetProc NativeFileAttrsSet;
static Tcl_FSLoadFileProc NativeLoadFile; 
static Tcl_FSOpenFileChannelProc NativeOpenFileChannel; 
static Tcl_FSUtimeProc NativeUtime;

/* 
 * 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_FSInternalToNormalizedProc TclpNativeToNormalized;
Tcl_FSStatProc TclpObjStat;
Tcl_FSAccessProc TclpObjAccess;	    
Tcl_FSMatchInDirectoryProc TclpMatchInDirectory;  
Tcl_FSGetCwdProc TclpObjGetCwd;     
Tcl_FSChdirProc TclpObjChdir;	    
Tcl_FSLstatProc TclpObjLstat;	    
Tcl_FSCopyFileProc TclpObjCopyFile; 
Tcl_FSDeleteFileProc TclpObjDeleteFile;	    
Tcl_FSRenameFileProc TclpObjRenameFile;	    
Tcl_FSCreateDirectoryProc TclpObjCreateDirectory;	    
Tcl_FSCopyDirectoryProc TclpObjCopyDirectory;	    
Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory;	    
Tcl_FSUnloadFileProc TclpUnloadFile;	    
Tcl_FSReadlinkProc TclpObjReadlink; 
Tcl_FSListVolumesProc TclpListVolumes;	    

/* Define the native filesystem dispatch table */
static Tcl_Filesystem nativeFilesystem = {
    "native",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_1,
    &NativePathInFilesystem,
    &NativeDupInternalRep,
    &NativeFreeInternalRep,
    &TclpNativeToNormalized,
    &NativeCreateNativeRep,
    &TclpObjNormalizePath,
    &NativeFilesystemPathType,
    &NativeFilesystemSeparator,
    &TclpObjStat,
    &TclpObjAccess,
    &NativeOpenFileChannel,
    &TclpMatchInDirectory,
    &NativeUtime,
#ifndef S_IFLNK
    NULL,
#else
    &TclpObjReadlink,
#endif /* S_IFLNK */
    &TclpListVolumes,
    &NativeFileAttrStrings,
    &NativeFileAttrsGet,
    &NativeFileAttrsSet,
    &TclpObjCreateDirectory,
    &TclpObjRemoveDirectory, 
    &TclpObjDeleteFile,
    &TclpObjLstat,
    &TclpObjCopyFile,
    &TclpObjRenameFile,
    &TclpObjCopyDirectory, 
    &NativeLoadFile,
    &TclpUnloadFile,
    &TclpObjGetCwd,
    &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
 * in the lookup list 'filesystemList' below.
 */
static FilesystemRecord nativeFilesystemRecord = {
    NULL,
    &nativeFilesystem,
    1,
    NULL
};

/* 
 * The following few variables are protected by the 
 * filesystemMutex just below.
 */

/* 
 * This is incremented each time we modify the linked list of
 * filesystems.  Any time it changes, all cached filesystem
 * representations are suspect and must be freed.
 */
int filesystemEpoch = 0;
/* Stores the linked list of filesystems.*/
static FilesystemRecord *filesystemList = &nativeFilesystemRecord;
/* 
 * The number of loops which are currently iterating over the linked
 * list.  If this is greater than zero, we can't modify the list.
 */
int filesystemIteratorsInProgress = 0;
/* Someone wants to modify the list of filesystems if this is set. */
int filesystemWantToModify = 0;

Tcl_Condition filesystemOkToModify = NULL;

TCL_DECLARE_MUTEX(filesystemMutex)

/* 
 * 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 'normPathPtr' can be a circular reference to the
 * container Tcl_Obj of this FsPath.
 */
typedef struct FsPath {
    char *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. */ 
    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;

/* 
 * Used to implement Tcl_FSGetCwd in a file-system independent way.
 * This is protected by the cwdMutex below.
 */
static Tcl_Obj* cwdPathPtr = NULL;
TCL_DECLARE_MUTEX(cwdMutex)

/* 
 * Declare fallback support function and 
 * information for Tcl_FSLoadFile 
 */
static Tcl_FSUnloadFileProc FSUnloadTempFile;

/*
 * One of these structures is used each time we successfully load a
 * file from a file system by way of making a temporary copy of the
 * file on the native filesystem.  We need to store both the actual
 * unloadProc/clientData combination which was used, and the original
 * and modified filenames, so that we can correctly undo the entire
 * operation when we want to unload the code.
 */
typedef struct FsDivertLoad {
    ClientData clientData;
    Tcl_FSUnloadFileProc *unloadProcPtr;	
    Tcl_Obj *divertedFile;
} FsDivertLoad;

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


static int 
FsCwdPointerEquals(objPtr)
    Tcl_Obj* objPtr;
{
    Tcl_MutexLock(&cwdMutex);
    if (cwdPathPtr == objPtr) {
	Tcl_MutexUnlock(&cwdMutex);
	return 1;
    } else {
	Tcl_MutexUnlock(&cwdMutex);
	return 0;
    }
}
        

static FilesystemRecord* 
FsGetIterator(void) {
    Tcl_MutexLock(&filesystemMutex);
    filesystemIteratorsInProgress++;
    Tcl_MutexUnlock(&filesystemMutex);
    /* Now we know the list of filesystems cannot be modified */
    return filesystemList;
}

static void 
FsReleaseIterator(void) {
    Tcl_MutexLock(&filesystemMutex);
    filesystemIteratorsInProgress--;
    if (filesystemIteratorsInProgress == 0) {
        /* Notify any waiting threads that things are ok now */
	if (filesystemWantToModify > 0) {
	    Tcl_ConditionNotify(&filesystemOkToModify);
	}
    }
    Tcl_MutexUnlock(&filesystemMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSRegister --
 *
 *    Insert the filesystem function table at the head of the list of
 *    functions which are used during calls to all file-system
 *    operations.  The filesystem will be added even if it is 
 *    already in the list.  (You can use TclFilesystemData to
 *    check if it is in the list, provided the ClientData used was
 *    not NULL).
 *    
 *    Note that the filesystem handling is head-to-tail of the list.
 *    Each filesystem is asked in turn whether it can handle a
 *    particular request, _until_ one of them says 'yes'. At that
 *    point no further filesystems are asked.
 *    
 *    In particular this means if you want to add a diagnostic
 *    filesystem (which simply reports all fs activity), it must be 
 *    at the head of the list: i.e. it must be the last registered.
 *
 * Results:
 *    Normally TCL_OK; TCL_ERROR if memory for a new node in the list
 *    could not be allocated.
 *
 * Side effects:
 *    Memory allocataed and modifies the link list for filesystems.
 *
 *----------------------------------------------------------------------
 */

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

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

    newFilesystemPtr = (FilesystemRecord *)
	ckalloc(sizeof(FilesystemRecord));

    newFilesystemPtr->clientData = clientData;
    newFilesystemPtr->fsPtr = fsPtr;
    
    /* 
     * Is this lock and wait strictly speaking necessary?  Since any
     * iterators out there will have grabbed a copy of the head of
     * the list and be iterating away from that, if we add a new
     * element to the head of the list, it can't possibly have any
     * effect on any of their loops.  In fact it could be better not
     * to wait, since we are adjusting the filesystem epoch, any
     * cached representations calculated by existing iterators are
     * going to have to be thrown away anyway.
     * 
     * However, since registering and unregistering filesystems is
     * a very rare action, this is not a very important point.
     */
    Tcl_MutexLock(&filesystemMutex);
    filesystemWantToModify++;
    Tcl_ConditionWait(&filesystemOkToModify, &filesystemMutex, NULL);
    filesystemWantToModify--;

    newFilesystemPtr->nextPtr = filesystemList;
    filesystemList = newFilesystemPtr;
    /* 
     * Increment the filesystem epoch counter, since existing paths
     * might conceivably now belong to different filesystems.
     */
    filesystemEpoch++;
    Tcl_MutexUnlock(&filesystemMutex);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSUnregister --
 *
 *    Remove the passed filesystem from the list of filesystem
 *    function tables.  It also ensures that the built-in
 *    (native) filesystem is not removable, although we may wish
 *    to change that decision in the future to allow a smaller
 *    Tcl core, in which the native filesystem is not used at
 *    all (we could, say, initialise Tcl completely over a network
 *    connection).
 *
 * Results:
 *    TCL_OK if the procedure pointer was successfully removed,
 *    TCL_ERROR otherwise.
 *
 * Side effects:
 *    Memory is deallocated and the respective list updated.
 *
 *----------------------------------------------------------------------
 */

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

    Tcl_MutexLock(&filesystemMutex);
    filesystemWantToModify++;
    Tcl_ConditionWait(&filesystemOkToModify, &filesystemMutex, NULL);
    filesystemWantToModify--;
    tmpFsRecPtr = filesystemList;
    /*
     * Traverse the 'filesystemList' looking for the particular node
     * whose 'fsPtr' member matches 'fsPtr' and remove that one from
     * the list.  Ensure that the "default" node cannot be removed.
     */

    while ((retVal == TCL_ERROR) && (tmpFsRecPtr != &nativeFilesystemRecord)) {
	if (tmpFsRecPtr->fsPtr == fsPtr) {
	    if (prevFsRecPtr == NULL) {
		filesystemList = filesystemList->nextPtr;
	    } else {
		prevFsRecPtr->nextPtr = tmpFsRecPtr->nextPtr;
	    }
	    /* 
	     * Increment the filesystem epoch counter, since existing
	     * paths might conceivably now belong to different
	     * filesystems.  This should also ensure that paths which
	     * have cached the filesystem which is about to be deleted
	     * do not reference that filesystem (which would of course
	     * lead to memory exceptions).
	     */
	    filesystemEpoch++;

	    ckfree((char *)tmpFsRecPtr);

	    retVal = TCL_OK;
	} else {
	    prevFsRecPtr = tmpFsRecPtr;
	    tmpFsRecPtr = tmpFsRecPtr->nextPtr;
	}
    }

    Tcl_MutexUnlock(&filesystemMutex);
    return (retVal);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSData --
 *
 *    Retrieve the clientData field for the filesystem given,
 *    or NULL if that filesystem is not registered.
 *
 * Results:
 *    A clientData value, or NULL.  Note that if the filesystem
 *    was registered with a NULL clientData field, this function
 *    will return that NULL value.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

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

    tmpFsRecPtr = FsGetIterator();
    /*
     * Traverse the 'filesystemList' looking for the particular node
     * whose 'fsPtr' member matches 'fsPtr' and remove that one from
     * the list.  Ensure that the "default" node cannot be removed.
     */

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

    FsReleaseIterator();
    return (retVal);
}

/*
 *---------------------------------------------------------------------------
 *
 * FSNormalizeAbsolutePath --
 *
 * Description:
 *	Takes an absolute path specification and computes a 'normalized'
 *	path from it.
 *	
 *	A normalized path is one which has all '../', './' removed.
 *	Also it is one which is in the 'standard' format for the native
 *	platform.  On MacOS, Unix, this means the path must be free of
 *	symbolic links/aliases, and on Windows it means we want the
 *	long form, with that long form's case-dependence (which gives
 *	us a unique, case-dependent path).
 *	
 *	The behaviour of this function if passed a non-absolute path
 *	is NOT defined.
 *
 * Results:
 *	The result is returned in a Tcl_Obj with a refCount of 1,
 *	which is therefore owned by the caller.  It must be
 *	freed (with Tcl_DecrRefCount) by the caller when no longer needed.
 *
 * Side effects:
 *	None (beyond the memory allocation for the result).
 *
 * Special note:
 *	This code is based on code from Matt Newman and Jean-Claude
 *	Wippler, with additions from Vince Darley and is copyright 
 *	those respective authors.
 *
 *---------------------------------------------------------------------------
 */
static Tcl_Obj*
FSNormalizeAbsolutePath(interp, path)
    Tcl_Interp* interp;    /* Interpreter to use */
    char *path;            /* Absolute path to normalize (UTF-8) */
{
    char **sp = NULL, *np[BUFSIZ];
    int splen = 0, nplen, i;
    Tcl_Obj *retVal;
    
    Tcl_SplitPath(path, &splen, &sp);
    
    nplen = 0;
    for (i = 0;i < splen;i++) {
	if (strcmp(sp[i], ".") == 0)
	    continue;

	if (strcmp(sp[i], "..") == 0) {
	    if (nplen > 1) nplen--;
	} else {
	    np[nplen++] = sp[i];
	}
    }
    if (nplen > 0) {
	Tcl_DString dtemp;
	Tcl_DStringInit(&dtemp);
	Tcl_JoinPath(nplen, np, &dtemp);
	/* 
	 * Now we have an absolute path, with no '..', '.' sequences,
	 * but it still may not be in 'unique' form, depending on the
	 * platform.  For instance, Unix is case-sensitive, so the
	 * path is ok.  Windows is case-insensitive, and also has the
	 * weird 'longname/shortname' thing (e.g. C:/Program Files/ and
	 * C:/Progra~1/ are equivalent).  MacOS is case-insensitive.
	 * 
	 * Virtual file systems which may be registered may have
	 * other criteria for normalizing a path.
	 */
	retVal = Tcl_NewStringObj(Tcl_DStringValue(&dtemp),-1);
	Tcl_DStringFree(&dtemp);
	Tcl_IncrRefCount(retVal);
	TclNormalizeToUniquePath(interp, retVal);
	/* 
	 * Since we know it is a normalized path, we can
	 * actually convert this object into an FsPath for
	 * greater efficiency 
	 */
	SetFsPathFromAbsoluteNormalized(interp, retVal);
    } else {
	/* Init to an empty string */
	retVal = Tcl_NewStringObj("",0);
	Tcl_IncrRefCount(retVal);
    }
    ckfree((char*) sp);

    /* This has a refCount of 1 for the caller */
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclNormalizeToUniquePath --
 *
 * Description:
 *	Takes a path specification containing no ../, ./ sequences,
 *	and converts it into a unique path for the given platform.
 *      On MacOS, Unix, this means the path must be free of
 *	symbolic links/aliases, and on Windows it means we want the
 *	long form, with that long form's case-dependence (which gives
 *	us a unique, case-dependent path).
 *
 * Results:
 *	The result is returned in a Tcl_Obj with a refCount of 1,
 *	which is therefore owned by the caller.  It must be
 *	freed (with Tcl_DecrRefCount) by the caller when no longer needed.
 *
 * Side effects:
 *	None (beyond the memory allocation for the result).
 *
 * Special note:
 *	This is only used by the above function.  Also if the
 *	filesystem-specific normalizePathProcs can re-introduce
 *	../, ./ sequences into the path, then this function will
 *	not return the correct result.  This may be possible with
 *	symbolic links on unix/macos.
 *
 *---------------------------------------------------------------------------
 */
static int
TclNormalizeToUniquePath(interp, pathPtr)
    Tcl_Interp *interp;
    Tcl_Obj *pathPtr;
{
    FilesystemRecord *fsRecPtr;
    int retVal = 0;

    /*
     * Call each of the "normalise path" functions in succession. This is
     * a special case, in which if we have a native filesystem handler,
     * we call it first.  This is because the root of Tcl's filesystem
     * is always a native filesystem (i.e. '/' on unix is native).
     */

    fsRecPtr = FsGetIterator();
    while (fsRecPtr != NULL) {
        if (fsRecPtr == &nativeFilesystemRecord) {
	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
	    if (proc != NULL) {
		retVal = (*proc)(interp, pathPtr, retVal);
	    }
	    break;
        }
	fsRecPtr = fsRecPtr->nextPtr;
    }
    FsReleaseIterator();
    
    fsRecPtr = FsGetIterator();
    while (fsRecPtr != NULL) {
	/* Skip the native system next time through */
	if (fsRecPtr != &nativeFilesystemRecord) {
	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
	    if (proc != NULL) {
		retVal = (*proc)(interp, pathPtr, retVal);
	    }
	    /* 
	     * We could add an efficiency check like this:
	     * 
	     *   if (retVal == Tcl_DStringLength(pathPtr)) {break;}
	     * 
	     * but there's not much benefit.
	     */
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    FsReleaseIterator();

    return (retVal);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclGetOpenMode --
 *
 * Description:

    }
    return mode;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSEvalFile --
 *
 *	Read in a file and process the entire file as one gigantic
 *	Tcl command.
 *
 * Results:
 *	A standard Tcl result, which is either the result of executing
 *	the file or an error indicating why the file couldn't be read.
 *
 * Side effects:
 *	Depends on the commands in the file.  During the evaluation
 *	of the contents of the file, iPtr->scriptFile is made to
 *	point to fileName (the old value is cached and replaced when
 *	this function returns).
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSEvalFile(interp, fileName)
    Tcl_Interp *interp;		/* Interpreter in which to process file. */
    Tcl_Obj *fileName;		/* Name of file to process.  Tilde-substitution
				 * will be performed on this name. */
{
    int result, length;
    struct stat statBuf;
    Tcl_Obj *oldScriptFile;
    Interp *iPtr;

    char *string;
    Tcl_Channel chan;
    Tcl_Obj *objPtr;


    if (Tcl_FSGetTranslatedPath(interp, fileName) == NULL) {
	return TCL_ERROR;
    }

    result = TCL_ERROR;
    objPtr = Tcl_NewObj();

    if (Tcl_FSStat(fileName, &statBuf) == -1) {
        Tcl_SetErrno(errno);
	Tcl_AppendResult(interp, "couldn't read file \"", 
		Tcl_GetString(fileName),
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	goto end;
    }
    chan = Tcl_FSOpenFileChannel(interp, fileName, "r", 0644);
    if (chan == (Tcl_Channel) NULL) {
        Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "couldn't read file \"", 
		Tcl_GetString(fileName),
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	goto end;
    }
    /*
     * The eofchar is \32 (^Z).  This is the usual on Windows, but we
     * effect this cross-platform to allow for scripted documents.
     * [Bug: 2040]
     */
    Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");
    if (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) {
        Tcl_Close(interp, chan);
	Tcl_AppendResult(interp, "couldn't read file \"", 
		Tcl_GetString(fileName),
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	goto end;
    }
    if (Tcl_Close(interp, chan) != TCL_OK) {
        goto end;
    }

    iPtr = (Interp *) interp;
    oldScriptFile = iPtr->scriptFile;
    iPtr->scriptFile = fileName;
    Tcl_IncrRefCount(iPtr->scriptFile);
    string = Tcl_GetStringFromObj(objPtr, &length);
    result = Tcl_EvalEx(interp, string, length, 0);
    /* 
     * Now we have to be careful; the script may have changed the
     * iPtr->scriptFile value, so we must reset it without
     * assuming it still points to 'fileName'.
     */
    if (iPtr->scriptFile != NULL) {
	Tcl_DecrRefCount(iPtr->scriptFile);
    }
    iPtr->scriptFile = oldScriptFile;

    if (result == TCL_RETURN) {
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	char msg[200 + TCL_INTEGER_SPACE];

	/*
	 * Record information telling where the error occurred.
	 */

	sprintf(msg, "\n    (file \"%.150s\" line %d)", Tcl_GetString(fileName),
		interp->errorLine);
	Tcl_AddErrorInfo(interp, msg);
    }

    end:
    Tcl_DecrRefCount(objPtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetErrno --

    Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
    return msg;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSStat --
 *
 *	This procedure replaces the library version of stat and lsat.
 *	
 *	The appropriate function for the filesystem to which pathPtr
 *	belongs will be called.

 *
 * Results:
 *      See stat documentation.
 *
 * Side effects:
 *      See stat documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSStat(pathPtr, buf)
    Tcl_Obj *pathPtr;		/* Path of file to stat (in current CP). */
    struct stat *buf;		/* Filled with results of stat call. */
{
#ifdef USE_OBSOLETE_FS_HOOKS
    StatProc *statProcPtr;
    int retVal = -1;
#endif /* USE_OBSOLETE_FS_HOOKS */
    Tcl_Filesystem *fsPtr;
    char *path = Tcl_FSGetTranslatedPath(NULL, pathPtr);

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

#ifdef USE_OBSOLETE_FS_HOOKS
    Tcl_MutexLock(&obsoleteFsHookMutex);
    statProcPtr = statProcList;
    while ((retVal == -1) && (statProcPtr != NULL)) {
	retVal = (*statProcPtr->proc)(path, buf);
	statProcPtr = statProcPtr->nextPtr;
    }
    Tcl_MutexUnlock(&obsoleteFsHookMutex);
    if (retVal != -1) {
        return retVal;
    }
#endif /* USE_OBSOLETE_FS_HOOKS */
    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSStatProc *proc = fsPtr->statProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr, buf);
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSLstat --
 *
 *	This procedure replaces the library version of lstat.
 *	The appropriate function for the filesystem to which pathPtr
 *	belongs will be called.  If no 'lstat' function is listed,
 *	but a 'stat' function is, then Tcl will fall back on the
 *	stat function.
 *
 * Results:
 *      See lstat documentation.
 *
 * Side effects:
 *      See lstat documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSLstat(pathPtr, buf)
    Tcl_Obj *pathPtr;		/* Path of file to stat (in current CP). */
    struct stat *buf;		/* Filled with results of stat call. */
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSLstatProc *proc = fsPtr->lstatProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr, buf);
	} else {
	    Tcl_FSStatProc *sproc = fsPtr->statProc;
	    if (sproc != NULL) {
		return (*sproc)(pathPtr, buf);
	    }
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSAccess --
 *
 *	This procedure replaces the library version of access.
 *	The appropriate function for the filesystem to which pathPtr
 *	belongs will be called.

 *
 * Results:
 *      See access documentation.
 *
 * Side effects:
 *      See access documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSAccess(pathPtr, mode)
    Tcl_Obj *pathPtr;		/* Path of file to access (in current CP). */
    int mode;                   /* Permission setting. */
{
#ifdef USE_OBSOLETE_FS_HOOKS
    AccessProc *accessProcPtr;
    int retVal = -1;
#endif /* USE_OBSOLETE_FS_HOOKS */
    Tcl_Filesystem *fsPtr;
    char *path = Tcl_FSGetTranslatedPath(NULL, pathPtr);

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

#ifdef USE_OBSOLETE_FS_HOOKS
    Tcl_MutexLock(&obsoleteFsHookMutex);
    accessProcPtr = accessProcList;
    while ((retVal == -1) && (accessProcPtr != NULL)) {
	retVal = (*accessProcPtr->proc)(path, mode);
	accessProcPtr = accessProcPtr->nextPtr;
    }
    Tcl_MutexUnlock(&obsoleteFsHookMutex);
    if (retVal != -1) {
	return retVal;
    }
#endif /* USE_OBSOLETE_FS_HOOKS */
    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSAccessProc *proc = fsPtr->accessProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr, mode);
	}
    }

    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSOpenFileChannel --
 *
 *	The appropriate function for the filesystem to which pathPtr
 *	belongs will be called.


 *
 * Results:
 *	The new channel or NULL, if the named file could not be opened.
 *
 * Side effects:
 *	May open the channel and may cause creation of a file on the
 *	file system.
 *
 *----------------------------------------------------------------------
 */
 
Tcl_Channel
Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
    Tcl_Interp *interp;                 /* Interpreter for error reporting;
                                         * can be NULL. */
    Tcl_Obj *pathPtr;                   /* Name of file to open. */
    char *modeString;                   /* A list of POSIX open modes or
                                         * a string such as "rw". */
    int permissions;                    /* If the open involves creating a
                                         * file, with what modes to create
                                         * it? */
{
#ifdef USE_OBSOLETE_FS_HOOKS
    OpenFileChannelProc *openFileChannelProcPtr;
    Tcl_Channel retVal = NULL;
#endif /* USE_OBSOLETE_FS_HOOKS */
    Tcl_Filesystem *fsPtr;
    char *path = Tcl_FSGetTranslatedPath(interp, pathPtr);
    if (path == NULL) {
	return NULL;
    }

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

#ifdef USE_OBSOLETE_FS_HOOKS
    Tcl_MutexLock(&obsoleteFsHookMutex);
    openFileChannelProcPtr = openFileChannelProcList;
    while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) {
	retVal = (*openFileChannelProcPtr->proc)(interp, path,
		modeString, permissions);
	openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;
    }
    Tcl_MutexUnlock(&obsoleteFsHookMutex);
    if (retVal != NULL) {
	return retVal;
    }
#endif /* USE_OBSOLETE_FS_HOOKS */
    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;
	if (proc != NULL) {
	    return (*proc)(interp, pathPtr, modeString, permissions);
	}
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSMatchInDirectory --
 *
 *	This routine is used by the globbing code to search a directory
 *	for all files which match a given pattern.  The appropriate
 *	function for the filesystem to which pathPtr belongs will be
 *	called.  If pathPtr does not belong to any filesystem and if it
 *	is NULL or the empty string, then we assume the pattern is to
 *	be matched in the current working directory.  To avoid each
 *	filesystem's Tcl_FSMatchInDirectoryProc having to deal with
 *	this issue, we create a pathPtr on the fly, and then remove it
 *	from the results returned.  This makes filesystems easy to
 *	write, since they can assume the pathPtr passed to them
 *	is an ordinary path.  In fact this means we could remove such
 *	special case handling from Tcl's native filesystems.
 *
 * Results: 
 *	
 *	The return value is a standard Tcl result indicating whether an
 *	error occurred in globbing.  Error messages are placed in
 *	interp, but good results are placed in the resultPtr given.
 *	
 *	Recursive searches, e.g.
 *	
 *	   glob -dir $dir -join * pkgIndex.tcl
 *	   
 *	which must recurse through each directory matching '*' are
 *	handled internally by Tcl, by passing specific flags in a 
 *	modified 'types' parameter.
 *
 * Side effects:
 *	The interpreter may have an error message inserted into it.
 *
 *---------------------------------------------------------------------- 
 */

int
Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
    Tcl_Interp *interp;		/* Interpreter to receive error messages. */
    Tcl_Obj *result;		/* List object to receive results. */
    Tcl_Obj *pathPtr;	        /* Contains path to directory to search. */
    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 = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
	if (proc != NULL) {
	    return (*proc)(interp, result, pathPtr, pattern, types);
	}
    } else {
	Tcl_Obj* cwd;
	int ret;
	if (pathPtr != NULL) {
	    int len;
	    Tcl_GetStringFromObj(pathPtr,&len);
	    if (len != 0) {
		/* 
		 * We have no idea how to match files in a directory
		 * which belongs to no known filesystem
		 */
		return -1;
	    }
	}
	/* 
	 * We have a null string, this means we must use the 'cwd', and
	 * then manipulate the result.  We must deal with this here,
	 * since if we don't, every single filesystem's implementation
	 * of Tcl_FSMatchInDirectory will have to deal with it for us.
	 */
	cwd = Tcl_FSGetCwd(NULL);
	if (cwd == NULL) {
	    if (interp != NULL) {
	        Tcl_SetResult(interp, "glob couldn't determine"
			  "the current working directory", TCL_STATIC);
	    }
	    return TCL_ERROR;
	}
	fsPtr = Tcl_FSGetFileSystemForPath(cwd);
	if (fsPtr != NULL) {
	    Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
	    if (proc != NULL) {
		int cwdLen;
		Tcl_Obj *cwdDir;
		Tcl_Obj* tmpResultPtr = Tcl_NewListObj(0, NULL);
		/* 
		 * We know the cwd is a normalised object which does
		 * not end in a directory delimiter.
		 */
		cwdDir = Tcl_DuplicateObj(cwd);
		#ifdef MAC_TCL
		Tcl_AppendToObj(cwdDir, ":", 1);
		#else
		Tcl_AppendToObj(cwdDir, "/", 1);
		#endif
		Tcl_GetStringFromObj(cwdDir, &cwdLen);
		Tcl_IncrRefCount(cwdDir);
		ret = (*proc)(interp, tmpResultPtr, cwdDir, pattern, types);
		Tcl_DecrRefCount(cwdDir);
		if (ret == TCL_OK) {
		    int resLength;
		    ret = Tcl_ListObjLength(interp, tmpResultPtr, &resLength);
		    if (ret == TCL_OK) {
			int i;
			for (i =0; i< resLength; i++) {
			    Tcl_Obj *elt, *cutElt;
			    char *eltStr;
			    int eltLen;
			    Tcl_ListObjIndex(interp, tmpResultPtr, i, &elt);
			    eltStr = Tcl_GetStringFromObj(elt,&eltLen);
			    cutElt = Tcl_NewStringObj(eltStr + cwdLen, eltLen - cwdLen);
			    Tcl_ListObjAppendElement(interp, result, cutElt);
			}
		    }
		}
		Tcl_DecrRefCount(tmpResultPtr);
	    }
	}
	Tcl_DecrRefCount(cwd);
	return ret;
    }
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSGetCwd --
 *
 *	This function replaces the library version of getcwd().
 *	
 *	Most VFS's will *not* implement a 'cwdProc'.  Tcl now maintains
 *	its own record (in a Tcl_Obj) of the cwd, and an attempt
 *	is made to synchronise this with the cwd's containing filesystem,
 *	if that filesystem provides a cwdProc (e.g. the native filesystem).
 *	
 *	Note that if Tcl's cwd is not in the native filesystem, then of
 *	course Tcl's cwd and the native cwd are different: extensions
 *	should therefore ensure they only access the cwd through this
 *	function to avoid confusion.
 *	
 *	If a global cwdPathPtr already exists, it is returned, subject
 *	to a synchronisation attempt in that cwdPathPtr's fs.
 *	Otherwise, the chain of functions that have been "inserted"
 *	into the filesystem will be called in succession until either a
 *	value other than NULL is returned, or the entire list is
 *	visited.
 *
 * Results:
 *	The result is a pointer to a Tcl_Obj 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.  
 *	
 *	The result already has its refCount incremented for the caller.
 *	When it is no longer needed, that refCount should be decremented.
 *	This is needed for thread-safety purposes, to allow multiple
 *	threads to access this and related functions, while ensuring the
 *	results are always valid.
 *	
 *	Of course it is probably a bad idea for multiple threads to
 *	be *setting* the cwd anyway, but we can at least try to 
 *	help the case of multiple reads with occasional sets.
 *
 * Side effects:
 *	Various objects may be freed and allocated.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj*
Tcl_FSGetCwd(interp)
    Tcl_Interp *interp;
{
    Tcl_Obj *cwdToReturn;
    
    if (FsCwdPointerEquals(NULL)) {
	FilesystemRecord *fsRecPtr;
	Tcl_Obj *retVal = NULL;

        /* 
         * We've never been called before, try to find a cwd.  Call
         * each of the "Tcl_GetCwd" function in succession.  A non-NULL
         * return value indicates the particular function has
         * succeeded.
	 */

	fsRecPtr = FsGetIterator();
	while ((retVal == NULL) && (fsRecPtr != NULL)) {
	    Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc;
	    if (proc != NULL) {
		retVal = (*proc)(interp);
	    }
	    fsRecPtr = fsRecPtr->nextPtr;
	}
	FsReleaseIterator();
	/* 
	 * 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.
	 * 
	 * Finally, if retVal is NULL, we do not have a cwd, which
	 * could be problematic.
	 */
	if (retVal != NULL) {
	    Tcl_Obj *norm = FSNormalizeAbsolutePath(interp, 
				Tcl_GetString(retVal));
	    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.
		 */
		Tcl_MutexLock(&cwdMutex);
		/* Just in case the pointer has been set by another
		 * thread between now and the test above */
		if (cwdPathPtr != NULL) {
		    Tcl_DecrRefCount(cwdPathPtr);
		}
		cwdPathPtr = norm;
		Tcl_MutexUnlock(&cwdMutex);
	    }
	    Tcl_DecrRefCount(retVal);
	}
    } else {
	/* 
	 * We already have a cwd cached, but we want to give the
	 * filesystem it is in a chance to check whether that cwd
	 * has changed, or is perhaps no longer accessible.  This
	 * allows an error to be thrown if, say, the permissions on
	 * that directory have changed.
	 */
	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(cwdPathPtr);
	/* 
	 * If the filesystem couldn't be found, or if no cwd function
	 * exists for this filesystem, then we simply assume the cached
	 * cwd is ok.  If we do call a cwd, we must watch for errors
	 * (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;
	    if (proc != NULL) {
		Tcl_Obj *retVal = (*proc)(interp);
		if (retVal != NULL) {
		    Tcl_Obj *norm = FSNormalizeAbsolutePath(interp, 
					Tcl_GetString(retVal));
		    /* 
		     * 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 */
		    } else if (Tcl_FSEqualPaths(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);
		    } else {
			/* The cwd has in fact changed, so we must
			 * lock down the cwdMutex to modify. */
			Tcl_MutexLock(&cwdMutex);
			Tcl_DecrRefCount(cwdPathPtr);
			cwdPathPtr = norm;
			Tcl_MutexUnlock(&cwdMutex);
		    }
		    Tcl_DecrRefCount(retVal);
		} else {
		    /* The 'cwd' function returned an error, so we
		     * reset the cwd after locking down the mutex. */
		    Tcl_MutexLock(&cwdMutex);
		    Tcl_DecrRefCount(cwdPathPtr);
		    cwdPathPtr = NULL;
		    Tcl_MutexUnlock(&cwdMutex);
		}
	    }
	}
    }
    
    /* 
     * The paths all eventually fall through to here.  Note that
     * we use a bunch of separate mutex locks throughout this
     * code to help prevent deadlocks between threads.  Really
     * the only weirdness will arise if multiple threads are setting
     * and reading the cwd, and that behaviour is always going to be
     * a little suspect.
     */
    Tcl_MutexLock(&cwdMutex);
    cwdToReturn = cwdPathPtr;
    if (cwdToReturn != NULL) {
        Tcl_IncrRefCount(cwdToReturn);
    }
    Tcl_MutexUnlock(&cwdMutex);
    
    return (cwdToReturn);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSUtime --
 *
 *	This procedure replaces the library version of utime.
 *	The appropriate function for the filesystem to which pathPtr
 *	belongs will be called.
 *
 * Results:
 *      See utime documentation.
 *
 * Side effects:
 *      See utime documentation.
 *
 *----------------------------------------------------------------------
 */

int 
Tcl_FSUtime (pathPtr, tval)
    Tcl_Obj *pathPtr;       /* File to change access/modification times */
    struct utimbuf *tval;   /* Structure containing access/modification 
                             * times to use.  Should not be modified. */
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSUtimeProc *proc = fsPtr->utimeProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr, tval);
	}
    }
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * NativeFileAttrStrings --
 *
 *	This procedure implements the platform dependent 'file
 *	attributes' subcommand, for the native filesystem, for listing
 *	the set of possible attribute strings.  This function is part
 *	of Tcl's native filesystem support, and is placed here because
 *	it is shared by Unix, MacOS and Windows code.
 *
 * Results:
 *      An array of strings
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

char**
NativeFileAttrStrings(pathPtr, objPtrRef)
    Tcl_Obj *pathPtr;
    Tcl_Obj** objPtrRef;
{
    return tclpFileAttrStrings;
}

/*
 *----------------------------------------------------------------------
 *
 * NativeFileAttrsGet --
 *
 *	This procedure implements the platform dependent
 *	'file attributes' subcommand, for the native
 *	filesystem, for 'get' operations.  This function is part
 *	of Tcl's native filesystem support, and is placed here
 *	because it is shared by Unix, MacOS and Windows code.
 *
 * Results:
 *      Standard Tcl return code.  The object placed in objPtrRef
 *      (if TCL_OK was returned) is likely to have a refCount of zero.
 *      Either way we must either store it somewhere (e.g. the Tcl 
 *      result), or Incr/Decr its refCount to ensure it is properly
 *      freed.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
NativeFileAttrsGet(interp, index, fileName, objPtrRef)
    Tcl_Interp *interp;		/* The interpreter for error reporting. */
    int index;			/* index of the attribute command. */
    Tcl_Obj *fileName;		/* filename we are operating on. */
    Tcl_Obj **objPtrRef;	/* for output. */
{
    return (*tclpFileAttrProcs[index].getProc)(interp, index, 
		    Tcl_FSGetTranslatedPath(NULL, fileName),
		    objPtrRef);
}

/*
 *----------------------------------------------------------------------
 *
 * NativeFileAttrsSet --
 *
 *	This procedure implements the platform dependent
 *	'file attributes' subcommand, for the native
 *	filesystem, for 'set' operations. This function is part
 *	of Tcl's native filesystem support, and is placed here
 *	because it is shared by Unix, MacOS and Windows code.
 *
 * Results:
 *      Standard Tcl return code.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
NativeFileAttrsSet(interp, index, fileName, objPtr)
    Tcl_Interp *interp;		/* The interpreter for error reporting. */
    int index;			/* index of the attribute command. */
    Tcl_Obj *fileName;		/* filename we are operating on. */
    Tcl_Obj *objPtr;		/* set to this value. */
{
    return (*tclpFileAttrProcs[index].setProc)(interp, index,
		    Tcl_FSGetTranslatedPath(NULL, fileName),
		    objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSFileAttrStrings --
 *
 *	This procedure implements part of the hookable 'file
 *	attributes' subcommand.  The appropriate function for the
 *	filesystem to which pathPtr belongs will be called.
 *
 * Results:
 *      The called procedure may either return an array of strings,
 *      or may instead return NULL and place a Tcl list into the 
 *      given objPtrRef.  Tcl will take that list and first increment
 *      its refCount before using it.  On completion of that use, Tcl
 *      will decrement its refCount.  Hence if the list should be
 *      disposed of by Tcl when done, it should have a refCount of zero,
 *      and if the list should not be disposed of, the filesystem
 *      should ensure it retains a refCount on the object.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

char**
Tcl_FSFileAttrStrings(pathPtr, objPtrRef)
    Tcl_Obj* pathPtr;
    Tcl_Obj** objPtrRef;
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSFileAttrStringsProc *proc = fsPtr->fileAttrStringsProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr, objPtrRef);
	}
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSFileAttrsGet --
 *
 *	This procedure implements read access for the hookable 'file
 *	attributes' subcommand.  The appropriate function for the
 *	filesystem to which pathPtr belongs will be called.
 *
 * Results:
 *      Standard Tcl return code.  The object placed in objPtrRef
 *      (if TCL_OK was returned) is likely to have a refCount of zero.
 *      Either way we must either store it somewhere (e.g. the Tcl 
 *      result), or Incr/Decr its refCount to ensure it is properly
 *      freed.

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

int
Tcl_FSFileAttrsGet(interp, index, pathPtr, objPtrRef)
    Tcl_Interp *interp;		/* The interpreter for error reporting. */
    int index;			/* index of the attribute command. */
    Tcl_Obj *pathPtr;		/* filename we are operating on. */
    Tcl_Obj **objPtrRef;	/* for output. */
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSFileAttrsGetProc *proc = fsPtr->fileAttrsGetProc;
	if (proc != NULL) {
	    return (*proc)(interp, index, pathPtr, objPtrRef);
	}
    }
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSFileAttrsSet --
 *
 *	This procedure implements write access for the hookable 'file
 *	attributes' subcommand.  The appropriate function for the
 *	filesystem to which pathPtr belongs will be called.
 *
 * Results:
 *      Standard Tcl return code.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSFileAttrsSet(interp, index, pathPtr, objPtr)
    Tcl_Interp *interp;		/* The interpreter for error reporting. */
    int index;			/* index of the attribute command. */
    Tcl_Obj *pathPtr;		/* filename we are operating on. */
    Tcl_Obj *objPtr;		/* Input value. */
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSFileAttrsSetProc *proc = fsPtr->fileAttrsSetProc;
	if (proc != NULL) {
	    return (*proc)(interp, index, pathPtr, objPtr);
	}
    }
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSChdir --
 *
 *	This function replaces the library version of chdir().
 *	
 *	The path is normalized and then passed to the filesystem
 *	which claims it.
 *
 * Results:
 *	See chdir() documentation.  If successful, we keep a 
 *	record of the successful path in cwdPathPtr for subsequent 
 *	calls to getcwd.
 *
 * Side effects:
 *	See chdir() documentation.  The global cwdPathPtr may 
 *	change value.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_FSChdir(pathPtr)
    Tcl_Obj *pathPtr;
{
    Tcl_Filesystem *fsPtr;
    int retVal = -1;
    Tcl_Obj *normDirName;
    
    normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (normDirName == NULL) {
        return TCL_ERROR;
    }
    
    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSChdirProc *proc = fsPtr->chdirProc;
	if (proc != NULL) {
	    retVal = (*proc)(pathPtr);
	} else {
	    /* Fallback on stat-based implementation */
	    struct stat buf;
	    /* If the file can be stat'ed and is a directory and
	     * is readable, then we can chdir. */
	    if ((Tcl_FSStat(pathPtr, &buf) == 0) 
	      && (S_ISDIR(buf.st_mode))
	      && (Tcl_FSAccess(pathPtr, R_OK) == 0)) {
		/* We allow the chdir */
		retVal = 0;
	    }
	}
    }

    if (retVal != -1) {
	/* 
	 * The cwd changed, or an error was thrown.  If an error was
	 * thrown, we can just continue (and that will report the error
	 * to the user).  If there was no error we must assume that the
	 * cwd was actually changed to the normalized value we
	 * calculated above, and we must therefore cache that
	 * information.
	 */
	if (retVal == TCL_OK) {
	    /* Get a lock on the cwd while we modify it */
	    Tcl_MutexLock(&cwdMutex);
	    /* Free up the previous cwd we stored */
	    if (cwdPathPtr != NULL) {
		Tcl_DecrRefCount(cwdPathPtr);
	    }
	    /* Now remember the current cwd */
	    cwdPathPtr = normDirName;
	    Tcl_IncrRefCount(cwdPathPtr);
	    Tcl_MutexUnlock(&cwdMutex);
	}
    }
    
    return (retVal);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSLoadFile --
 *
 *	Dynamically loads a binary code file into memory and returns
 *	the addresses of two procedures within that file, if they are
 *	defined.  The appropriate function for the filesystem to which
 *	pathPtr belongs will be called.
 *
 * Results:
 *	A standard Tcl completion code.  If an error occurs, an error
 *	message is left in the interp's result.
 *
 * Side effects:
 *	New code suddenly appears in memory.  We remember which
 *	filesystem loaded the code, so that we can use that filesystem's
 *	unloadProc to unload the code when that occurs.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, 
	       clientDataPtr, unloadProcPtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    Tcl_Obj *pathPtr;		/* Name of the file containing the desired
				 * code. */
    char *sym1, *sym2;		/* Names of two procedures to look up in
				 * the file's symbol table. */
    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
				/* Where to return the addresses corresponding
				 * to sym1 and sym2. */
    ClientData *clientDataPtr;	/* Filled with token for dynamically loaded
				 * file which will be passed back to 
				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr;	
                                /* Filled with address of Tcl_FSUnloadFileProc
                                 * function which should be used for
                                 * this file. */
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSLoadFileProc *proc = fsPtr->loadFileProc;
	if (proc != NULL) {
	    int retVal = (*proc)(interp, pathPtr, sym1, sym2,
			     proc1Ptr, proc2Ptr, clientDataPtr);
	    if (retVal != -1) {
		/* 
		 * We handled it.  Remember which unload file 
		 * proc to use. 
		 */
		(*unloadProcPtr) = fsPtr->unloadFileProc;
	    }
	    return retVal;
	} else {
	    Tcl_Filesystem *copyFsPtr;
	    /* Get a temporary filename to use, first to
	     * copy the file into, and then to load. */
	    Tcl_Obj *copyToPtr = TclpTempFileName();
	    if (copyToPtr == NULL) {
	        return -1;
	    }
	    Tcl_IncrRefCount(copyToPtr);
	    
	    copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
	    if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) {
		/* We already know we can't use Tcl_FSLoadFile from 
		 * this filesystem, and we must avoid a possible
		 * infinite loop. */
		Tcl_DecrRefCount(copyToPtr);
		return -1;
	    }
	    
	    if (Tcl_FSCopyFile(pathPtr, copyToPtr) == 0) {
		/* 
		 * Do we need to set appropriate permissions 
		 * on the file?  This may be required on some
		 * systems.  On Unix we could do loop over
		 * the file attributes, and set any that are
		 * called "-permissions" to 0777.  Or directly:
		 * 
		 * Tcl_Obj* perm = Tcl_NewStringObj("0777",-1);
		 * Tcl_IncrRefCount(perm);
		 * Tcl_FSFileAttrsSet(NULL, 2, copyToPtr, perm);
		 * Tcl_DecrRefCount(perm);
		 * 
		 */
		ClientData newClientData = NULL;
		Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
		FsDivertLoad *tvdlPtr;
		int retVal;
		
		retVal = Tcl_FSLoadFile(interp, copyToPtr, sym1, sym2, proc1Ptr, 
			       proc2Ptr, &newClientData, &newUnloadProcPtr);
	        if (retVal == -1) {
		    /* The file didn't load successfully */
		    Tcl_FSDeleteFile(copyToPtr);
		    Tcl_DecrRefCount(copyToPtr);
		    return -1;
		}
		/* 
		 * When we unload this file, we need to divert the 
		 * unloading so we can unload and cleanup the 
		 * temporary file correctly.
		 */
		tvdlPtr = (FsDivertLoad*) ckalloc(sizeof(FsDivertLoad));

		/* 
		 * Remember three pieces of information.  This allows
		 * us to cleanup the diverted load completely, on
		 * platforms which allow proper unloading of code.
		 */
		tvdlPtr->clientData = newClientData;
		tvdlPtr->unloadProcPtr = newUnloadProcPtr;
		/* copyToPtr is already incremented for this reference */
		tvdlPtr->divertedFile = copyToPtr;
		copyToPtr = NULL;
		(*clientDataPtr) = (ClientData) tvdlPtr;
		(*unloadProcPtr) = &FSUnloadTempFile;
		
		return retVal;
	    }
	}
    }
    return -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * FSUnloadTempFile --
 *
 *	This function is called when we loaded a library of code via
 *	an intermediate temporary file.  This function ensures
 *	the library is correctly unloaded and the temporary file
 *	is correctly deleted.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The effects of the 'unload' function called, and of course
 *	the temporary file will be deleted.
 *
 *---------------------------------------------------------------------------
 */
static void 
FSUnloadTempFile(clientData)
    ClientData clientData;    /* ClientData returned by a previous call
			       * to Tcl_FSLoadFile().  The clientData is 
			       * a token that represents the loaded 
			       * file. */
{
    FsDivertLoad *tvdlPtr = (FsDivertLoad*)clientData;
    /* 
     * This test should never trigger, since we give
     * the client data in the function above.
     */
    if (tvdlPtr == NULL) { return; }
    
    /* Call the real 'unloadfile' proc we actually used. */
    if (tvdlPtr->unloadProcPtr != NULL) {
	(*tvdlPtr->unloadProcPtr)(tvdlPtr->clientData);
    }
    
    /* Remove the temporary file we created. */
    Tcl_FSDeleteFile(tvdlPtr->divertedFile);
    
    /* And free up the allocations */
    Tcl_DecrRefCount(tvdlPtr->divertedFile);
    ckfree((char*)tvdlPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSReadlink --
 *
 *	This function replaces the library version of readlink().
 *	The appropriate function for the filesystem to which pathPtr
 *	belongs will be called.
 *
 * Results:
 *	The result is a Tcl_Obj specifying the contents
 *	of the symbolic link given by 'path', or NULL if the symbolic
 *	link could not be read.  The result is owned by the caller,
 *	which should call Tcl_DecrRefCount when the result is no longer
 *	needed.
 *
 * Side effects:
 *	See readlink() documentation.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSReadlink(pathPtr)
    Tcl_Obj *pathPtr;		/* Path of file to readlink (UTF-8). */
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSReadlinkProc *proc = fsPtr->readlinkProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr);
	}
    }
    /*
     * If S_IFLNK isn't defined it means that the machine doesn't
     * support symbolic links, so the file can't possibly be a
     * symbolic link.  Generate an EINVAL error, which is what
     * happens on machines that do support symbolic links when
     * you invoke readlink on a file that isn't a symbolic link.
     */
#ifndef S_IFLNK
    errno = EINVAL;
#endif /* S_IFLNK */
    return NULL;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSListVolumes --
 *
 *	Lists the currently mounted volumes.
 *	The chain of functions that have been "inserted" into the
 *	filesystem will be called in succession; each may add to 
 *	the Tcl result, until all mounted file systems are listed.
 *
 * Results:
 *	A standard Tcl result.  Will always be TCL_OK, since there is no way
 *	that this command can fail.  Also, the interpreter's result is set to 
 *	the list of volumes.
 *
 * Side effects:
 *	None
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSListVolumes(interp)
    Tcl_Interp *interp;		/* Interpreter for returning volume list. */
{
    FilesystemRecord *fsRecPtr;

    /*
     * Call each of the "listVolumes" function in succession.
     * A non-NULL return value indicates the particular function has
     * succeeded.  We call all the functions registered, since we want
     * a list of all drives from all filesystems.
     */

    fsRecPtr = FsGetIterator();
    while (fsRecPtr != NULL) {
	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
	if (proc != NULL) {
	    /* Ignore return value */
	    (*proc)(interp);
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    FsReleaseIterator();
    
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSRenameFile --
 *
 *	If the two paths given belong to the same filesystem, we call
 *	that filesystems rename function.  Otherwise we simply
 *	return the posix error 'EXDEV', and -1.
 *
 * Results:
 *      Standard Tcl error code if a function was called.
 *
 * Side effects:
 *	A file may be renamed.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSRenameFile(srcPathPtr, destPathPtr)
    Tcl_Obj* srcPathPtr;	/* Pathname of file or dir to be renamed
				 * (UTF-8). */
    Tcl_Obj *destPathPtr;	/* New pathname of file or directory
				 * (UTF-8). */
{
    int retVal = -1;
    Tcl_Filesystem *fsPtr, *fsPtr2;
    fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
    fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);

    if (fsPtr == fsPtr2 && fsPtr != NULL) {
	Tcl_FSRenameFileProc *proc = fsPtr->renameFileProc;
	if (proc != NULL) {
	    retVal =  (*proc)(srcPathPtr, destPathPtr);
	}
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSCopyFile --
 *
 *	If the two paths given belong to the same filesystem, we call
 *	that filesystem's copy function.  Otherwise we simply
 *	return the posix error 'EXDEV', and -1.
 *
 * Results:
 *      Standard Tcl error code if a function was called.
 *
 * Side effects:
 *	A file may be copied.
 *
 *---------------------------------------------------------------------------
 */

int 
Tcl_FSCopyFile(srcPathPtr, destPathPtr)
    Tcl_Obj* srcPathPtr;	/* Pathname of file to be copied (UTF-8). */
    Tcl_Obj *destPathPtr;	/* Pathname of file to copy to (UTF-8). */
{
    int retVal = -1;
    Tcl_Filesystem *fsPtr, *fsPtr2;
    fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
    fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);

    if (fsPtr == fsPtr2 && fsPtr != NULL) {
	Tcl_FSCopyFileProc *proc = fsPtr->copyFileProc;
	if (proc != NULL) {
	    retVal = (*proc)(srcPathPtr, destPathPtr);
	}
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSDeleteFile --
 *
 *	The appropriate function for the filesystem to which pathPtr
 *	belongs will be called.
 *
 * Results:
 *      Standard Tcl error code.
 *
 * Side effects:
 *	A file may be deleted.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSDeleteFile(pathPtr)
    Tcl_Obj *pathPtr;		/* Pathname of file to be removed (UTF-8). */
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSDeleteFileProc *proc = fsPtr->deleteFileProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr);
	}
    }
    return -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSCreateDirectory --
 *
 *	The appropriate function for the filesystem to which pathPtr
 *	belongs will be called.
 *
 * Results:
 *      Standard Tcl error code.
 *
 * Side effects:
 *	A directory may be created.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSCreateDirectory(pathPtr)
    Tcl_Obj *pathPtr;		/* Pathname of directory to create (UTF-8). */
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSCreateDirectoryProc *proc = fsPtr->createDirectoryProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr);
	}
    }
    return -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSRenameFile --
 *
 *	If the two paths given belong to the same filesystem, we call
 *	that filesystems copy-directory function.  Otherwise we simply
 *	return the posix error 'EXDEV', and -1.
 *
 * Results:
 *      Standard Tcl error code if a function was called.
 *
 * Side effects:
 *	A directory may be copied.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
    Tcl_Obj* srcPathPtr;	/* Pathname of directory to be copied
				 * (UTF-8). */
    Tcl_Obj *destPathPtr;	/* Pathname of target directory (UTF-8). */
    Tcl_Obj **errorPtr;	        /* If non-NULL, then will be set to a
                       	         * new object containing name of file
                       	         * causing error, with refCount 1. */
{
    int retVal = -1;
    Tcl_Filesystem *fsPtr, *fsPtr2;
    fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
    fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);

    if (fsPtr == fsPtr2 && fsPtr != NULL) {
	Tcl_FSCopyDirectoryProc *proc = fsPtr->copyDirectoryProc;
	if (proc != NULL) {
	    retVal = (*proc)(srcPathPtr, destPathPtr, errorPtr);
	}
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSRemoveDirectory --
 *
 *	The appropriate function for the filesystem to which pathPtr
 *	belongs will be called.
 *
 * Results:
 *      Standard Tcl error code.
 *
 * Side effects:
 *	A directory may be deleted.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
    Tcl_Obj *pathPtr;		/* Pathname of directory to be removed
				 * (UTF-8). */
    int recursive;		/* If non-zero, removes directories that
				 * are nonempty.  Otherwise, will only remove
				 * empty directories. */
    Tcl_Obj **errorPtr;	        /* If non-NULL, then will be set to a
				 * new object containing name of file
				 * causing error, with refCount 1. */
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSRemoveDirectoryProc *proc = fsPtr->removeDirectoryProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr, recursive, errorPtr);
	}
    }
    return -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSConvertToPathType --
 *
 *      This function 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).
 *
 * Results:
 *      Standard Tcl error code.
 *
 * Side effects:
 *	The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

int 
Tcl_FSConvertToPathType(interp, objPtr)
    Tcl_Interp *interp;		/* Interpreter in which to store error
				 * message (if necessary). */
    Tcl_Obj *objPtr;		/* Object to convert to a valid, current
                    		 * path type. */
{
    /* 
     * 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 (objPtr->typePtr == &tclFsPathType) {
	FsPath *fsPathPtr = (FsPath*) objPtr->internalRep.otherValuePtr;
	if (fsPathPtr->cwdPtr == NULL) {
	    return TCL_OK;
	} else {
	    if (FsCwdPointerEquals(fsPathPtr->cwdPtr)) {
		return TCL_OK;
	    } else {
		FreeFsPathInternalRep(objPtr);
		objPtr->typePtr = NULL;
		return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
	    }
	}
    } else {
	return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
    }
}


/* 
 * Helper function for SetFsPathFromAny.  Returns position of first
 * directory delimiter in the path.
 */
static int
FindSplitPos(path, separator)
    char *path;
    char *separator;
{
    int count = 0;
    switch (tclPlatform) {
	case TCL_PLATFORM_UNIX:
	case TCL_PLATFORM_MAC:
	    while (path[count] != 0) {
	        if (path[count] == *separator) {
	            return count;
	        }
	        count++;
	    }
	    break;

	case TCL_PLATFORM_WINDOWS:
	    while (path[count] != 0) {
		if (path[count] == *separator || path[count] == '\\') {
		    return count;
		}
		count++;
	    }
	    break;
    }
    return count;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetFsPathFromAbsoluteNormalized --
 *
 *      Like SetFsPathFromAny, but assumes the given object is an
 *      absolute normalized path. Only for internal use.
 *      
 * Results:
 *      Standard Tcl error code.
 *
 * Side effects:
 *	The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

static int
SetFsPathFromAbsoluteNormalized(interp, objPtr)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr;		/* The object to convert. */
{
    FsPath *fsPathPtr;

    if (objPtr->typePtr == &tclFsPathType) {
        return TCL_OK;
    }
    
    /* Free old representation */
    if (objPtr->typePtr != NULL) {
	if (objPtr->bytes == NULL) {
	    objPtr->typePtr->updateStringProc(objPtr);
	}
	if ((objPtr->typePtr->freeIntRepProc) != NULL) {
	    (*objPtr->typePtr->freeIntRepProc)(objPtr);
	}
    }

    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
    /* It's a pure normalized absolute path */
    fsPathPtr->translatedPathPtr = NULL;
    fsPathPtr->normPathPtr = objPtr;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsRecPtr = NULL;
    fsPathPtr->filesystemEpoch = -1;

    objPtr->internalRep.otherValuePtr = fsPathPtr;
    objPtr->typePtr = &tclFsPathType;

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetFsPathFromAny --
 *
 *      This function tries to convert the given Tcl_Obj to a valid
 *      Tcl path type.
 *      
 *      The filename may begin with "~" (to indicate current user's
 *      home directory) or "~<user>" (to indicate any user's home
 *      directory).
 *
 * Results:
 *      Standard Tcl error code.
 *
 * Side effects:
 *	The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

static int
SetFsPathFromAny(interp, objPtr)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr;		/* The object to convert. */
{
    int len;
    FsPath *fsPathPtr;
    Tcl_DString buffer;
    char *name;
    
    if (objPtr->typePtr == &tclFsPathType) {
	return TCL_OK;
    }
    
    /* Free old representation */
    if (objPtr->typePtr != NULL) {
	if (objPtr->bytes == NULL) {
	    objPtr->typePtr->updateStringProc(objPtr);
	}
	if ((objPtr->typePtr->freeIntRepProc) != NULL) {
	    (*objPtr->typePtr->freeIntRepProc)(objPtr);
	}
    }

    /* 
     * 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(objPtr,&len);

    /*
     * Handle tilde substitutions, if needed.
     */
    if (name[0] == '~') {
	char *expandedUser;
	Tcl_DString temp;
	int split;
	char separator='/';
	
	if (tclPlatform==TCL_PLATFORM_MAC) {
		if (strchr(name, ':') != NULL) separator = ':';
	}
	
	split = FindSplitPos(name, &separator);
	if (split != len) {
	    /* We have multiple pieces '~user/foo/bar...' */
	    name[split] = '\0';
	}
	/* Do some tilde substitution */
	if (name[1] == '\0') {
	    /* We have just '~' */
	    char *dir;
	    Tcl_DString dirString;
	    if (split != len) { name[split] = separator; }
	    
	    dir = TclGetEnv("HOME", &dirString);
	    if (dir == NULL) {
		if (interp) {
		    Tcl_ResetResult(interp);
		    Tcl_AppendResult(interp, "couldn't find HOME environment ",
			    "variable to expand path", (char *) NULL);
		}
		return TCL_ERROR;
	    }
	    Tcl_DStringInit(&temp);
	    Tcl_JoinPath(1, &dir, &temp);
	    Tcl_DStringFree(&dirString);
	} else {
	    /* We have a user name '~user' */
	    Tcl_DStringInit(&temp);
	    if (TclpGetUserHome(name+1, &temp) == NULL) {	
		if (interp) {
		    Tcl_ResetResult(interp);
		    Tcl_AppendResult(interp, "user \"", (name+1), 
				     "\" doesn't exist", (char *) NULL);
		}
		Tcl_DStringFree(&temp);
		if (split != len) { name[split] = separator; }
		return TCL_ERROR;
	    }
	    if (split != len) { name[split] = separator; }
	}
	expandedUser = Tcl_DStringValue(&temp);

	Tcl_DStringInit(&buffer);
	if (split == len) {
	    /* We have the result we need in the wrong DString */
	    Tcl_DStringAppend(&buffer, expandedUser, Tcl_DStringLength(&temp));
	} else {
	    /* 
	     * Build a simple 2 element list and join it up with
	     * the tilde substitution in place 
	     */
	    char *argv[2];
            argv[0] = expandedUser;
            argv[1] = name+split+1;
	    Tcl_JoinPath(2, argv, &buffer);
	}
	Tcl_DStringFree(&temp);
    } else {
	Tcl_DStringInit(&buffer);
	Tcl_JoinPath(1, &name, &buffer);
    }

    len = Tcl_DStringLength(&buffer);

    /* 
     * Now we have a translated filename in 'buffer', of
     * length 'len'.  This will have forward slashes on
     * Windows, and will not contain any ~user sequences.
     */
    
    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
    fsPathPtr->translatedPathPtr = ckalloc((unsigned)(1+len));
    strcpy(fsPathPtr->translatedPathPtr, Tcl_DStringValue(&buffer));
    Tcl_DStringFree(&buffer);
    fsPathPtr->normPathPtr = NULL;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsRecPtr = NULL;
    fsPathPtr->filesystemEpoch = -1;

    objPtr->internalRep.otherValuePtr = fsPathPtr;
    objPtr->typePtr = &tclFsPathType;

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSNewNativePath --
 *
 *      This function performs the something like that reverse of the 
 *      usual obj->path->nativerep conversions.  If some code retrieves
 *      a path in native form (from, e.g. readlink or a native dialog),
 *      and that path is to be used at the Tcl level, then calling
 *      this function is an efficient way of creating the appropriate
 *      path object type.
 *
 * Results:
 *      NULL or a valid path object pointer, with refCount zero.
 *
 * Side effects:
 *	New memory may be allocated.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSNewNativePath(fromFilesystem, clientData)
    Tcl_Obj* fromFilesystem;
    ClientData clientData;
{
    Tcl_Obj *objPtr;
    FsPath *fsPathPtr, *fsFromPtr;
    Tcl_FSInternalToNormalizedProc *proc;
    
    if (Tcl_FSConvertToPathType(NULL, fromFilesystem) != TCL_OK) {
        return NULL;
    }
    
    fsFromPtr = (FsPath*) fromFilesystem->internalRep.otherValuePtr;

    proc = fsFromPtr->fsRecPtr->fsPtr->internalToNormalizedProc;

    if (proc == NULL) {
        return NULL;
    }
    
    objPtr = (*proc)(clientData);
    if (objPtr == NULL) {
        return NULL;
    }
    
    /* 
     * Free old representation; shouldn't normally be any,
     * but best to be safe. 
     */
    if (objPtr->typePtr != NULL) {
	if (objPtr->bytes == NULL) {
	    objPtr->typePtr->updateStringProc(objPtr);
	}
	if ((objPtr->typePtr->freeIntRepProc) != NULL) {
	    (*objPtr->typePtr->freeIntRepProc)(objPtr);
	}
    }
    
    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
    fsPathPtr->translatedPathPtr = NULL;
    /* Circular reference, by design */
    fsPathPtr->normPathPtr = objPtr;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = clientData;
    fsPathPtr->fsRecPtr = fsFromPtr->fsRecPtr;
    fsPathPtr->filesystemEpoch = fsFromPtr->filesystemEpoch;

    objPtr->internalRep.otherValuePtr = fsPathPtr;
    objPtr->typePtr = &tclFsPathType;
    return objPtr;
}

static void
FreeFsPathInternalRep(pathObjPtr)
    Tcl_Obj *pathObjPtr;	/* Path object with internal rep to free. */
{
    register FsPath* fsPathPtr = 
      (FsPath*) pathObjPtr->internalRep.otherValuePtr;

    if (fsPathPtr->translatedPathPtr != NULL) {
	ckfree((char *) fsPathPtr->translatedPathPtr);
    }
    if (fsPathPtr->normPathPtr != NULL) {
	if (fsPathPtr->normPathPtr != pathObjPtr) {
	    Tcl_DecrRefCount(fsPathPtr->normPathPtr);
	}
	fsPathPtr->normPathPtr = NULL;
    }
    if (fsPathPtr->cwdPtr != NULL) {
	Tcl_DecrRefCount(fsPathPtr->cwdPtr);
    }
    if (fsPathPtr->nativePathPtr != NULL) {
	if (fsPathPtr->fsRecPtr != NULL) {
	    if (fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc != NULL) {
		(*fsPathPtr->fsRecPtr->fsPtr
		   ->freeInternalRepProc)(fsPathPtr->nativePathPtr);
		fsPathPtr->nativePathPtr = NULL;
	    }
	}
    }
    if (fsPathPtr->fsRecPtr != NULL) {
        fsPathPtr->fsRecPtr->refCount--;
    }

    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. */
{
    register FsPath* srcFsPathPtr = 
      (FsPath*) srcPtr->internalRep.otherValuePtr;
    register FsPath* copyFsPathPtr = 
      (FsPath*) ckalloc((unsigned)sizeof(FsPath));
    Tcl_FSDupInternalRepProc *dupProc;
    
    copyPtr->internalRep.otherValuePtr = copyFsPathPtr;

    if (srcFsPathPtr->translatedPathPtr != NULL) {
	copyFsPathPtr->translatedPathPtr = 
	  ckalloc(1+strlen(srcFsPathPtr->translatedPathPtr));
	strcpy(copyFsPathPtr->translatedPathPtr, 
	       srcFsPathPtr->translatedPathPtr);
    } else {
	copyFsPathPtr->translatedPathPtr = NULL;
    }
    
    if (srcFsPathPtr->normPathPtr != NULL) {
	copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
	if (copyFsPathPtr->normPathPtr != copyPtr) {
	    Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
	}
    } else {
	copyFsPathPtr->normPathPtr = NULL;
    }
    
    if (srcFsPathPtr->cwdPtr != NULL) {
	copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr;
	Tcl_IncrRefCount(copyFsPathPtr->cwdPtr);
    } else {
	copyFsPathPtr->cwdPtr = NULL;
    }

    if (srcFsPathPtr->fsRecPtr != NULL 
      && srcFsPathPtr->nativePathPtr != NULL) {
	dupProc = srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc;
	if (dupProc != NULL) {
	    copyFsPathPtr->nativePathPtr = 
	      (*dupProc)(srcFsPathPtr->nativePathPtr);
	} else {
	    copyFsPathPtr->nativePathPtr = NULL;
	}
    } else {
	copyFsPathPtr->nativePathPtr = NULL;
    }
    copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr;
    copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch;
    if (copyFsPathPtr->fsRecPtr != NULL) {
        copyFsPathPtr->fsRecPtr->refCount++;
    }

    copyPtr->typePtr = &tclFsPathType;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetTranslatedPath --
 *
 *      This function attempts to extract the translated path string
 *      from the given Tcl_Obj.  If the translation succeeds (i.e. the
 *      object is a valid path), then it is returned.  Otherwise NULL
 *      will be returned, and an error message may be left in the
 *      interpreter.
 *
 * Results:
 *      NULL or a valid string.
 *
 * Side effects:
 *	Only those of 'Tcl_FSConvertToPathType'
 *
 *---------------------------------------------------------------------------
 */

char* 
Tcl_FSGetTranslatedPath(interp, pathPtr)
    Tcl_Interp *interp;
    Tcl_Obj* pathPtr;
{
    register FsPath* srcFsPathPtr;
    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
	return NULL;
    }
    srcFsPathPtr = (FsPath*) pathPtr->internalRep.otherValuePtr;
    if (srcFsPathPtr->translatedPathPtr == NULL) {
        /* 
         * It is a pure absolute, normalized path object.
         * This is something like being a 'pure list'.  The
         * object's string, translatedPath and normalizedPath
         * are all identical.
         */
	return Tcl_GetString(srcFsPathPtr->normPathPtr);
    } else {
	/* It is an ordinary path object */
	return srcFsPathPtr->translatedPathPtr;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetNormalizedPath --
 *
 *      This important function attempts to extract from the given Tcl_Obj
 *      a unique normalised path representation, whose string value can
 *      be used as a unique identifier for the file.
 *
 * Results:
 *      NULL or a valid path object pointer.
 *
 * Side effects:
 *	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, pathObjPtr)
    Tcl_Interp *interp;
    Tcl_Obj* pathObjPtr;
{
    register FsPath* srcFsPathPtr;
    if (Tcl_FSConvertToPathType(interp, pathObjPtr) != TCL_OK) {
	return NULL;
    }
    srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
    if (srcFsPathPtr->normPathPtr == NULL) {
	int relative = 0;
	char *path = srcFsPathPtr->translatedPathPtr;
	Tcl_DString atemp;
	
	if ((path[0] != '\0') && (Tcl_GetPathType(path) == TCL_PATH_RELATIVE)) {
	    char * pair[2];
	    Tcl_Obj *cwd = Tcl_FSGetCwd(interp);

	    if (cwd == NULL) {
		return NULL;
	    }
		
	    /* 
	     * The efficiency of this piece of code could
	     * be improved, given the new object interfaces.
	     */
	    pair[0] = Tcl_GetString(cwd);
	    pair[1] = path;

	    Tcl_DStringInit(&atemp);
	    Tcl_JoinPath(2, pair, &atemp);
	    path = Tcl_DStringValue(&atemp);
	    Tcl_DecrRefCount(cwd);
	    
	    relative = 1;
	}

	/* Already has refCount incremented */
	srcFsPathPtr->normPathPtr = FSNormalizeAbsolutePath(interp, path);
	if (!strcmp(Tcl_GetString(srcFsPathPtr->normPathPtr),
		    Tcl_GetString(pathObjPtr))) {
	    /* 
	     * The path was already normalized.  
	     * Get rid of the duplicate.
	     */
	    Tcl_DecrRefCount(srcFsPathPtr->normPathPtr);
	    /* 
	     * We do *not* increment the refCount for 
	     * this circular reference 
	     */
	    srcFsPathPtr->normPathPtr = pathObjPtr;
	}
	if (relative) {
	    Tcl_DStringFree(&atemp);

	    /* Get a quick, temporary lock on the cwd while we copy it */
	    Tcl_MutexLock(&cwdMutex);
	    srcFsPathPtr->cwdPtr = cwdPathPtr;
	    Tcl_IncrRefCount(srcFsPathPtr->cwdPtr);
	    Tcl_MutexUnlock(&cwdMutex);
	}
    }
    return srcFsPathPtr->normPathPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetInternalRep --
 *
 *      Extract the internal representation of a given path object,
 *      in the given filesystem.  If the path object belongs to a
 *      different filesystem, we return NULL.
 *      
 *      If the internal representation is currently NULL, we attempt
 *      to generate it, by calling the filesystem's 
 *      'Tcl_FSCreateInternalRepProc'.
 *
 * Results:
 *      NULL or a valid internal representation.
 *
 * Side effects:
 *	An attempt may be made to convert the object.
 *
 *---------------------------------------------------------------------------
 */

ClientData 
Tcl_FSGetInternalRep(pathObjPtr, fsPtr)
    Tcl_Obj* pathObjPtr;
    Tcl_Filesystem *fsPtr;
{
    register FsPath* srcFsPathPtr;
    
    if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) {
	return NULL;
    }
    srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
    
    /* 
     * 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
     * another.  Another way of putting this is that 'stacked'
     * filesystems are not allowed.  We recognise that this is a
     * potentially useful feature for the future.
     * 
     * Even something simple like a 'pass through' filesystem which
     * logs all activity and passes the calls onto the native system
     * would be nice, but not easily achievable with the current
     * implementation.
     */
    if (srcFsPathPtr->fsRecPtr == NULL) {
	/* 
	 * This only usually happens in wrappers like TclpStat which
	 * 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(pathObjPtr);
    }

    if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) {
	return NULL;
    }

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

	if (proc == NULL) {
	    return NULL;
	}
	srcFsPathPtr->nativePathPtr = (*proc)(pathObjPtr);
    }
    return srcFsPathPtr->nativePathPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetNativePath --
 *
 *      This function is for use by the Win/Unix/MacOS native filesystems,
 *      so that they can easily retrieve the native (char* or TCHAR*)
 *      representation of a path.  Other filesystems will probably
 *      want to implement similar functions.  They basically act as a 
 *      safety net around Tcl_FSGetInternalRep.  Normally your file-
 *      system procedures will always be called with path objects
 *      already converted to the correct filesystem, but if for 
 *      some reason they are called directly (i.e. by procedures 
 *      not in this file), then one cannot necessarily guarantee that
 *      the path object pointer is from the correct filesystem.
 *      
 *      Note: in the future it might be desireable to have separate
 *      versions of this function with different signatures, for
 *      example Tcl_FSGetNativeMacPath, Tcl_FSGetNativeUnixPath etc.
 *      Right now, since native paths are all string based, we use just
 *      one function.  On MacOS we could possibly use an FSSpec or
 *      FSRef as the native representation.
 *
 * Results:
 *      NULL or a valid native path.
 *
 * Side effects:
 *	See Tcl_FSGetInternalRep.
 *
 *---------------------------------------------------------------------------
 */

char* 
Tcl_FSGetNativePath(pathObjPtr)
    Tcl_Obj* pathObjPtr;
{
    return (char*)Tcl_FSGetInternalRep(pathObjPtr, &nativeFilesystem);
}

/*
 *---------------------------------------------------------------------------
 *
 * NativeCreateNativeRep --
 *
 *      Create a native representation for the given path.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
ClientData 
NativeCreateNativeRep(pathObjPtr)
    Tcl_Obj* pathObjPtr;
{
    char *nativePathPtr;
    Tcl_DString ds;
    Tcl_Obj* normPtr;
    int len;
    char *str;

    /* Make sure the normalized path is set */
    normPtr = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);

    str = Tcl_GetStringFromObj(normPtr,&len);
#ifdef __WIN32__
    Tcl_WinUtfToTChar(str, len, &ds);
    nativePathPtr = ckalloc((unsigned)(2+Tcl_DStringLength(&ds)));
    memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), 
	   (size_t) (2+Tcl_DStringLength(&ds)));
#else
    Tcl_UtfToExternalDString(NULL, str, len, &ds);
    nativePathPtr = ckalloc((unsigned)(1+Tcl_DStringLength(&ds)));
    memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), 
	  (size_t) (1+Tcl_DStringLength(&ds)));
#endif
	  
    Tcl_DStringFree(&ds);
    return (ClientData)nativePathPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpNativeToNormalized --
 *
 *      Convert native format to a normalized path object, with refCount
 *      of zero.
 *
 * Results:
 *      A valid normalized path.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj* 
TclpNativeToNormalized(clientData)
    ClientData clientData;
{
    Tcl_DString ds;
    Tcl_Obj *objPtr;
    
#ifdef __WIN32__
    Tcl_WinTCharToUtf((char*)clientData, -1, &ds);
#else
    Tcl_ExternalToUtfDString(NULL, (char*)clientData, -1, &ds);
#endif
    objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
    Tcl_DStringFree(&ds);
    
    return objPtr;
}


/*
 *---------------------------------------------------------------------------
 *
 * NativeDupInternalRep --
 *
 *      Duplicate the native representation.
 *
 * Results:
 *      The copied native representation, or NULL if it is not possible
 *      to copy the representation.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
ClientData 
NativeDupInternalRep(clientData)
    ClientData clientData;
{
#ifdef __WIN32__
    /* Copying internal representations is complicated with multi-byte TChars */
    return NULL;
#else
    if (clientData == NULL) {
        return NULL;
    } else {
	char *native = (char*)clientData;
	char *copy = ckalloc((unsigned)(1+strlen(native)));
	strcpy(copy,native);
	return (ClientData)copy;
    }
#endif
}

/*
 *---------------------------------------------------------------------------
 *
 * NativePathInFilesystem --
 *
 *      Any path object is acceptable to the native filesystem, by
 *      default (we will throw errors when illegal paths are actually
 *      tried to be used).
 *
 * Results:
 *      TCL_OK, to indicate 'yes', -1 to indicate no.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
int 
NativePathInFilesystem(pathPtr, clientDataPtr)
    Tcl_Obj *pathPtr;
    ClientData *clientDataPtr;
{
    int len;
    Tcl_GetStringFromObj(pathPtr,&len);
    if (len == 0) {
        return -1;
    } else {
	/* We accept any path as valid */
	return TCL_OK;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * NativeFreeInternalRep --
 *
 *      Free a native internal representation, which will be non-NULL.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *	Memory is released.
 *
 *---------------------------------------------------------------------------
 */
void 
NativeFreeInternalRep(clientData)
    ClientData clientData;
{
    ckfree((char*)clientData);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSFileSystemInfo --
 *
 *      This function returns a list of two elements.  The first
 *      element is the name of the filesystem (e.g. "native" or "vfs"),
 *      and the second is the particular type of the given path within
 *      that filesystem.
 *
 * Results:
 *      A list of two elements.
 *
 * Side effects:
 *	The object may be converted to a path type.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj*
Tcl_FSFileSystemInfo(pathObjPtr)
    Tcl_Obj* pathObjPtr;
{
    Tcl_Obj *resPtr;
    Tcl_FSFilesystemPathTypeProc *proc;
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr);
    
    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)(pathObjPtr);
	if (typePtr != NULL) {
	    Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
	}
    }
    
    return resPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSPathSeparator --
 *
 *      This function returns the separator to be used for a given
 *      path.  The object returned should have a refCount of zero
 *
 * Results:
 *      A Tcl object, with a refCount of zero.  If the caller
 *      needs to retain a reference to the object, it should
 *      call Tcl_IncrRefCount.
 *
 * Side effects:
 *	The path object may be converted to a path type.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj*
Tcl_FSPathSeparator(pathObjPtr)
    Tcl_Obj* pathObjPtr;
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr);
    
    if (fsPtr == NULL) {
	return NULL;
    }
    if (fsPtr->filesystemSeparatorProc != NULL) {
	return (*fsPtr->filesystemSeparatorProc)(pathObjPtr);
    }
    
    return NULL;
}

/*
 *---------------------------------------------------------------------------
 *
 * NativeFilesystemSeparator --
 *
 *      This function is part of the native filesystem support, and
 *      returns the separator for the given path.
 *
 * Results:
 *      String object containing the separator character.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj*
NativeFilesystemSeparator(pathObjPtr)
    Tcl_Obj* pathObjPtr;
{
    char *separator = NULL; /* lint */
    switch (tclPlatform) {
	case TCL_PLATFORM_UNIX:
	    separator = "/";
	    break;
	case TCL_PLATFORM_WINDOWS:
	    separator = "\\";
	    break;
	case TCL_PLATFORM_MAC:
	    separator = ":";
	    break;
    }
    return Tcl_NewStringObj(separator,1);
}

/*
 *---------------------------------------------------------------------------
 *
 * NativeFilesystemPathType --
 *
 *      This function is part of the native filesystem support, and
 *      returns the path type of the given path.  Right now it simply
 *      returns NULL.  In the future it could return specific path
 *      types, like 'network' for a natively-networked path, etc.
 *
 * Results:
 *      NULL at present.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj*
NativeFilesystemPathType(pathObjPtr)
    Tcl_Obj* pathObjPtr;
{
    /* All native paths are of the same type */
    return NULL;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetFileSystemForPath --
 *
 *      This function determines which filesystem to use for a
 *      particular path object, and returns the filesystem which
 *      accepts this file.  If no filesystem will accept this object
 *      as a valid file path, then NULL is returned.
 *
 * Results:
 *      NULL or a filesystem which will accept this path.
 *
 * Side effects:
 *	The object may be converted to a path type.
 *
 *---------------------------------------------------------------------------
 */

static Tcl_Filesystem*
Tcl_FSGetFileSystemForPath(pathObjPtr)
    Tcl_Obj* pathObjPtr;
{
    FilesystemRecord *fsRecPtr;
    Tcl_Filesystem* retVal = NULL;
    FsPath* srcFsPathPtr;
    
    /* Make sure pathObjPtr is of our type */

    if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) {
	return NULL;
    }
    
    if (Tcl_FSGetNormalizedPath(NULL, pathObjPtr) == NULL) {
	return NULL;
    }
    
    /* 
     * Get a lock on filesystemEpoch and the filesystemList
     * 
     * While we don't need the fsRecPtr until the while loop
     * below, we do want to make sure the filesystemEpoch doesn't
     * change between the 'if' and 'while' blocks, getting this
     * iterator will ensure that everything is consistent
     */
    fsRecPtr = FsGetIterator();
    
    /* Make sure pathObjPtr is of the correct epoch */
    
    srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
    
    if (srcFsPathPtr->filesystemEpoch != -1) {
	/* 
	 * Check if the filesystem has changed in some way since
	 * this object's internal representation was calculated.
	 */
	if (srcFsPathPtr->filesystemEpoch != filesystemEpoch) {
	    /* 
	     * We have to discard the stale representation and 
	     * recalculate it 
	     */
	    FreeFsPathInternalRep(pathObjPtr);
	    pathObjPtr->typePtr = NULL;
	    if (SetFsPathFromAny(NULL, pathObjPtr) != TCL_OK) {
	        goto done;
	    }
	    srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
	}
    }
    
    /* Check whether the object is already assigned to a fs */
    if (srcFsPathPtr->fsRecPtr != NULL) {
        retVal = srcFsPathPtr->fsRecPtr->fsPtr;
        goto done;
    }
    
    /*
     * Call each of the "pathInFilesystem" functions in succession.  A
     * non-return value of -1 indicates the particular function has
     * succeeded.
     */

    while ((retVal == NULL) && (fsRecPtr != NULL)) {
	Tcl_FSPathInFilesystemProc *proc = fsRecPtr->fsPtr->pathInFilesystemProc;
	if (proc != NULL) {
	    ClientData clientData = NULL;
	    int ret = (*proc)(pathObjPtr, &clientData);
	    if (ret != -1) {
		/* 
		 * We assume the srcFsPathPtr hasn't been changed 
		 * by the above call to the pathInFilesystemProc.
		 */
		srcFsPathPtr->fsRecPtr = fsRecPtr;
		srcFsPathPtr->nativePathPtr = clientData;
		srcFsPathPtr->filesystemEpoch = filesystemEpoch;
		fsRecPtr->refCount++;
		retVal = fsRecPtr->fsPtr;
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

  done:
    FsReleaseIterator();
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSEqualPaths --
 *
 *      This function tests whether the two paths given are equal path
 *      objects.
 *
 * Results:
 *      1 or 0.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int 
Tcl_FSEqualPaths(firstPtr, secondPtr)
    Tcl_Obj* firstPtr;
    Tcl_Obj* secondPtr;
{
    if (firstPtr == secondPtr) {
        return 1;
    } else {
        int tempErrno;

	if (firstPtr == NULL || secondPtr == NULL) {
	    return 0;
	}
	if (!(strcmp(Tcl_GetString(firstPtr), Tcl_GetString(secondPtr)))) {
	    return 1;
	}
	/* 
         * Try the most thorough, correct method of comparing fully
         * normalized paths
         */

	tempErrno = Tcl_GetErrno();
	firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr);
	secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr);
	Tcl_SetErrno(tempErrno);

	if (firstPtr == NULL || secondPtr == NULL) {
	    return 0;
	}
	if (!(strcmp(Tcl_GetString(firstPtr), Tcl_GetString(secondPtr)))) {
	    return 1;
	}
    }
    return 0;
}

/* Wrappers */

Tcl_Channel 
NativeOpenFileChannel(interp, pathPtr, modeString, permissions)
    Tcl_Interp *interp;
    Tcl_Obj *pathPtr;
    char *modeString;
    int permissions;
{
    char *trans = Tcl_FSGetTranslatedPath(interp, pathPtr);
    if (trans == NULL) {
	return NULL;
    }
    return TclpOpenFileChannel(interp, trans, modeString, permissions);
}

/* 
 * utime wants a normalized, NOT native path.  I assume a native
 * version of 'utime' doesn't exist (at least under that name) on NT/2000.
 * If a native function does exist somewhere, then we could use:
 * 
 *   return native_utime(Tcl_FSGetNativePath(pathPtr),tval);
 *   
 * This seems rather strange when compared with stat, lstat, access, etc.
 * all of which want a native path.
 */
int 
NativeUtime(pathPtr, tval)
    Tcl_Obj *pathPtr;
    struct utimbuf *tval;
{
	#ifdef MAC_TCL
	long gmt_offset=TclpGetGMTOffset();
	struct utimbuf local_tval;
	local_tval.actime=tval->actime+gmt_offset;
	local_tval.modtime=tval->modtime+gmt_offset;
    return utime(Tcl_GetString(Tcl_FSGetNormalizedPath(NULL,pathPtr)),&local_tval);
	#else
    return utime(Tcl_GetString(Tcl_FSGetNormalizedPath(NULL,pathPtr)),tval);
    #endif
}

int 
NativeLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
    Tcl_Interp * interp; 
    Tcl_Obj *pathPtr;
    char * sym1;
    char * sym2; 
    Tcl_PackageInitProc ** proc1Ptr; 
    Tcl_PackageInitProc ** proc2Ptr; 
    ClientData * clientDataPtr;
{
    return TclpLoadFile(interp, Tcl_FSGetTranslatedPath(NULL, pathPtr), 
			sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr);
}

/* Everything from here on is contained in this obsolete ifdef */
#ifdef USE_OBSOLETE_FS_HOOKS

/*
 *----------------------------------------------------------------------
 *
 * TclStatInsertProc --
 *
 *	Insert the passed procedure pointer at the head of the list of
 *	functions which are used during a call to 'TclStat(...)'. The