sl@0: /* 
sl@0:  * tclMacFCmd.c --
sl@0:  *
sl@0:  * Implements the Macintosh specific portions of the file manipulation
sl@0:  * subcommands of the "file" command.
sl@0:  *
sl@0:  * Copyright (c) 1996-1998 Sun Microsystems, Inc.
sl@0:  *
sl@0:  * See the file "license.terms" for information on usage and redistribution
sl@0:  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclMacFCmd.c,v 1.19 2003/02/04 17:06:51 vincentdarley Exp $
sl@0:  */
sl@0: 
sl@0: #include "tclInt.h"
sl@0: #include "tclMac.h"
sl@0: #include "tclMacInt.h"
sl@0: #include "tclPort.h"
sl@0: #include <FSpCompat.h>
sl@0: #include <MoreFilesExtras.h>
sl@0: #include <Strings.h>
sl@0: #include <Errors.h>
sl@0: #include <FileCopy.h>
sl@0: #include <DirectoryCopy.h>
sl@0: #include <Script.h>
sl@0: #include <string.h>
sl@0: #include <Finder.h>
sl@0: #include <Aliases.h>
sl@0: 
sl@0: /*
sl@0:  * Callback for the file attributes code.
sl@0:  */
sl@0: 
sl@0: static int		GetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
sl@0: 			    int objIndex, Tcl_Obj *fileName,
sl@0: 			    Tcl_Obj **attributePtrPtr));
sl@0: static int		GetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
sl@0: 			    int objIndex, Tcl_Obj *fileName,
sl@0: 			    Tcl_Obj **readOnlyPtrPtr));
sl@0: static int		SetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
sl@0: 			    int objIndex, Tcl_Obj *fileName,
sl@0: 			    Tcl_Obj *attributePtr));
sl@0: static int		SetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
sl@0: 			    int objIndex, Tcl_Obj *fileName,
sl@0: 			    Tcl_Obj *readOnlyPtr));
sl@0: 
sl@0: /*
sl@0:  * These are indeces into the tclpFileAttrsStrings table below.
sl@0:  */
sl@0: 
sl@0: #define MAC_CREATOR_ATTRIBUTE	0
sl@0: #define MAC_HIDDEN_ATTRIBUTE	1
sl@0: #define MAC_READONLY_ATTRIBUTE	2
sl@0: #define MAC_TYPE_ATTRIBUTE	3
sl@0: 
sl@0: /*
sl@0:  * Global variables for the file attributes code.
sl@0:  */
sl@0: 
sl@0: CONST char *tclpFileAttrStrings[] = {"-creator", "-hidden", "-readonly",
sl@0: 	"-type", (char *) NULL};
sl@0: CONST TclFileAttrProcs tclpFileAttrProcs[] = {
sl@0: 	{GetFileFinderAttributes, SetFileFinderAttributes},
sl@0: 	{GetFileFinderAttributes, SetFileFinderAttributes},
sl@0: 	{GetFileReadOnly, SetFileReadOnly},
sl@0: 	{GetFileFinderAttributes, SetFileFinderAttributes}};
sl@0: 
sl@0: /*
sl@0:  * File specific static data
sl@0:  */
sl@0: 
sl@0: static long startSeed = 248923489;
sl@0: 
sl@0: /*
sl@0:  * Prototypes for procedure only used in this file
sl@0:  */
sl@0: 
sl@0: static pascal Boolean 	CopyErrHandler _ANSI_ARGS_((OSErr error, 
sl@0: 			    short failedOperation,
sl@0: 			    short srcVRefNum, long srcDirID,
sl@0: 			    ConstStr255Param srcName, short dstVRefNum,
sl@0: 			    long dstDirID,ConstStr255Param dstName));
sl@0: static int		DoCopyDirectory _ANSI_ARGS_((CONST char *src,
sl@0: 			    CONST char *dst, Tcl_DString *errorPtr));
sl@0: static int		DoCopyFile _ANSI_ARGS_((CONST char *src, 
sl@0: 			    CONST char *dst));
sl@0: static int		DoCreateDirectory _ANSI_ARGS_((CONST char *path));
sl@0: static int		DoRemoveDirectory _ANSI_ARGS_((CONST char *path, 
sl@0: 			    int recursive, Tcl_DString *errorPtr));
sl@0: static int		DoRenameFile _ANSI_ARGS_((CONST char *src,
sl@0: 			    CONST char *dst));
sl@0: OSErr			FSpGetFLockCompat _ANSI_ARGS_((const FSSpec *specPtr, 
sl@0: 			    Boolean *lockedPtr));
sl@0: static OSErr		GetFileSpecs _ANSI_ARGS_((CONST char *path, 
sl@0: 			    FSSpec *pathSpecPtr, FSSpec *dirSpecPtr,	
sl@0: 			    Boolean *pathExistsPtr, 
sl@0: 			    Boolean *pathIsDirectoryPtr));
sl@0: static OSErr		MoveRename _ANSI_ARGS_((const FSSpec *srcSpecPtr, 
sl@0: 			    const FSSpec *dstSpecPtr, StringPtr copyName));
sl@0: static int		Pstrequal _ANSI_ARGS_((ConstStr255Param stringA, 
sl@0: 			    ConstStr255Param stringB));
sl@0:                  
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpObjRenameFile, DoRenameFile --
sl@0:  *
sl@0:  *      Changes the name of an existing file or directory, from src to dst.
sl@0:  *	If src and dst refer to the same file or directory, does nothing
sl@0:  *	and returns success.  Otherwise if dst already exists, it will be
sl@0:  *	deleted and replaced by src subject to the following conditions:
sl@0:  *	    If src is a directory, dst may be an empty directory.
sl@0:  *	    If src is a file, dst may be a file.
sl@0:  *	In any other situation where dst already exists, the rename will
sl@0:  *	fail.  
sl@0:  *
sl@0:  * Results:
sl@0:  *	If the directory was successfully created, returns TCL_OK.
sl@0:  *	Otherwise the return value is TCL_ERROR and errno is set to
sl@0:  *	indicate the error.  Some possible values for errno are:
sl@0:  *
sl@0:  *	EACCES:     src or dst parent directory can't be read and/or written.
sl@0:  *	EEXIST:	    dst is a non-empty directory.
sl@0:  *	EINVAL:	    src is a root directory or dst is a subdirectory of src.
sl@0:  *	EISDIR:	    dst is a directory, but src is not.
sl@0:  *	ENOENT:	    src doesn't exist.  src or dst is "".
sl@0:  *	ENOTDIR:    src is a directory, but dst is not.  
sl@0:  *	EXDEV:	    src and dst are on different filesystems.
sl@0:  *	
sl@0:  * Side effects:
sl@0:  *	The implementation of rename may allow cross-filesystem renames,
sl@0:  *	but the caller should be prepared to emulate it with copy and
sl@0:  *	delete if errno is EXDEV.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int 
sl@0: TclpObjRenameFile(srcPathPtr, destPathPtr)
sl@0:     Tcl_Obj *srcPathPtr;
sl@0:     Tcl_Obj *destPathPtr;
sl@0: {
sl@0:     return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
sl@0: 			Tcl_FSGetNativePath(destPathPtr));
sl@0: }
sl@0: 
sl@0: static int
sl@0: DoRenameFile(
sl@0:     CONST char *src,		/* Pathname of file or dir to be renamed
sl@0: 				 * (native). */
sl@0:     CONST char *dst)		/* New pathname of file or directory
sl@0: 				 * (native). */
sl@0: {
sl@0:     FSSpec srcFileSpec, dstFileSpec, dstDirSpec;
sl@0:     OSErr err; 
sl@0:     long srcID, dummy;
sl@0:     Boolean srcIsDirectory, dstIsDirectory, dstExists, dstLocked;
sl@0: 
sl@0:     err = FSpLLocationFromPath(strlen(src), src, &srcFileSpec);
sl@0:     if (err == noErr) {
sl@0: 	FSpGetDirectoryID(&srcFileSpec, &srcID, &srcIsDirectory);
sl@0:     }
sl@0:     if (err == noErr) {
sl@0:         err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists, 
sl@0:         	&dstIsDirectory);
sl@0:     }
sl@0:     if (err == noErr) {
sl@0: 	if (dstExists == 0) {
sl@0:             err = MoveRename(&srcFileSpec, &dstDirSpec, dstFileSpec.name);
sl@0:             goto end;
sl@0:         }
sl@0:         err = FSpGetFLockCompat(&dstFileSpec, &dstLocked);
sl@0:         if (dstLocked) {
sl@0:             FSpRstFLockCompat(&dstFileSpec);
sl@0:         }
sl@0:     }
sl@0:     if (err == noErr) {
sl@0:         if (srcIsDirectory) {
sl@0: 	    if (dstIsDirectory) {
sl@0: 		/*
sl@0: 		 * The following call will remove an empty directory.  If it
sl@0: 		 * fails, it's because it wasn't empty.
sl@0: 		 */
sl@0: 		 
sl@0:                 if (DoRemoveDirectory(dst, 0, NULL) != TCL_OK) {
sl@0:                     return TCL_ERROR;
sl@0:                 }
sl@0:                 
sl@0:                 /*
sl@0: 		 * Now that that empty directory is gone, we can try
sl@0: 		 * renaming src.  If that fails, we'll put this empty
sl@0: 		 * directory back, for completeness.
sl@0: 		 */
sl@0: 
sl@0: 		err = MoveRename(&srcFileSpec, &dstDirSpec, dstFileSpec.name);
sl@0:                 if (err != noErr) {
sl@0: 		    FSpDirCreateCompat(&dstFileSpec, smSystemScript, &dummy);
sl@0: 		    if (dstLocked) {
sl@0: 		        FSpSetFLockCompat(&dstFileSpec);
sl@0: 		    }
sl@0: 		}
sl@0: 	    } else {
sl@0: 	        errno = ENOTDIR;
sl@0: 	        return TCL_ERROR;
sl@0: 	    }
sl@0: 	} else {   
sl@0: 	    if (dstIsDirectory) {
sl@0: 		errno = EISDIR;
sl@0: 		return TCL_ERROR;
sl@0: 	    } else {                                
sl@0: 		/*
sl@0: 		 * Overwrite existing file by:
sl@0: 		 * 
sl@0: 		 * 1. Rename existing file to temp name.
sl@0: 		 * 2. Rename old file to new name.
sl@0: 		 * 3. If success, delete temp file.  If failure,
sl@0: 		 *    put temp file back to old name.
sl@0: 		 */
sl@0: 
sl@0: 	        Str31 tmpName;
sl@0: 	        FSSpec tmpFileSpec;
sl@0: 
sl@0: 	        err = GenerateUniqueName(dstFileSpec.vRefNum, &startSeed,
sl@0: 	        	dstFileSpec.parID, dstFileSpec.parID, tmpName);
sl@0: 	        if (err == noErr) {
sl@0: 	            err = FSpRenameCompat(&dstFileSpec, tmpName);
sl@0: 	        }
sl@0: 	        if (err == noErr) {
sl@0: 	            err = FSMakeFSSpecCompat(dstFileSpec.vRefNum,
sl@0: 	            	    dstFileSpec.parID, tmpName, &tmpFileSpec);
sl@0: 	        }
sl@0: 	        if (err == noErr) {
sl@0: 	            err = MoveRename(&srcFileSpec, &dstDirSpec, 
sl@0: 	            	    dstFileSpec.name);
sl@0: 	        }
sl@0: 	        if (err == noErr) {
sl@0: 		    FSpDeleteCompat(&tmpFileSpec);
sl@0: 		} else {
sl@0: 		    FSpDeleteCompat(&dstFileSpec);
sl@0: 		    FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
sl@0: 	            if (dstLocked) {
sl@0: 	            	FSpSetFLockCompat(&dstFileSpec);
sl@0: 	            }
sl@0: 	        }
sl@0: 	    }
sl@0:    	}
sl@0:     }    
sl@0: 
sl@0:     end:    
sl@0:     if (err != noErr) {
sl@0: 	errno = TclMacOSErrorToPosixError(err);
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *--------------------------------------------------------------------------
sl@0:  *
sl@0:  * MoveRename --
sl@0:  *
sl@0:  *	Helper function for TclpRenameFile.  Renames a file or directory
sl@0:  *	into the same directory or another directory.  The target name
sl@0:  * 	must not already exist in the destination directory.
sl@0:  *
sl@0:  *	Don't use FSpMoveRenameCompat because it doesn't work with
sl@0:  *	directories or with locked files. 
sl@0:  *
sl@0:  * Results:
sl@0:  *	Returns a mac error indicating the cause of the failure.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Creates a temp file in the target directory to handle a rename
sl@0:  *	between directories.
sl@0:  *
sl@0:  *--------------------------------------------------------------------------
sl@0:  */
sl@0:   
sl@0: static OSErr		
sl@0: MoveRename(
sl@0:     const FSSpec *srcFileSpecPtr,   /* Source object. */
sl@0:     const FSSpec *dstDirSpecPtr,    /* Destination directory. */
sl@0:     StringPtr copyName)		    /* New name for object in destination 
sl@0:     				     * directory. */
sl@0: {
sl@0:     OSErr err;
sl@0:     long srcID, dstID;
sl@0:     Boolean srcIsDir, dstIsDir;
sl@0:     Str31 tmpName;
sl@0:     FSSpec dstFileSpec, srcDirSpec, tmpSrcFileSpec, tmpDstFileSpec;
sl@0:     Boolean locked;
sl@0:     
sl@0:     if (srcFileSpecPtr->parID == 1) {
sl@0:         /*
sl@0:          * Trying to rename a volume.
sl@0:          */
sl@0:           
sl@0:         return badMovErr;
sl@0:     }
sl@0:     if (srcFileSpecPtr->vRefNum != dstDirSpecPtr->vRefNum) {
sl@0: 	/*
sl@0: 	 * Renaming across volumes.
sl@0: 	 */
sl@0: 	 
sl@0:         return diffVolErr;
sl@0:     }
sl@0:     err = FSpGetFLockCompat(srcFileSpecPtr, &locked);
sl@0:     if (locked) {
sl@0:         FSpRstFLockCompat(srcFileSpecPtr);
sl@0:     }
sl@0:     if (err == noErr) {
sl@0: 	err = FSpGetDirectoryID(dstDirSpecPtr, &dstID, &dstIsDir);
sl@0:     }
sl@0:     if (err == noErr) {
sl@0:         if (srcFileSpecPtr->parID == dstID) {
sl@0:             /*
sl@0:              * Renaming object within directory. 
sl@0:              */
sl@0:             
sl@0:             err = FSpRenameCompat(srcFileSpecPtr, copyName);
sl@0:             goto done; 
sl@0:         }
sl@0:         if (Pstrequal(srcFileSpecPtr->name, copyName)) {
sl@0: 	    /*
sl@0: 	     * Moving object to another directory (under same name). 
sl@0: 	     */
sl@0: 	 
sl@0: 	    err = FSpCatMoveCompat(srcFileSpecPtr, dstDirSpecPtr);
sl@0: 	    goto done; 
sl@0:         } 
sl@0:         err = FSpGetDirectoryID(srcFileSpecPtr, &srcID, &srcIsDir);
sl@0:     } 
sl@0:     if (err == noErr) {
sl@0:         /*
sl@0:          * Fullblown: rename source object to temp name, move temp to
sl@0:          * dest directory, and rename temp to target.
sl@0:          */
sl@0:           
sl@0:         err = GenerateUniqueName(srcFileSpecPtr->vRefNum, &startSeed,
sl@0:        		srcFileSpecPtr->parID, dstID, tmpName);
sl@0:         FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
sl@0:          	tmpName, &tmpSrcFileSpec);
sl@0:         FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum, dstID, tmpName,
sl@0:          	&tmpDstFileSpec);
sl@0:     }
sl@0:     if (err == noErr) {
sl@0:         err = FSpRenameCompat(srcFileSpecPtr, tmpName);
sl@0:     }
sl@0:     if (err == noErr) {
sl@0:         err = FSpCatMoveCompat(&tmpSrcFileSpec, dstDirSpecPtr);
sl@0:         if (err == noErr) {
sl@0:             err = FSpRenameCompat(&tmpDstFileSpec, copyName);
sl@0:             if (err == noErr) {
sl@0:                 goto done;
sl@0:             }
sl@0:             FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
sl@0:              	    NULL, &srcDirSpec);
sl@0:             FSpCatMoveCompat(&tmpDstFileSpec, &srcDirSpec);
sl@0:         }                 
sl@0:         FSpRenameCompat(&tmpSrcFileSpec, srcFileSpecPtr->name);
sl@0:     }
sl@0:     
sl@0:     done:
sl@0:     if (locked != false) {
sl@0:     	if (err == noErr) {
sl@0: 	    FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum, 
sl@0: 	    	    dstID, copyName, &dstFileSpec);
sl@0:             FSpSetFLockCompat(&dstFileSpec);
sl@0:         } else {
sl@0:             FSpSetFLockCompat(srcFileSpecPtr);
sl@0:         }
sl@0:     }
sl@0:     return err;
sl@0: }     
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpObjCopyFile, DoCopyFile --
sl@0:  *
sl@0:  *      Copy a single file (not a directory).  If dst already exists and
sl@0:  *	is not a directory, it is removed.
sl@0:  *
sl@0:  * Results:
sl@0:  *	If the file was successfully copied, returns TCL_OK.  Otherwise
sl@0:  *	the return value is TCL_ERROR and errno is set to indicate the
sl@0:  *	error.  Some possible values for errno are:
sl@0:  *
sl@0:  *	EACCES:     src or dst parent directory can't be read and/or written.
sl@0:  *	EISDIR:	    src or dst is a directory.
sl@0:  *	ENOENT:	    src doesn't exist.  src or dst is "".
sl@0:  *
sl@0:  * Side effects:
sl@0:  *      This procedure will also copy symbolic links, block, and
sl@0:  *      character devices, and fifos.  For symbolic links, the links 
sl@0:  *      themselves will be copied and not what they point to.  For the
sl@0:  *	other special file types, the directory entry will be copied and
sl@0:  *	not the contents of the device that it refers to.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0:  
sl@0: int 
sl@0: TclpObjCopyFile(srcPathPtr, destPathPtr)
sl@0:     Tcl_Obj *srcPathPtr;
sl@0:     Tcl_Obj *destPathPtr;
sl@0: {
sl@0:     return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
sl@0: 		      Tcl_FSGetNativePath(destPathPtr));
sl@0: }
sl@0: 
sl@0: static int
sl@0: DoCopyFile(
sl@0:     CONST char *src,		/* Pathname of file to be copied (native). */
sl@0:     CONST char *dst)		/* Pathname of file to copy to (native). */
sl@0: {
sl@0:     OSErr err, dstErr;
sl@0:     Boolean dstExists, dstIsDirectory, dstLocked;
sl@0:     FSSpec srcFileSpec, dstFileSpec, dstDirSpec, tmpFileSpec;
sl@0:     Str31 tmpName;
sl@0: 	
sl@0:     err = FSpLLocationFromPath(strlen(src), src, &srcFileSpec);
sl@0:     if (err == noErr) {
sl@0:         err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists,
sl@0:         	&dstIsDirectory);
sl@0:     }
sl@0:     if (dstExists) {
sl@0:         if (dstIsDirectory) {
sl@0:             errno = EISDIR;
sl@0:             return TCL_ERROR;
sl@0:         }
sl@0:         err = FSpGetFLockCompat(&dstFileSpec, &dstLocked);
sl@0:         if (dstLocked) {
sl@0:             FSpRstFLockCompat(&dstFileSpec);
sl@0:         }
sl@0:         
sl@0:         /*
sl@0:          * Backup dest file.
sl@0:          */
sl@0:          
sl@0:         dstErr = GenerateUniqueName(dstFileSpec.vRefNum, &startSeed, dstFileSpec.parID, 
sl@0:     	        dstFileSpec.parID, tmpName);
sl@0:         if (dstErr == noErr) {
sl@0:             dstErr = FSpRenameCompat(&dstFileSpec, tmpName);
sl@0:         }   
sl@0:     }
sl@0:     if (err == noErr) {
sl@0:     	err = FSpFileCopy(&srcFileSpec, &dstDirSpec, 
sl@0:     		(StringPtr) dstFileSpec.name, NULL, 0, true);
sl@0:     }
sl@0:     if ((dstExists != false) && (dstErr == noErr)) {
sl@0:         FSMakeFSSpecCompat(dstFileSpec.vRefNum, dstFileSpec.parID,
sl@0:         	tmpName, &tmpFileSpec);
sl@0: 	if (err == noErr) {
sl@0: 	    /* 
sl@0: 	     * Delete backup file. 
sl@0: 	     */
sl@0: 	     
sl@0: 	    FSpDeleteCompat(&tmpFileSpec);
sl@0: 	} else {
sl@0: 	
sl@0: 	    /* 
sl@0: 	     * Restore backup file.
sl@0: 	     */
sl@0: 	     
sl@0: 	    FSpDeleteCompat(&dstFileSpec);
sl@0: 	    FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
sl@0: 	    if (dstLocked) {
sl@0: 	        FSpSetFLockCompat(&dstFileSpec);
sl@0: 	    }
sl@0: 	}
sl@0:     }
sl@0:     
sl@0:     if (err != noErr) {
sl@0: 	errno = TclMacOSErrorToPosixError(err);
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpObjDeleteFile, TclpDeleteFile --
sl@0:  *
sl@0:  *      Removes a single file (not a directory).
sl@0:  *
sl@0:  * Results:
sl@0:  *	If the file was successfully deleted, returns TCL_OK.  Otherwise
sl@0:  *	the return value is TCL_ERROR and errno is set to indicate the
sl@0:  *	error.  Some possible values for errno are:
sl@0:  *
sl@0:  *	EACCES:     a parent directory can't be read and/or written.
sl@0:  *	EISDIR:	    path is a directory.
sl@0:  *	ENOENT:	    path doesn't exist or is "".
sl@0:  *
sl@0:  * Side effects:
sl@0:  *      The file is deleted, even if it is read-only.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int 
sl@0: TclpObjDeleteFile(pathPtr)
sl@0:     Tcl_Obj *pathPtr;
sl@0: {
sl@0:     return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));
sl@0: }
sl@0: 
sl@0: int
sl@0: TclpDeleteFile(
sl@0:     CONST char *path)		/* Pathname of file to be removed (native). */
sl@0: {
sl@0:     OSErr err;
sl@0:     FSSpec fileSpec;
sl@0:     Boolean isDirectory;
sl@0:     long dirID;
sl@0:     
sl@0:     err = FSpLLocationFromPath(strlen(path), path, &fileSpec);
sl@0:     if (err == noErr) {
sl@0: 	/*
sl@0:      	 * Since FSpDeleteCompat will delete an empty directory, make sure
sl@0:      	 * that this isn't a directory first.
sl@0:          */
sl@0:         
sl@0:         FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0: 	if (isDirectory == true) {
sl@0:             errno = EISDIR;
sl@0:             return TCL_ERROR;
sl@0:         }
sl@0:     }
sl@0:     err = FSpDeleteCompat(&fileSpec);
sl@0:     if (err == fLckdErr) {
sl@0:     	FSpRstFLockCompat(&fileSpec);
sl@0:     	err = FSpDeleteCompat(&fileSpec);
sl@0:     	if (err != noErr) {
sl@0:     	    FSpSetFLockCompat(&fileSpec);
sl@0:     	}
sl@0:     }
sl@0:     if (err != noErr) {
sl@0: 	errno = TclMacOSErrorToPosixError(err);
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpObjCreateDirectory, DoCreateDirectory --
sl@0:  *
sl@0:  *      Creates the specified directory.  All parent directories of the
sl@0:  *	specified directory must already exist.  The directory is
sl@0:  *	automatically created with permissions so that user can access
sl@0:  *	the new directory and create new files or subdirectories in it.
sl@0:  *
sl@0:  * Results:
sl@0:  *	If the directory was successfully created, returns TCL_OK.
sl@0:  *	Otherwise the return value is TCL_ERROR and errno is set to
sl@0:  *	indicate the error.  Some possible values for errno are:
sl@0:  *
sl@0:  *	EACCES:     a parent directory can't be read and/or written.
sl@0:  *	EEXIST:	    path already exists.
sl@0:  *	ENOENT:	    a parent directory doesn't exist.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *      A directory is created with the current umask, except that
sl@0:  *	permission for u+rwx will always be added.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int 
sl@0: TclpObjCreateDirectory(pathPtr)
sl@0:     Tcl_Obj *pathPtr;
sl@0: {
sl@0:     return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
sl@0: }
sl@0: 
sl@0: static int
sl@0: DoCreateDirectory(
sl@0:     CONST char *path)		/* Pathname of directory to create (native). */
sl@0: {
sl@0:     OSErr err;
sl@0:     FSSpec dirSpec;
sl@0:     long outDirID;
sl@0: 	
sl@0:     err = FSpLocationFromPath(strlen(path), path, &dirSpec);
sl@0:     if (err == noErr) {
sl@0:         err = dupFNErr;		/* EEXIST. */
sl@0:     } else if (err == fnfErr) {
sl@0:         err = FSpDirCreateCompat(&dirSpec, smSystemScript, &outDirID);
sl@0:     } 
sl@0:     
sl@0:     if (err != noErr) {
sl@0: 	errno = TclMacOSErrorToPosixError(err);
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpObjCopyDirectory, DoCopyDirectory --
sl@0:  *
sl@0:  *      Recursively copies a directory.  The target directory dst must
sl@0:  *	not already exist.  Note that this function does not merge two
sl@0:  *	directory hierarchies, even if the target directory is an an
sl@0:  *	empty directory.
sl@0:  *
sl@0:  * Results:
sl@0:  *	If the directory was successfully copied, returns TCL_OK.
sl@0:  *	Otherwise the return value is TCL_ERROR, errno is set to indicate
sl@0:  *	the error, and the pathname of the file that caused the error
sl@0:  *	is stored in errorPtr.  See TclpCreateDirectory and TclpCopyFile
sl@0:  *	for a description of possible values for errno.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *      An exact copy of the directory hierarchy src will be created
sl@0:  *	with the name dst.  If an error occurs, the error will
sl@0:  *      be returned immediately, and remaining files will not be
sl@0:  *	processed.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int 
sl@0: TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
sl@0:     Tcl_Obj *srcPathPtr;
sl@0:     Tcl_Obj *destPathPtr;
sl@0:     Tcl_Obj **errorPtr;
sl@0: {
sl@0:     Tcl_DString ds;
sl@0:     int ret;
sl@0:     ret = DoCopyDirectory(Tcl_FSGetNativePath(srcPathPtr),
sl@0: 			  Tcl_FSGetNativePath(destPathPtr), &ds);
sl@0:     if (ret != TCL_OK) {
sl@0: 	*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
sl@0: 	Tcl_DStringFree(&ds);
sl@0: 	Tcl_IncrRefCount(*errorPtr);
sl@0:     }
sl@0:     return ret;
sl@0: }
sl@0: 
sl@0: static int
sl@0: DoCopyDirectory(
sl@0:     CONST char *src,		/* Pathname of directory to be copied
sl@0: 				 * (Native). */
sl@0:     CONST char *dst,		/* Pathname of target directory (Native). */
sl@0:     Tcl_DString *errorPtr)	/* If non-NULL, uninitialized or free
sl@0: 				 * DString filled with UTF-8 name of file
sl@0: 				 * causing error. */
sl@0: {
sl@0:     OSErr err, saveErr;
sl@0:     long srcID, tmpDirID;
sl@0:     FSSpec srcFileSpec, dstFileSpec, dstDirSpec, tmpDirSpec, tmpFileSpec;
sl@0:     Boolean srcIsDirectory, srcLocked;
sl@0:     Boolean dstIsDirectory, dstExists;
sl@0:     Str31 tmpName;
sl@0: 
sl@0:     err = FSpLocationFromPath(strlen(src), src, &srcFileSpec);
sl@0:     if (err == noErr) {
sl@0:     	err = FSpGetDirectoryID(&srcFileSpec, &srcID, &srcIsDirectory);
sl@0:     }
sl@0:     if (err == noErr) {
sl@0:         if (srcIsDirectory == false) {
sl@0:             err = afpObjectTypeErr;	/* ENOTDIR. */
sl@0:         }
sl@0:     }
sl@0:     if (err == noErr) {
sl@0:         err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists,
sl@0:         	&dstIsDirectory);
sl@0:     }
sl@0:     if (dstExists) {
sl@0:         if (dstIsDirectory == false) {
sl@0:             err = afpObjectTypeErr;	/* ENOTDIR. */
sl@0:         } else {
sl@0:             err = dupFNErr;		/* EEXIST. */
sl@0:         }
sl@0:     }
sl@0:     if (err != noErr) {
sl@0:         goto done;
sl@0:     }        
sl@0:     if ((srcFileSpec.vRefNum == dstFileSpec.vRefNum) &&
sl@0:     	    (srcFileSpec.parID == dstFileSpec.parID) &&
sl@0:             (Pstrequal(srcFileSpec.name, dstFileSpec.name) != 0)) {
sl@0:         /*
sl@0:          * Copying on top of self.  No-op.
sl@0:          */
sl@0:                     
sl@0:         goto done;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * This algorthm will work making a copy of the source directory in
sl@0:      * the current directory with a new name, in a new directory with the
sl@0:      * same name, and in a new directory with a new name:
sl@0:      *
sl@0:      * 1. Make dstDir/tmpDir.
sl@0:      * 2. Copy srcDir/src to dstDir/tmpDir/src
sl@0:      * 3. Rename dstDir/tmpDir/src to dstDir/tmpDir/dst (if necessary).
sl@0:      * 4. CatMove dstDir/tmpDir/dst to dstDir/dst.
sl@0:      * 5. Remove dstDir/tmpDir.
sl@0:      */
sl@0:                 
sl@0:     err = FSpGetFLockCompat(&srcFileSpec, &srcLocked);
sl@0:     if (srcLocked) {
sl@0:         FSpRstFLockCompat(&srcFileSpec);
sl@0:     }
sl@0:     if (err == noErr) {
sl@0:         err = GenerateUniqueName(dstFileSpec.vRefNum, &startSeed, dstFileSpec.parID, 
sl@0:     	        dstFileSpec.parID, tmpName);
sl@0:     }
sl@0:     if (err == noErr) {
sl@0:         FSMakeFSSpecCompat(dstFileSpec.vRefNum, dstFileSpec.parID,
sl@0:         	tmpName, &tmpDirSpec);
sl@0:         err = FSpDirCreateCompat(&tmpDirSpec, smSystemScript, &tmpDirID);
sl@0:     }
sl@0:     if (err == noErr) {
sl@0: 	err = FSpDirectoryCopy(&srcFileSpec, &tmpDirSpec, NULL, NULL, 0, true,
sl@0: 	    	CopyErrHandler);
sl@0:     }
sl@0:     
sl@0:     /* 
sl@0:      * Even if the Copy failed, Rename/Move whatever did get copied to the
sl@0:      * appropriate final destination, if possible.  
sl@0:      */
sl@0:      
sl@0:     saveErr = err;
sl@0:     err = noErr;
sl@0:     if (Pstrequal(srcFileSpec.name, dstFileSpec.name) == 0) {
sl@0:         err = FSMakeFSSpecCompat(tmpDirSpec.vRefNum, tmpDirID, 
sl@0:         	srcFileSpec.name, &tmpFileSpec);
sl@0:         if (err == noErr) {
sl@0:             err = FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
sl@0:         }
sl@0:     }
sl@0:     if (err == noErr) {
sl@0:         err = FSMakeFSSpecCompat(tmpDirSpec.vRefNum, tmpDirID,
sl@0:         	dstFileSpec.name, &tmpFileSpec);
sl@0:     }
sl@0:     if (err == noErr) {
sl@0:         err = FSpCatMoveCompat(&tmpFileSpec, &dstDirSpec);
sl@0:     }
sl@0:     if (err == noErr) {
sl@0:         if (srcLocked) {
sl@0:             FSpSetFLockCompat(&dstFileSpec);
sl@0:         }
sl@0:     }
sl@0:     
sl@0:     FSpDeleteCompat(&tmpDirSpec);
sl@0:     
sl@0:     if (saveErr != noErr) {
sl@0:         err = saveErr;
sl@0:     }
sl@0:     
sl@0:     done:
sl@0:     if (err != noErr) {
sl@0:         errno = TclMacOSErrorToPosixError(err);
sl@0:         if (errorPtr != NULL) {
sl@0:             Tcl_ExternalToUtfDString(NULL, dst, -1, errorPtr);
sl@0:         }
sl@0:         return TCL_ERROR;
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * CopyErrHandler --
sl@0:  *
sl@0:  *      This procedure is called from the MoreFiles procedure 
sl@0:  *      FSpDirectoryCopy whenever an error occurs.
sl@0:  *
sl@0:  * Results:
sl@0:  *      False if the condition should not be considered an error, true
sl@0:  *      otherwise.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *      Since FSpDirectoryCopy() is called only after removing any 
sl@0:  *      existing target directories, there shouldn't be any errors.
sl@0:  *      
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static pascal Boolean 
sl@0: CopyErrHandler(
sl@0:     OSErr error,		/* Error that occured */
sl@0:     short failedOperation,	/* operation that caused the error */
sl@0:     short srcVRefNum,		/* volume ref number of source */
sl@0:     long srcDirID,		/* directory id of source */
sl@0:     ConstStr255Param srcName,	/* name of source */
sl@0:     short dstVRefNum,		/* volume ref number of dst */
sl@0:     long dstDirID,		/* directory id of dst */
sl@0:     ConstStr255Param dstName)	/* name of dst directory */
sl@0: {
sl@0:     return true;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpObjRemoveDirectory, DoRemoveDirectory --
sl@0:  *
sl@0:  *	Removes directory (and its contents, if the recursive flag is set).
sl@0:  *
sl@0:  * Results:
sl@0:  *	If the directory was successfully removed, returns TCL_OK.
sl@0:  *	Otherwise the return value is TCL_ERROR, errno is set to indicate
sl@0:  *	the error, and the pathname of the file that caused the error
sl@0:  *	is stored in errorPtr.  Some possible values for errno are:
sl@0:  *
sl@0:  *	EACCES:     path directory can't be read and/or written.
sl@0:  *	EEXIST:	    path is a non-empty directory.
sl@0:  *	EINVAL:	    path is a root directory.
sl@0:  *	ENOENT:	    path doesn't exist or is "".
sl@0:  * 	ENOTDIR:    path is not a directory.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Directory removed.  If an error occurs, the error will be returned
sl@0:  *	immediately, and remaining files will not be deleted.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0:  
sl@0: int 
sl@0: TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
sl@0:     Tcl_Obj *pathPtr;
sl@0:     int recursive;
sl@0:     Tcl_Obj **errorPtr;
sl@0: {
sl@0:     Tcl_DString ds;
sl@0:     int ret;
sl@0:     ret = DoRemoveDirectory(Tcl_FSGetNativePath(pathPtr),recursive, &ds);
sl@0:     if (ret != TCL_OK) {
sl@0: 	*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
sl@0: 	Tcl_DStringFree(&ds);
sl@0: 	Tcl_IncrRefCount(*errorPtr);
sl@0:     }
sl@0:     return ret;
sl@0: }
sl@0: 
sl@0: static int
sl@0: DoRemoveDirectory(
sl@0:     CONST char *path,		/* Pathname of directory to be removed
sl@0: 				 * (native). */
sl@0:     int recursive,		/* If non-zero, removes directories that
sl@0: 				 * are nonempty.  Otherwise, will only remove
sl@0: 				 * empty directories. */
sl@0:     Tcl_DString *errorPtr)	/* If non-NULL, uninitialized or free
sl@0: 				 * DString filled with UTF-8 name of file
sl@0: 				 * causing error. */
sl@0: {
sl@0:     OSErr err;
sl@0:     FSSpec fileSpec;
sl@0:     long dirID;
sl@0:     int locked;
sl@0:     Boolean isDirectory;
sl@0:     CInfoPBRec pb;
sl@0:     Str255 fileName;
sl@0: 
sl@0: 
sl@0:     locked = 0;
sl@0:     err = FSpLocationFromPath(strlen(path), path, &fileSpec);
sl@0:     if (err != noErr) {
sl@0:         goto done;
sl@0:     }   
sl@0: 
sl@0:     /*
sl@0:      * Since FSpDeleteCompat will delete a file, make sure this isn't
sl@0:      * a file first.
sl@0:      */
sl@0:          
sl@0:     isDirectory = 1;
sl@0:     FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0:     if (isDirectory == 0) {
sl@0:         errno = ENOTDIR;
sl@0:         return TCL_ERROR;
sl@0:     }
sl@0:     
sl@0:     err = FSpDeleteCompat(&fileSpec);
sl@0:     if (err == fLckdErr) {
sl@0:         locked = 1;
sl@0:     	FSpRstFLockCompat(&fileSpec);
sl@0:     	err = FSpDeleteCompat(&fileSpec);
sl@0:     }
sl@0:     if (err == noErr) {
sl@0: 	return TCL_OK;
sl@0:     }
sl@0:     if (err != fBsyErr) {
sl@0:         goto done;
sl@0:     }
sl@0:      
sl@0:     if (recursive == 0) {
sl@0: 	/*
sl@0: 	 * fBsyErr means one of three things: file busy, directory not empty, 
sl@0: 	 * or working directory control block open.  Determine if directory
sl@0: 	 * is empty. If directory is not empty, return EEXIST.
sl@0: 	 */
sl@0: 
sl@0: 	pb.hFileInfo.ioVRefNum = fileSpec.vRefNum;
sl@0: 	pb.hFileInfo.ioDirID = dirID;
sl@0: 	pb.hFileInfo.ioNamePtr = (StringPtr) fileName;
sl@0: 	pb.hFileInfo.ioFDirIndex = 1;
sl@0: 	if (PBGetCatInfoSync(&pb) == noErr) {
sl@0: 	    err = dupFNErr;	/* EEXIST */
sl@0: 	    goto done;
sl@0: 	}
sl@0:     }
sl@0: 	
sl@0:     /*
sl@0:      * DeleteDirectory removes a directory and all its contents, including
sl@0:      * any locked files.  There is no interface to get the name of the 
sl@0:      * file that caused the error, if an error occurs deleting this tree,
sl@0:      * unless we rewrite DeleteDirectory ourselves.
sl@0:      */
sl@0: 	 
sl@0:     err = DeleteDirectory(fileSpec.vRefNum, dirID, NULL);
sl@0: 
sl@0:     done:
sl@0:     if (err != noErr) {
sl@0: 	if (errorPtr != NULL) {
sl@0: 	    Tcl_UtfToExternalDString(NULL, path, -1, errorPtr);
sl@0: 	}
sl@0:         if (locked) {
sl@0:             FSpSetFLockCompat(&fileSpec);
sl@0:         }
sl@0:     	errno = TclMacOSErrorToPosixError(err);
sl@0:     	return TCL_ERROR;
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 			    
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * GetFileSpecs --
sl@0:  *
sl@0:  *	Gets FSSpecs for the specified path and its parent directory.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is noErr if there was no error getting FSSpecs,
sl@0:  *	otherwise it is an error describing the problem.  Fills buffers 
sl@0:  *	with information, as above.  
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static OSErr
sl@0: GetFileSpecs(
sl@0:     CONST char *path,		/* The path to query. */
sl@0:     FSSpec *pathSpecPtr,	/* Filled with information about path. */
sl@0:     FSSpec *dirSpecPtr,		/* Filled with information about path's
sl@0:     				 * parent directory. */
sl@0:     Boolean *pathExistsPtr,	/* Set to true if path actually exists, 
sl@0:     				 * false if it doesn't or there was an 
sl@0:     				 * error reading the specified path. */
sl@0:     Boolean *pathIsDirectoryPtr)/* Set to true if path is itself a directory,
sl@0:     				 * otherwise false. */
sl@0: {
sl@0:     CONST char *dirName;
sl@0:     OSErr err;
sl@0:     int argc;
sl@0:     CONST char **argv;
sl@0:     long d;
sl@0:     Tcl_DString buffer;
sl@0:         
sl@0:     *pathExistsPtr = false;
sl@0:     *pathIsDirectoryPtr = false;
sl@0:     
sl@0:     Tcl_DStringInit(&buffer);
sl@0:     Tcl_SplitPath(path, &argc, &argv);
sl@0:     if (argc == 1) {
sl@0:         dirName = ":";
sl@0:     } else {
sl@0:         dirName = Tcl_JoinPath(argc - 1, argv, &buffer);
sl@0:     }
sl@0:     err = FSpLocationFromPath(strlen(dirName), dirName, dirSpecPtr);
sl@0:     Tcl_DStringFree(&buffer);
sl@0:     ckfree((char *) argv);
sl@0: 
sl@0:     if (err == noErr) {
sl@0:         err = FSpLocationFromPath(strlen(path), path, pathSpecPtr);
sl@0:         if (err == noErr) {
sl@0:             *pathExistsPtr = true;
sl@0:             err = FSpGetDirectoryID(pathSpecPtr, &d, pathIsDirectoryPtr);
sl@0:         } else if (err == fnfErr) {
sl@0:             err = noErr;
sl@0:         }
sl@0:     }
sl@0:     return err;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *-------------------------------------------------------------------------
sl@0:  *
sl@0:  * FSpGetFLockCompat --
sl@0:  *
sl@0:  *	Determines if there exists a software lock on the specified
sl@0:  *	file.  The software lock could prevent the file from being 
sl@0:  *	renamed or moved.
sl@0:  *
sl@0:  * Results:
sl@0:  *	Standard macintosh error code.  
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *
sl@0:  *-------------------------------------------------------------------------
sl@0:  */
sl@0:  
sl@0: OSErr
sl@0: FSpGetFLockCompat(
sl@0:     const FSSpec *specPtr,	/* File to query. */
sl@0:     Boolean *lockedPtr)		/* Set to true if file is locked, false
sl@0:     				 * if it isn't or there was an error reading
sl@0:     				 * specified file. */
sl@0: {
sl@0:     CInfoPBRec pb;
sl@0:     OSErr err;
sl@0:     
sl@0:     pb.hFileInfo.ioVRefNum = specPtr->vRefNum;
sl@0:     pb.hFileInfo.ioDirID = specPtr->parID;
sl@0:     pb.hFileInfo.ioNamePtr = (StringPtr) specPtr->name;
sl@0:     pb.hFileInfo.ioFDirIndex = 0;
sl@0:     
sl@0:     err = PBGetCatInfoSync(&pb);
sl@0:     if ((err == noErr) && (pb.hFileInfo.ioFlAttrib & 0x01)) {
sl@0:         *lockedPtr = true;
sl@0:     } else {
sl@0:         *lockedPtr = false;
sl@0:     }
sl@0:     return err;
sl@0: }
sl@0:     
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Pstrequal --
sl@0:  *
sl@0:  *      Pascal string compare. 
sl@0:  *
sl@0:  * Results:
sl@0:  *      Returns 1 if strings equal, 0 otherwise.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *      None.
sl@0:  *      
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int 
sl@0: Pstrequal (
sl@0:     ConstStr255Param stringA,	/* Pascal string A */
sl@0:     ConstStr255Param stringB)   /* Pascal string B */
sl@0: {
sl@0:     int i, len;
sl@0:     
sl@0:     len = *stringA;
sl@0:     for (i = 0; i <= len; i++) {
sl@0:         if (*stringA++ != *stringB++) {
sl@0:             return 0;
sl@0:         }
sl@0:     }
sl@0:     return 1;
sl@0: }
sl@0:     
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * GetFileFinderAttributes --
sl@0:  *
sl@0:  *	Returns a Tcl_Obj containing the value of a file attribute
sl@0:  *	which is part of the FInfo record. Which attribute is controlled
sl@0:  *	by objIndex.
sl@0:  *
sl@0:  * Results:
sl@0:  *      Returns a standard TCL error. If the return value is TCL_OK,
sl@0:  *	the new creator or file type object is put into attributePtrPtr.
sl@0:  *	The object will have ref count 0. If there is an error,
sl@0:  *	attributePtrPtr is not touched.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *      A new object is allocated if the file is valid.
sl@0:  *      
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: GetFileFinderAttributes(
sl@0:     Tcl_Interp *interp,		/* The interp to report errors with. */
sl@0:     int objIndex,		/* The index of the attribute option. */
sl@0:     Tcl_Obj *fileName,	/* The name of the file (UTF-8). */
sl@0:     Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
sl@0: {
sl@0:     OSErr err;
sl@0:     FSSpec fileSpec;
sl@0:     FInfo finfo;
sl@0:     CONST char *native;
sl@0: 
sl@0:     native=Tcl_FSGetNativePath(fileName);
sl@0:     err = FSpLLocationFromPath(strlen(native),
sl@0: 	    native, &fileSpec);
sl@0: 
sl@0:     if (err == noErr) {
sl@0:     	err = FSpGetFInfo(&fileSpec, &finfo);
sl@0:     }
sl@0:     
sl@0:     if (err == noErr) {
sl@0:     	switch (objIndex) {
sl@0:     	    case MAC_CREATOR_ATTRIBUTE:
sl@0:     	    	*attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdCreator);
sl@0:     	    	break;
sl@0:     	    case MAC_HIDDEN_ATTRIBUTE:
sl@0:     	    	*attributePtrPtr = Tcl_NewBooleanObj(finfo.fdFlags
sl@0:     	    		& kIsInvisible);
sl@0:     	    	break;
sl@0:     	    case MAC_TYPE_ATTRIBUTE:
sl@0:     	    	*attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdType);
sl@0:     	    	break;
sl@0:     	}
sl@0:     } else if (err == fnfErr) {
sl@0:     	long dirID;
sl@0:     	Boolean isDirectory = 0;
sl@0:     	
sl@0:     	err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0:     	if ((err == noErr) && isDirectory) {
sl@0:     	    if (objIndex == MAC_HIDDEN_ATTRIBUTE) {
sl@0:     	    	*attributePtrPtr = Tcl_NewBooleanObj(0);
sl@0:     	    } else {
sl@0:     	    	*attributePtrPtr = Tcl_NewOSTypeObj('Fldr');
sl@0:     	    }
sl@0:     	}
sl@0:     }
sl@0:     
sl@0:     if (err != noErr) {
sl@0:     	errno = TclMacOSErrorToPosixError(err);
sl@0:     	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
sl@0:     		"could not read \"", Tcl_GetString(fileName), "\": ",
sl@0:     		Tcl_PosixError(interp), (char *) NULL);
sl@0:     	return TCL_ERROR;
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * GetFileReadOnly --
sl@0:  *
sl@0:  *	Returns a Tcl_Obj containing a Boolean value indicating whether
sl@0:  *	or not the file is read-only. The object will have ref count 0.
sl@0:  *	This procedure just checks the Finder attributes; it does not
sl@0:  *	check AppleShare sharing attributes.
sl@0:  *
sl@0:  * Results:
sl@0:  *      Returns a standard TCL error. If the return value is TCL_OK,
sl@0:  *	the new creator type object is put into readOnlyPtrPtr.
sl@0:  *	If there is an error, readOnlyPtrPtr is not touched.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *      A new object is allocated if the file is valid.
sl@0:  *      
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: GetFileReadOnly(
sl@0:     Tcl_Interp *interp,		/* The interp to report errors with. */
sl@0:     int objIndex,		/* The index of the attribute. */
sl@0:     Tcl_Obj *fileName,	/* The name of the file (UTF-8). */
sl@0:     Tcl_Obj **readOnlyPtrPtr)	/* A pointer to return the object with. */
sl@0: {
sl@0:     OSErr err;
sl@0:     FSSpec fileSpec;
sl@0:     CInfoPBRec paramBlock;
sl@0:     CONST char *native;
sl@0: 
sl@0:     native=Tcl_FSGetNativePath(fileName);
sl@0:     err = FSpLLocationFromPath(strlen(native),
sl@0: 	    native, &fileSpec);
sl@0:     
sl@0:     if (err == noErr) {
sl@0:     	if (err == noErr) {
sl@0:     	    paramBlock.hFileInfo.ioCompletion = NULL;
sl@0:     	    paramBlock.hFileInfo.ioNamePtr = fileSpec.name;
sl@0:     	    paramBlock.hFileInfo.ioVRefNum = fileSpec.vRefNum;
sl@0:     	    paramBlock.hFileInfo.ioFDirIndex = 0;
sl@0:     	    paramBlock.hFileInfo.ioDirID = fileSpec.parID;
sl@0:     	    err = PBGetCatInfo(&paramBlock, 0);
sl@0:     	    if (err == noErr) {
sl@0:     	    
sl@0:     	    	/*
sl@0:     	    	 * For some unknown reason, the Mac does not give
sl@0:     	    	 * symbols for the bits in the ioFlAttrib field.
sl@0:     	    	 * 1 -> locked.
sl@0:     	    	 */
sl@0:     	    
sl@0:     	    	*readOnlyPtrPtr = Tcl_NewBooleanObj(
sl@0:     	    		paramBlock.hFileInfo.ioFlAttrib & 1);
sl@0:     	    }
sl@0:     	}
sl@0:     }
sl@0:     if (err != noErr) {
sl@0:     	errno = TclMacOSErrorToPosixError(err);
sl@0:     	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
sl@0:     		"could not read \"", Tcl_GetString(fileName), "\": ",
sl@0:     		Tcl_PosixError(interp), (char *) NULL);
sl@0:     	return TCL_ERROR;
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * SetFileFinderAttributes --
sl@0:  *
sl@0:  *	Sets the file to the creator or file type given by attributePtr.
sl@0:  *	objIndex determines whether the creator or file type is set.
sl@0:  *
sl@0:  * Results:
sl@0:  *	Returns a standard TCL error.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *      The file's attribute is set.
sl@0:  *      
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: SetFileFinderAttributes(
sl@0:     Tcl_Interp *interp,		/* The interp to report errors with. */
sl@0:     int objIndex,		/* The index of the attribute. */
sl@0:     Tcl_Obj *fileName,	/* The name of the file (UTF-8). */
sl@0:     Tcl_Obj *attributePtr)	/* The command line object. */
sl@0: {
sl@0:     OSErr err;
sl@0:     FSSpec fileSpec;
sl@0:     FInfo finfo;
sl@0:     CONST char *native;
sl@0: 
sl@0:     native=Tcl_FSGetNativePath(fileName);
sl@0:     err = FSpLLocationFromPath(strlen(native),
sl@0: 	    native, &fileSpec);
sl@0:     
sl@0:     if (err == noErr) {
sl@0:     	err = FSpGetFInfo(&fileSpec, &finfo);
sl@0:     }
sl@0:     
sl@0:     if (err == noErr) {
sl@0:     	switch (objIndex) {
sl@0:     	    case MAC_CREATOR_ATTRIBUTE:
sl@0:     	    	if (Tcl_GetOSTypeFromObj(interp, attributePtr,
sl@0:     	    		&finfo.fdCreator) != TCL_OK) {
sl@0:     	    	    return TCL_ERROR;
sl@0:     	    	}
sl@0:     	    	break;
sl@0:     	    case MAC_HIDDEN_ATTRIBUTE: {
sl@0:     	    	int hidden;
sl@0:     	    	
sl@0:     	    	if (Tcl_GetBooleanFromObj(interp, attributePtr, &hidden)
sl@0:     	    		!= TCL_OK) {
sl@0:     	    	    return TCL_ERROR;
sl@0:     	    	}
sl@0:     	    	if (hidden) {
sl@0:     	    	    finfo.fdFlags |= kIsInvisible;
sl@0:     	    	} else {
sl@0:     	    	    finfo.fdFlags &= ~kIsInvisible;
sl@0:     	    	}
sl@0:     	    	break;
sl@0:     	    }
sl@0:     	    case MAC_TYPE_ATTRIBUTE:
sl@0:     	    	if (Tcl_GetOSTypeFromObj(interp, attributePtr,
sl@0:     	    		&finfo.fdType) != TCL_OK) {
sl@0:     	    	    return TCL_ERROR;
sl@0:     	    	}
sl@0:     	    	break;
sl@0:     	}
sl@0:     	err = FSpSetFInfo(&fileSpec, &finfo);
sl@0:     } else if (err == fnfErr) {
sl@0:     	long dirID;
sl@0:     	Boolean isDirectory = 0;
sl@0:     	
sl@0:     	err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0:     	if ((err == noErr) && isDirectory) {
sl@0:     	    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
sl@0:     	    Tcl_AppendStringsToObj(resultPtr, "cannot set ",
sl@0:     	    	    tclpFileAttrStrings[objIndex], ": \"",
sl@0:     	    	    Tcl_GetString(fileName), "\" is a directory", (char *) NULL);
sl@0:     	    return TCL_ERROR;
sl@0:     	}
sl@0:     }
sl@0:     
sl@0:     if (err != noErr) {
sl@0:     	errno = TclMacOSErrorToPosixError(err);
sl@0:     	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
sl@0:     		"could not read \"", Tcl_GetString(fileName), "\": ",
sl@0:     		Tcl_PosixError(interp), (char *) NULL);
sl@0:     	return TCL_ERROR;
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * SetFileReadOnly --
sl@0:  *
sl@0:  *	Sets the file to be read-only according to the Boolean value
sl@0:  *	given by hiddenPtr.
sl@0:  *
sl@0:  * Results:
sl@0:  *	Returns a standard TCL error.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *      The file's attribute is set.
sl@0:  *      
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: SetFileReadOnly(
sl@0:     Tcl_Interp *interp,		/* The interp to report errors with. */
sl@0:     int objIndex,		/* The index of the attribute. */
sl@0:     Tcl_Obj *fileName,	/* The name of the file (UTF-8). */
sl@0:     Tcl_Obj *readOnlyPtr)	/* The command line object. */
sl@0: {
sl@0:     OSErr err;
sl@0:     FSSpec fileSpec;
sl@0:     HParamBlockRec paramBlock;
sl@0:     int hidden;
sl@0:     CONST char *native;
sl@0: 
sl@0:     native=Tcl_FSGetNativePath(fileName);
sl@0:     err = FSpLLocationFromPath(strlen(native),
sl@0: 	    native, &fileSpec);
sl@0:     
sl@0:     if (err == noErr) {
sl@0:     	if (Tcl_GetBooleanFromObj(interp, readOnlyPtr, &hidden) != TCL_OK) {
sl@0:     	    return TCL_ERROR;
sl@0:     	}
sl@0:     
sl@0:     	paramBlock.fileParam.ioCompletion = NULL;
sl@0:     	paramBlock.fileParam.ioNamePtr = fileSpec.name;
sl@0:     	paramBlock.fileParam.ioVRefNum = fileSpec.vRefNum;
sl@0:     	paramBlock.fileParam.ioDirID = fileSpec.parID;
sl@0:     	if (hidden) {
sl@0:     	    err = PBHSetFLock(&paramBlock, 0);
sl@0:     	} else {
sl@0:     	    err = PBHRstFLock(&paramBlock, 0);
sl@0:     	}
sl@0:     }
sl@0:     
sl@0:     if (err == fnfErr) {
sl@0:     	long dirID;
sl@0:     	Boolean isDirectory = 0;
sl@0:     	err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0:     	if ((err == noErr) && isDirectory) {
sl@0:     	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
sl@0:     	    	    "cannot set a directory to read-only when File Sharing is turned off",
sl@0:     	    	    (char *) NULL);
sl@0:     	    return TCL_ERROR;
sl@0:     	} else {
sl@0:     	    err = fnfErr;
sl@0:     	}
sl@0:     }
sl@0:     
sl@0:     if (err != noErr) {
sl@0:     	errno = TclMacOSErrorToPosixError(err);
sl@0:     	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
sl@0:     		"could not read \"", Tcl_GetString(fileName), "\": ",
sl@0:     		Tcl_PosixError(interp), (char *) NULL);
sl@0:     	return TCL_ERROR;
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpObjListVolumes --
sl@0:  *
sl@0:  *	Lists the currently mounted volumes
sl@0:  *
sl@0:  * Results:
sl@0:  *	The list of volumes.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: Tcl_Obj*
sl@0: TclpObjListVolumes(void)
sl@0: {
sl@0:     HParamBlockRec pb;
sl@0:     Str255 name;
sl@0:     OSErr theError = noErr;
sl@0:     Tcl_Obj *resultPtr, *elemPtr;
sl@0:     short volIndex = 1;
sl@0:     Tcl_DString dstr;
sl@0: 
sl@0:     resultPtr = Tcl_NewObj();
sl@0:         
sl@0:     /*
sl@0:      * We use two facts:
sl@0:      * 1) The Mac volumes are enumerated by the ioVolIndex parameter of
sl@0:      * the HParamBlockRec.  They run through the integers contiguously, 
sl@0:      * starting at 1.  
sl@0:      * 2) PBHGetVInfoSync returns an error when you ask for a volume index
sl@0:      * that does not exist.
sl@0:      * 
sl@0:      */
sl@0:         
sl@0:     while ( 1 ) {
sl@0:         pb.volumeParam.ioNamePtr = (StringPtr) &name;
sl@0:         pb.volumeParam.ioVolIndex = volIndex;
sl@0:                 
sl@0:         theError = PBHGetVInfoSync(&pb);
sl@0: 
sl@0:         if ( theError != noErr ) {
sl@0:             break;
sl@0:         }
sl@0:         
sl@0:         Tcl_ExternalToUtfDString(NULL, (CONST char *)&name[1], name[0], &dstr);
sl@0:         elemPtr = Tcl_NewStringObj(Tcl_DStringValue(&dstr),
sl@0: 		Tcl_DStringLength(&dstr));
sl@0:         Tcl_AppendToObj(elemPtr, ":", 1);
sl@0:         Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
sl@0:         
sl@0:         Tcl_DStringFree(&dstr);
sl@0:                 
sl@0:         volIndex++;             
sl@0:     }
sl@0: 
sl@0:     Tcl_IncrRefCount(resultPtr);
sl@0:     return resultPtr;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpObjNormalizePath --
sl@0:  *
sl@0:  *	This function scans through a path specification and replaces
sl@0:  *	it, in place, with a normalized version.  On MacOS, this means
sl@0:  *	resolving all aliases present in the path and replacing the head of
sl@0:  *	pathPtr with the absolute case-sensitive path to the last file or
sl@0:  *	directory that could be validated in the path.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The new 'nextCheckpoint' value, giving as far as we could
sl@0:  *	understand in the path.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	The pathPtr string, which must contain a valid path, is
sl@0:  *	possibly modified in place.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int
sl@0: TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
sl@0:     Tcl_Interp *interp;
sl@0:     Tcl_Obj *pathPtr;
sl@0:     int nextCheckpoint;
sl@0: {
sl@0:     #define MAXMACFILENAMELEN 31  /* assumed to be < sizeof(StrFileName) */
sl@0:  
sl@0:     StrFileName fileName;
sl@0:     StringPtr fileNamePtr;
sl@0:     int fileNameLen,newPathLen;
sl@0:     Handle newPathHandle;
sl@0:     OSErr err;
sl@0:     short vRefNum;
sl@0:     long dirID;
sl@0:     Boolean isDirectory;
sl@0:     Boolean wasAlias=FALSE;
sl@0:     FSSpec fileSpec, lastFileSpec;
sl@0:     
sl@0:     Tcl_DString nativeds;
sl@0: 
sl@0:     char cur;
sl@0:     int firstCheckpoint=nextCheckpoint, lastCheckpoint;
sl@0:     int origPathLen;
sl@0:     char *path = Tcl_GetStringFromObj(pathPtr,&origPathLen);
sl@0:     
sl@0:     {
sl@0: 	int currDirValid=0;    
sl@0: 	/*
sl@0: 	 * check if substring to first ':' after initial
sl@0: 	 * nextCheckpoint is a valid relative or absolute
sl@0: 	 * path to a directory, if not we return without
sl@0: 	 * normalizing anything
sl@0: 	 */
sl@0: 	
sl@0: 	while (1) {
sl@0: 	    cur = path[nextCheckpoint];
sl@0: 	    if (cur == ':' || cur == 0) {
sl@0: 		if (cur == ':') { 
sl@0: 		    /* jump over separator */
sl@0: 		    nextCheckpoint++; cur = path[nextCheckpoint]; 
sl@0: 		} 
sl@0: 		Tcl_UtfToExternalDString(NULL,path,nextCheckpoint,&nativeds);
sl@0: 		err = FSpLLocationFromPath(Tcl_DStringLength(&nativeds), 
sl@0: 					  Tcl_DStringValue(&nativeds), 
sl@0: 					  &fileSpec);
sl@0: 		Tcl_DStringFree(&nativeds);
sl@0: 		if (err == noErr) {
sl@0: 			lastFileSpec=fileSpec;
sl@0: 			err = ResolveAliasFile(&fileSpec, true, &isDirectory, 
sl@0: 				       &wasAlias);
sl@0: 			if (err == noErr) {
sl@0: 		    err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0: 		    currDirValid = ((err == noErr) && isDirectory);
sl@0: 		    vRefNum = fileSpec.vRefNum;
sl@0: 		    }
sl@0: 		}
sl@0: 		break;
sl@0: 	    }
sl@0: 	    nextCheckpoint++;
sl@0: 	}
sl@0: 	
sl@0: 	if(!currDirValid) {
sl@0: 	    /* can't determine root dir, bail out */
sl@0: 	    return firstCheckpoint; 
sl@0: 	}
sl@0:     }
sl@0: 	
sl@0:     /*
sl@0:      * Now vRefNum and dirID point to a valid
sl@0:      * directory, so walk the rest of the path
sl@0:      * ( code adapted from FSpLocationFromPath() )
sl@0:      */
sl@0: 
sl@0:     lastCheckpoint=nextCheckpoint;
sl@0:     while (1) {
sl@0: 	cur = path[nextCheckpoint];
sl@0: 	if (cur == ':' || cur == 0) {
sl@0: 	    fileNameLen=nextCheckpoint-lastCheckpoint;
sl@0: 	    fileNamePtr=fileName;
sl@0: 	    if(fileNameLen==0) {
sl@0: 		if (cur == ':') {
sl@0: 		    /*
sl@0: 		     * special case for empty dirname i.e. encountered
sl@0: 		     * a '::' path component: get parent dir of currDir
sl@0: 		     */
sl@0: 		    fileName[0]=2;
sl@0: 		    strcpy((char *) fileName + 1, "::");
sl@0: 		    lastCheckpoint--;
sl@0: 		} else {
sl@0: 		    /*
sl@0: 		     * empty filename, i.e. want FSSpec for currDir
sl@0: 		     */
sl@0: 		    fileNamePtr=NULL;
sl@0: 		}
sl@0: 	    } else {
sl@0: 		Tcl_UtfToExternalDString(NULL,&path[lastCheckpoint],
sl@0: 					 fileNameLen,&nativeds);
sl@0: 		fileNameLen=Tcl_DStringLength(&nativeds);
sl@0: 		if(fileNameLen > MAXMACFILENAMELEN) { 
sl@0: 		    err = bdNamErr;
sl@0: 		} else {
sl@0: 		fileName[0]=fileNameLen;
sl@0: 		strncpy((char *) fileName + 1, Tcl_DStringValue(&nativeds), 
sl@0: 			fileNameLen);
sl@0: 		}
sl@0: 		Tcl_DStringFree(&nativeds);
sl@0: 	    }
sl@0: 	    if(err == noErr)
sl@0: 	    err=FSMakeFSSpecCompat(vRefNum, dirID, fileNamePtr, &fileSpec);
sl@0: 	    if(err != noErr) {
sl@0: 		if(err != fnfErr) {
sl@0: 		    /*
sl@0: 		     * this can occur if trying to get parent of a root
sl@0: 		     * volume via '::' or when using an illegal
sl@0: 		     * filename; revert to last checkpoint and stop
sl@0: 		     * processing path further
sl@0: 		     */
sl@0: 		    err=FSMakeFSSpecCompat(vRefNum, dirID, NULL, &fileSpec);
sl@0: 		    if(err != noErr) {
sl@0: 			/* should never happen, bail out */
sl@0: 			return firstCheckpoint; 
sl@0: 		    }
sl@0: 		    nextCheckpoint=lastCheckpoint;
sl@0: 		    cur = path[lastCheckpoint];
sl@0: 		}
sl@0:     		break; /* arrived at nonexistent file or dir */
sl@0: 	    } else {
sl@0: 		/* fileSpec could point to an alias, resolve it */
sl@0: 		lastFileSpec=fileSpec;
sl@0: 		err = ResolveAliasFile(&fileSpec, true, &isDirectory, 
sl@0: 				       &wasAlias);
sl@0: 		if (err != noErr || !isDirectory) {
sl@0: 		    break; /* fileSpec doesn't point to a dir */
sl@0: 		}
sl@0: 	    }
sl@0: 	    if (cur == 0) break; /* arrived at end of path */
sl@0: 	    
sl@0: 	    /* fileSpec points to possibly nonexisting subdirectory; validate */
sl@0: 	    err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0: 	    if (err != noErr || !isDirectory) {
sl@0: 	        break; /* fileSpec doesn't point to existing dir */
sl@0: 	    }
sl@0: 	    vRefNum = fileSpec.vRefNum;
sl@0:     	
sl@0: 	    /* found a new valid subdir in path, continue processing path */
sl@0: 	    lastCheckpoint=nextCheckpoint+1;
sl@0: 	}
sl@0: 	wasAlias=FALSE;
sl@0: 	nextCheckpoint++;
sl@0:     }
sl@0:     
sl@0:     if (wasAlias)
sl@0:     	fileSpec=lastFileSpec;
sl@0:     
sl@0:     /*
sl@0:      * fileSpec now points to a possibly nonexisting file or dir
sl@0:      *  inside a valid dir; get full path name to it
sl@0:      */
sl@0:     
sl@0:     err=FSpPathFromLocation(&fileSpec, &newPathLen, &newPathHandle);
sl@0:     if(err != noErr) {
sl@0: 	return firstCheckpoint; /* should not see any errors here, bail out */
sl@0:     }
sl@0:     
sl@0:     HLock(newPathHandle);
sl@0:     Tcl_ExternalToUtfDString(NULL,*newPathHandle,newPathLen,&nativeds);
sl@0:     if (cur != 0) {
sl@0: 	/* not at end, append remaining path */
sl@0:     	if ( newPathLen==0 || (*(*newPathHandle+(newPathLen-1))!=':' && path[nextCheckpoint] !=':')) {
sl@0: 	    Tcl_DStringAppend(&nativeds, ":" , 1);
sl@0: 	}
sl@0: 	Tcl_DStringAppend(&nativeds, &path[nextCheckpoint], 
sl@0: 			  strlen(&path[nextCheckpoint]));
sl@0:     }
sl@0:     DisposeHandle(newPathHandle);
sl@0:     
sl@0:     fileNameLen=Tcl_DStringLength(&nativeds);
sl@0:     Tcl_SetStringObj(pathPtr,Tcl_DStringValue(&nativeds),fileNameLen);
sl@0:     Tcl_DStringFree(&nativeds);
sl@0:     
sl@0:     return nextCheckpoint+(fileNameLen-origPathLen);
sl@0: }
sl@0: