diff options
author | vincentdarley <vincentdarley> | 2001-08-30 08:53:14 (GMT) |
---|---|---|
committer | vincentdarley <vincentdarley> | 2001-08-30 08:53:14 (GMT) |
commit | 209cbd9eea8f0938d87548bdea9bd8970d18a1fb (patch) | |
tree | cf952115d99a903d3c817b01278505ed6aaff55d /generic | |
parent | ea7d3c538d82fb64a201fedfb9376f6dcafbd102 (diff) | |
download | tcl-209cbd9eea8f0938d87548bdea9bd8970d18a1fb.zip tcl-209cbd9eea8f0938d87548bdea9bd8970d18a1fb.tar.gz tcl-209cbd9eea8f0938d87548bdea9bd8970d18a1fb.tar.bz2 |
filesystem
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tcl.decls | 8 | ||||
-rw-r--r-- | generic/tclFCmd.c | 6 | ||||
-rw-r--r-- | generic/tclFileName.c | 247 | ||||
-rw-r--r-- | generic/tclIOUtil.c | 145 | ||||
-rw-r--r-- | generic/tclInt.decls | 86 | ||||
-rw-r--r-- | generic/tclInt.h | 23 | ||||
-rw-r--r-- | generic/tclIntDecls.h | 142 | ||||
-rw-r--r-- | generic/tclLoadNone.c | 6 | ||||
-rw-r--r-- | generic/tclStubInit.c | 26 | ||||
-rw-r--r-- | generic/tclTest.c | 155 |
10 files changed, 287 insertions, 557 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index 65ff02a..7a93099 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -10,7 +10,7 @@ # 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.52 2001/08/23 17:37:07 vincentdarley Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.53 2001/08/30 08:53:14 vincentdarley Exp $ library tcl @@ -468,6 +468,7 @@ declare 128 generic { declare 129 generic { int Tcl_Eval(Tcl_Interp *interp, char *string) } +# This is obsolete, use Tcl_FSEvalFile declare 130 generic { int Tcl_EvalFile(Tcl_Interp *interp, char *fileName) } @@ -656,6 +657,7 @@ declare 184 generic { declare 185 generic { int Tcl_IsSafe(Tcl_Interp *interp) } +# Obsolete, use Tcl_FSJoinPath declare 186 generic { char * Tcl_JoinPath(int argc, char **argv, Tcl_DString *resultPtr) } @@ -698,6 +700,7 @@ declare 197 {unix win} { Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, \ char **argv, int flags) } +# This is obsolete, use Tcl_FSOpenFileChannel declare 198 generic { Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, char *fileName, \ char *modeString, int permissions) @@ -845,6 +848,7 @@ declare 242 generic { int Tcl_SplitList(Tcl_Interp *interp, CONST char *listStr, int *argcPtr, \ char ***argvPtr) } +# Obsolete, use Tcl_FSSplitPath declare 243 generic { void Tcl_SplitPath(CONST char *path, int *argcPtr, char ***argvPtr) } @@ -1279,6 +1283,8 @@ declare 364 generic { int Tcl_ParseVarName (Tcl_Interp *interp, char *string, \ int numBytes, Tcl_Parse *parsePtr, int append) } +# These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir, +# Tcl_FSAccess and Tcl_FSStat declare 365 generic { char *Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) } diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index 7f3c590..035446f 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -9,7 +9,7 @@ * 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.10 2001/08/23 17:37:07 vincentdarley Exp $ + * RCS: @(#) $Id: tclFCmd.c,v 1.11 2001/08/30 08:53:14 vincentdarley Exp $ */ #include "tclInt.h" @@ -544,8 +544,8 @@ CopyRenameOneFile(interp, source, target, copyFlag, force) /* * 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. + * the low-level Tcl_FSRenameFileProc in the filesystem is allowed + * to implement cross-filesystem moves itself, if it desires. */ } diff --git a/generic/tclFileName.c b/generic/tclFileName.c index e4c484d..1839564 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -10,7 +10,7 @@ * 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.18 2001/08/23 18:20:50 hobbs Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.19 2001/08/30 08:53:14 vincentdarley Exp $ */ #include "tclInt.h" @@ -1110,7 +1110,7 @@ TclpNativeJoinPath(prefix, joining) * exactly one separator inbetween (unless the object we're * adding contains multiple contiguous colons, all of which * we must add). Also if an object is just ':' we don't - * both to add it unless it's the very first element. + * bother to add it unless it's the very first element. */ #ifdef MAC_UNDERSTANDS_UNIX_PATHS @@ -1184,7 +1184,9 @@ TclpNativeJoinPath(prefix, joining) * * Tcl_JoinPath -- * - * Combine a list of paths in a platform specific manner. + * Combine a list of paths in a platform specific manner. The + * function 'Tcl_FSJoinPath' should be used in preference where + * possible. * * Results: * Appends the joined path to the end of the specified @@ -1203,225 +1205,28 @@ Tcl_JoinPath(argc, argv, resultPtr) char **argv; Tcl_DString *resultPtr; /* Pointer to previously initialized DString. */ { - int oldLength, length, i, needsSep; - char c, *dest; - CONST char *p; - Tcl_PathType type = TCL_PATH_ABSOLUTE; - - oldLength = Tcl_DStringLength(resultPtr); - - switch (tclPlatform) { - case TCL_PLATFORM_UNIX: - for (i = 0; i < argc; i++) { - p = argv[i]; - /* - * If the path is absolute, reset the result buffer. - * Consume any duplicate leading slashes or a ./ in - * front of a tilde prefixed path that isn't at the - * beginning of the path. - */ - -#ifdef __QNX__ - /* - * Check for QNX //<node id> prefix - */ - if (*p && (strlen(p) > 3) && (p[0] == '/') && (p[1] == '/') - && isdigit(UCHAR(p[2]))) { /* INTL: digit */ - p += 3; - while (isdigit(UCHAR(*p))) { /* INTL: digit */ - ++p; - } - } -#endif - if (*p == '/') { - Tcl_DStringSetLength(resultPtr, oldLength); - Tcl_DStringAppend(resultPtr, "/", 1); - while (*p == '/') { - p++; - } - } else if (*p == '~') { - Tcl_DStringSetLength(resultPtr, oldLength); - } else if ((Tcl_DStringLength(resultPtr) != oldLength) - && (p[0] == '.') && (p[1] == '/') - && (p[2] == '~')) { - p += 2; - } - - if (*p == '\0') { - continue; - } - - /* - * Append a separator if needed. - */ - - length = Tcl_DStringLength(resultPtr); - if ((length != oldLength) - && (Tcl_DStringValue(resultPtr)[length-1] != '/')) { - Tcl_DStringAppend(resultPtr, "/", 1); - length++; - } - - /* - * Append the element, eliminating duplicate and trailing - * slashes. - */ - - Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p))); - dest = Tcl_DStringValue(resultPtr) + length; - for (; *p != '\0'; p++) { - if (*p == '/') { - while (p[1] == '/') { - p++; - } - if (p[1] != '\0') { - *dest++ = '/'; - } - } else { - *dest++ = *p; - } - } - length = dest - Tcl_DStringValue(resultPtr); - Tcl_DStringSetLength(resultPtr, length); - } - break; - - case TCL_PLATFORM_WINDOWS: - /* - * Iterate over all of the components. If a component is - * absolute, then reset the result and start building the - * path from the current component on. - */ - - for (i = 0; i < argc; i++) { - p = ExtractWinRoot(argv[i], resultPtr, oldLength, &type); - length = Tcl_DStringLength(resultPtr); - - /* - * If the pointer didn't move, then this is a relative path - * or a tilde prefixed path. - */ - - if (p == argv[i]) { - /* - * Remove the ./ from tilde prefixed elements unless - * it is the first component. - */ - - if ((length != oldLength) - && (p[0] == '.') - && ((p[1] == '/') || (p[1] == '\\')) - && (p[2] == '~')) { - p += 2; - } else if (*p == '~') { - Tcl_DStringSetLength(resultPtr, oldLength); - length = oldLength; - } - } - - if (*p != '\0') { - /* - * Check to see if we need to append a separator. - */ - - - if (length != oldLength) { - c = Tcl_DStringValue(resultPtr)[length-1]; - if ((c != '/') && (c != ':')) { - Tcl_DStringAppend(resultPtr, "/", 1); - } - } - - /* - * Append the element, eliminating duplicate and - * trailing slashes. - */ - - length = Tcl_DStringLength(resultPtr); - Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p))); - dest = Tcl_DStringValue(resultPtr) + length; - for (; *p != '\0'; p++) { - if ((*p == '/') || (*p == '\\')) { - while ((p[1] == '/') || (p[1] == '\\')) { - p++; - } - if (p[1] != '\0') { - *dest++ = '/'; - } - } else { - *dest++ = *p; - } - } - length = dest - Tcl_DStringValue(resultPtr); - Tcl_DStringSetLength(resultPtr, length); - } - } - break; - - case TCL_PLATFORM_MAC: - needsSep = 1; - for (i = 0; i < argc; i++) { - Tcl_Obj *splitPtr; - Tcl_Obj *eltPtr; - int eltLen; - int splitIndex = 0; - int splitElements; - - splitPtr = SplitMacPath(argv[i]); - - Tcl_ListObjLength(NULL, splitPtr, &splitElements); - if (splitElements == 0) { - Tcl_DecrRefCount(splitPtr); - continue; - } - - Tcl_ListObjIndex(NULL, splitPtr, 0, &eltPtr); - p = Tcl_GetStringFromObj(eltPtr, &eltLen); - if ((eltLen != 0) && (*p != ':') && (strchr(p, ':') != NULL)) { - Tcl_DStringSetLength(resultPtr, oldLength); - length = strlen(p); - Tcl_DStringAppend(resultPtr, p, eltLen); - needsSep = 0; - splitIndex++; - } - - /* - * Now append the rest of the path elements, skipping - * : unless it is the first element of the path, and - * watching out for :: et al. so we don't end up with - * too many colons in the result. - */ - - for (; splitIndex < splitElements; splitIndex++) { - Tcl_ListObjIndex(NULL, splitPtr, splitIndex, &eltPtr); - p = Tcl_GetStringFromObj(eltPtr, &eltLen); - if (p[0] == ':' && p[1] == '\0') { - if (Tcl_DStringLength(resultPtr) != oldLength) { - p++; - } else { - needsSep = 0; - } - } else { - c = p[1]; - if (*p == ':') { - if (!needsSep) { - p++; - } - } else { - if (needsSep) { - Tcl_DStringAppend(resultPtr, ":", 1); - } - } - needsSep = (c == ':') ? 0 : 1; - } - length = strlen(p); - Tcl_DStringAppend(resultPtr, p, length); - } - Tcl_DecrRefCount(splitPtr); - } - break; - + int i, len; + Tcl_Obj *listObj = Tcl_NewObj(); + Tcl_Obj *resultObj; + char *resultStr; + + /* Build the list of paths */ + for (i = 0; i < argc; i++) { + Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewStringObj(argv[i],-1)); } + + /* Ask the objectified code to join the paths */ + Tcl_IncrRefCount(listObj); + resultObj = Tcl_FSJoinPath(listObj, argc); + Tcl_IncrRefCount(resultObj); + Tcl_DecrRefCount(listObj); + + /* Store the result */ + resultStr = Tcl_GetStringFromObj(resultObj, &len); + Tcl_DStringAppend(resultPtr, resultStr, len); + Tcl_DecrRefCount(resultObj); + + /* Return a pointer to the result */ return Tcl_DStringValue(resultPtr); } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index d5fa64c..2406215 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * 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.16 2001/08/23 18:20:50 hobbs Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.17 2001/08/30 08:53:14 vincentdarley Exp $ */ #include "tclInt.h" @@ -71,29 +71,11 @@ extern CONST TclFileAttrProcs tclpFileAttrProcs[]; /* * The following functions are obsolete string based APIs, and should - * be removed in a future release. + * be removed in a future release (Tcl 9 would be a good time). */ /* 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. */ @@ -187,17 +169,6 @@ Tcl_EvalFile(interp, fileName) return ret; } -/* Obsolete */ -int -TclpListVolumes( - Tcl_Interp *interp) /* Interpreter for returning volume list. */ -{ - Tcl_Obj *resultPtr = TclpObjListVolumes(); - Tcl_SetObjResult(interp, resultPtr); - Tcl_DecrRefCount(resultPtr); - return TCL_OK; -} - /* * The 3 hooks for Stat, Access and OpenFileChannel are obsolete. The @@ -207,6 +178,9 @@ TclpListVolumes( * from stubs/tclInt. The only known users of these APIs are prowrap * and mktclapp. New code/extensions should not use them, since they * do not provide as full support as the full filesystem API. + * + * As soon as prowrap and mktclapp are updated to use the full + * filesystem support, I suggest all these hooks are removed. */ #define USE_OBSOLETE_FS_HOOKS @@ -299,8 +273,6 @@ 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; /* @@ -345,7 +317,7 @@ static Tcl_Filesystem nativeFilesystem = { &NativeFilesystemSeparator, &TclpObjStat, &TclpObjAccess, - &NativeOpenFileChannel, + &TclpOpenFileChannel, &TclpMatchInDirectory, &NativeUtime, #ifndef S_IFLNK @@ -364,7 +336,7 @@ static Tcl_Filesystem nativeFilesystem = { &TclpObjCopyFile, &TclpObjRenameFile, &TclpObjCopyDirectory, - &NativeLoadFile, + &TclpLoadFile, &TclpUnloadFile, &TclpObjGetCwd, &TclpObjChdir @@ -1602,19 +1574,33 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types) if (proc != NULL) { int cwdLen; Tcl_Obj *cwdDir; + char *cwdStr; +#ifdef MAC_TCL + char sep = ':'; +#else + char sep = '/'; +#endif Tcl_Obj* tmpResultPtr = Tcl_NewListObj(0, NULL); /* * We know the cwd is a normalised object which does - * not end in a directory delimiter. + * not end in a directory delimiter, unless the cwd + * is the name of a volume, in which case it will + * end in a delimiter! We handle this situation here. + * A better test than the '!= sep' might be to simply + * check if 'cwd' is a root volume. + * + * Note that if we get this wrong, we will strip off + * either too much or too little below, leading to + * wrong answers returned by glob. */ cwdDir = Tcl_DuplicateObj(cwd); -#ifdef MAC_TCL - Tcl_AppendToObj(cwdDir, ":", 1); -#else - Tcl_AppendToObj(cwdDir, "/", 1); -#endif - Tcl_GetStringFromObj(cwdDir, &cwdLen); Tcl_IncrRefCount(cwdDir); + cwdStr = Tcl_GetStringFromObj(cwdDir, &cwdLen); + if (cwdStr[cwdLen-1] != sep) { + Tcl_AppendToObj(cwdDir, &sep, 1); + cwdLen++; + /* Note: cwdStr may no longer be a valid pointer */ + } ret = (*proc)(interp, tmpResultPtr, cwdDir, pattern, types); Tcl_DecrRefCount(cwdDir); if (ret == TCL_OK) { @@ -2636,10 +2622,13 @@ Tcl_FSJoinPath(listObj, elements) int driveNameLength; Tcl_PathType type; char *strElt; + int strEltLen; + int length; + char *ptr; Tcl_Obj *driveName = NULL; Tcl_ListObjIndex(NULL, listObj, i, &elt); - strElt = Tcl_GetString(elt); + strElt = Tcl_GetStringFromObj(elt, &strEltLen); type = GetPathType(elt, &fsPtr, &driveNameLength, &driveName); if (type != TCL_PATH_RELATIVE) { /* Zero out the current result */ @@ -2653,6 +2642,19 @@ Tcl_FSJoinPath(listObj, elements) strElt += driveNameLength; } + ptr = Tcl_GetStringFromObj(res, &length); + + /* + * Strip off any './' before a tilde, unless this is the + * beginning of the path. + */ + if (length > 0 && strEltLen > 0) { + if ((strElt[0] == '.') && (strElt[1] == '/') + && (strElt[2] == '~')) { + strElt += 2; + } + } + /* * A NULL value for fsPtr at this stage basically means * we're trying to join a relative path onto something @@ -2664,9 +2666,7 @@ Tcl_FSJoinPath(listObj, elements) if (fsPtr == &nativeFilesystem || fsPtr == NULL) { TclpNativeJoinPath(res, strElt); } else { - int length; char separator = '/'; - char *ptr; int needsSep = 0; if (fsPtr->filesystemSeparatorProc != NULL) { @@ -2675,7 +2675,7 @@ Tcl_FSJoinPath(listObj, elements) separator = Tcl_GetString(sep)[0]; } } - ptr = Tcl_GetStringFromObj(res, &length); + if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); length++; @@ -3735,6 +3735,17 @@ Tcl_FSGetInternalRep(pathObjPtr, fsPtr) * to allow this sub-optimal routing. */ Tcl_FSGetFileSystemForPath(pathObjPtr); + + /* + * If we fail through here, then the path is probably not a + * valid path in the filesystsem, and is most likely to be a + * use of the empty path "" via a direct call to one of the + * objectified interfaces (e.g. from the Tcl testsuite). + */ + srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr; + if (srcFsPathPtr->fsRecPtr == NULL) { + return NULL; + } } if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) { @@ -3915,6 +3926,11 @@ NativeDupInternalRep(clientData) * Any path object is acceptable to the native filesystem, by * default (we will throw errors when illegal paths are actually * tried to be used). + * + * However, this behavior means the native filesystem must be + * the last filesystem in the lookup list (otherwise it will + * claim all files belong to it, and other filesystems will + * never get a look in). * * Results: * TCL_OK, to indicate 'yes', -1 to indicate no. @@ -4262,22 +4278,6 @@ Tcl_FSEqualPaths(firstPtr, secondPtr) return 0; } -/* Wrappers */ - -static Tcl_Channel -NativeOpenFileChannel(interp, pathPtr, modeString, permissions) - Tcl_Interp *interp; - Tcl_Obj *pathPtr; - char *modeString; - int permissions; -{ - Tcl_Obj *trans = Tcl_FSGetTranslatedPath(interp, pathPtr); - if (trans == NULL) { - return NULL; - } - return TclpOpenFileChannel(interp, Tcl_GetString(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. @@ -4304,27 +4304,6 @@ NativeUtime(pathPtr, tval) #endif } -static 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; -{ - char *path; - Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); - if (transPtr == NULL) { - path = NULL; - } else { - path = Tcl_GetString(transPtr); - } - return TclpLoadFile(interp, path, - sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr); -} - /* Everything from here on is contained in this obsolete ifdef */ #ifdef USE_OBSOLETE_FS_HOOKS diff --git a/generic/tclInt.decls b/generic/tclInt.decls index b0b883b..7b1dac5 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tclInt.decls,v 1.29 2001/07/31 19:12:06 vincentdarley Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.30 2001/08/30 08:53:14 vincentdarley Exp $ library tcl @@ -23,9 +23,10 @@ interface tclInt # Use at your own risk. Note that the position of functions should not # be changed between versions to avoid gratuitous incompatibilities. -declare 0 generic { - int TclAccess(CONST char *path, int mode) -} +# Replaced by Tcl_FSAccess in 8.4: +#declare 0 generic { +# int TclAccess(CONST char *path, int mode) +#} declare 1 generic { int TclAccessDeleteProc(TclAccessProc_ *proc) } @@ -268,9 +269,10 @@ declare 66 generic { declare 67 generic { int TclOpenFileChannelInsertProc(TclOpenFileChannelProc_ *proc) } -declare 68 generic { - int TclpAccess(CONST char *path, int mode) -} +# Replaced by Tcl_FSAccess in 8.4: +#declare 68 generic { +# int TclpAccess(CONST char *path, int mode) +#} declare 69 generic { char * TclpAlloc(unsigned int size) } @@ -302,13 +304,15 @@ declare 77 generic { declare 78 generic { int TclpGetTimeZone(unsigned long time) } -declare 79 generic { - int TclpListVolumes(Tcl_Interp *interp) -} -declare 80 generic { - Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName, \ - char *modeString, int permissions) -} +# Replaced by Tcl_FSListVolumes in 8.4: +#declare 79 generic { +# int TclpListVolumes(Tcl_Interp *interp) +#} +# Replaced by Tcl_FSOpenFileChannel in 8.4: +#declare 80 generic { +# Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName, \ +# char *modeString, int permissions) +#} declare 81 generic { char * TclpRealloc(char *ptr, unsigned int size) } @@ -362,9 +366,10 @@ declare 94 generic { int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp, \ int argc, char **argv) } -declare 95 generic { - int TclpStat(CONST char *path, struct stat *buf) -} +# Replaced by Tcl_FSStat in 8.4: +#declare 95 generic { +# int TclpStat(CONST char *path, struct stat *buf) +#} declare 96 generic { int TclRenameCommand(Tcl_Interp *interp, char *oldName, char *newName) } @@ -395,9 +400,10 @@ declare 103 generic { declare 104 {unix win} { int TclSockMinimumBuffers(int sock, int size) } -declare 105 generic { - int TclStat(CONST char *path, struct stat *buf) -} +# Replaced by Tcl_FSStat in 8.4: +#declare 105 generic { +# int TclStat(CONST char *path, struct stat *buf) +#} declare 106 generic { int TclStatDeleteProc(TclStatProc_ *proc) } @@ -520,17 +526,18 @@ declare 135 generic { declare 138 generic { char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr) } -declare 139 generic { - int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, \ - char *sym2, Tcl_PackageInitProc **proc1Ptr, \ - Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr) -} +#declare 139 generic { +# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, \ +# char *sym2, Tcl_PackageInitProc **proc1Ptr, \ +# Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr) +#} declare 140 generic { int TclLooksLikeInt(char *bytes, int length) } -#declare 141 generic { -# char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) -#} +# This is used by TclX, but should otherwise be considered private +declare 141 generic { + char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) +} declare 142 generic { int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, \ CompileHookProc *hookProc, ClientData clientData) @@ -616,29 +623,8 @@ declare 161 generic { declare 162 generic { void TclChannelEventScriptInvoker(ClientData clientData, int flags) } -# for virtual filesystem support. These should eventually be moved to -# Tcl's external API and properly documented, to allow extension writers -# to use them easily (hence providing automatic VFS support to all -# extensions) +# These functions are vfs aware, but are generally only useful internally. declare 163 generic { - int TclFileCopyCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) -} -declare 164 generic { - int TclFileRenameCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) -} -declare 165 generic { - int TclFileDeleteCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) -} -declare 166 generic { - int TclFileMakeDirsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) -} -declare 167 generic { - int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) -} -declare 168 generic { - Tcl_Obj* TclpTempFileName(void) -} -declare 169 generic { void TclpSetInitialEncodings(void) } diff --git a/generic/tclInt.h b/generic/tclInt.h index daa8a7d..049ab71 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.60 2001/08/30 07:50:18 davygrvy Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.61 2001/08/30 08:53:14 vincentdarley Exp $ */ #ifndef _TCLINT @@ -1773,12 +1773,7 @@ EXTERN int TclpObjLstat _ANSI_ARGS_((Tcl_Obj *pathPtr, struct stat *buf)); EXTERN char * TclpAlloc _ANSI_ARGS_((unsigned int size)); EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void)); -EXTERN int TclpCopyFile _ANSI_ARGS_((CONST char *source, - CONST char *dest)); -EXTERN int TclpCopyDirectory _ANSI_ARGS_((CONST char *source, - CONST char *dest, Tcl_DString *errorPtr)); -EXTERN int TclpCreateDirectory _ANSI_ARGS_((CONST char *path)); -EXTERN int TclpDeleteFile _ANSI_ARGS_((CONST char *path)); +EXTERN Tcl_Obj* TclpTempFileName _ANSI_ARGS_((void)); EXTERN void TclpExit _ANSI_ARGS_((int status)); EXTERN void TclpFinalizeCondition _ANSI_ARGS_(( Tcl_Condition *condPtr)); @@ -1805,7 +1800,11 @@ EXTERN void TclpInitLibraryPath _ANSI_ARGS_((CONST char *argv0)); EXTERN void TclpInitLock _ANSI_ARGS_((void)); EXTERN void TclpInitPlatform _ANSI_ARGS_((void)); EXTERN void TclpInitUnlock _ANSI_ARGS_((void)); -EXTERN int TclpListVolumes _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN int TclpLoadFile _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *pathPtr, char *sym1, char *sym2, + Tcl_PackageInitProc **proc1Ptr, + Tcl_PackageInitProc **proc2Ptr, + ClientData *clientDataPtr)); EXTERN Tcl_Obj* TclpObjListVolumes _ANSI_ARGS_((void)); EXTERN void TclpMasterLock _ANSI_ARGS_((void)); EXTERN void TclpMasterUnlock _ANSI_ARGS_((void)); @@ -1833,14 +1832,12 @@ EXTERN int TclpObjRemoveDirectory _ANSI_ARGS_((Tcl_Obj *pathPtr, EXTERN int TclpObjRenameFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)); EXTERN int TclpMatchInDirectory _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, char *pattern, Tcl_GlobTypeData *types)); -EXTERN int TclpChdir _ANSI_ARGS_((CONST char *dirName)); -EXTERN char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp *interp, Tcl_DString *bufferPtr)); EXTERN Tcl_Obj* TclpObjGetCwd _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN Tcl_Obj* TclpObjLink _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Obj *toPtr)); EXTERN int TclpObjChdir _ANSI_ARGS_((Tcl_Obj *pathPtr)); EXTERN int TclpObjStat _ANSI_ARGS_((Tcl_Obj *pathPtr, struct stat *buf)); EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp, - char *fileName, char *modeString, + Tcl_Obj *pathPtr, char *modeString, int permissions)); EXTERN void TclpPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *, format)); @@ -1849,10 +1846,6 @@ EXTERN char * TclpReadlink _ANSI_ARGS_((CONST char *fileName, EXTERN char * TclpRealloc _ANSI_ARGS_((char *ptr, unsigned int size)); EXTERN void TclpReleaseFile _ANSI_ARGS_((TclFile file)); -EXTERN int TclpRemoveDirectory _ANSI_ARGS_((CONST char *path, - int recursive, Tcl_DString *errorPtr)); -EXTERN int TclpRenameFile _ANSI_ARGS_((CONST char *source, - CONST char *dest)); EXTERN void TclpSetInitialEncodings _ANSI_ARGS_((void)); EXTERN void TclpSetVariables _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN VOID * TclpSysAlloc _ANSI_ARGS_((long size, int isBin)); diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 8d55864..47e08ad 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIntDecls.h,v 1.25 2001/07/31 19:12:06 vincentdarley Exp $ + * RCS: @(#) $Id: tclIntDecls.h,v 1.26 2001/08/30 08:53:14 vincentdarley Exp $ */ #ifndef _TCLINTDECLS @@ -29,8 +29,7 @@ * Exported function declarations: */ -/* 0 */ -EXTERN int TclAccess _ANSI_ARGS_((CONST char * path, int mode)); +/* Slot 0 is reserved */ /* 1 */ EXTERN int TclAccessDeleteProc _ANSI_ARGS_(( TclAccessProc_ * proc)); @@ -236,8 +235,7 @@ EXTERN int TclOpenFileChannelDeleteProc _ANSI_ARGS_(( /* 67 */ EXTERN int TclOpenFileChannelInsertProc _ANSI_ARGS_(( TclOpenFileChannelProc_ * proc)); -/* 68 */ -EXTERN int TclpAccess _ANSI_ARGS_((CONST char * path, int mode)); +/* Slot 68 is reserved */ /* 69 */ EXTERN char * TclpAlloc _ANSI_ARGS_((unsigned int size)); /* Slot 70 is reserved */ @@ -254,12 +252,8 @@ EXTERN unsigned long TclpGetSeconds _ANSI_ARGS_((void)); EXTERN void TclpGetTime _ANSI_ARGS_((Tcl_Time * time)); /* 78 */ EXTERN int TclpGetTimeZone _ANSI_ARGS_((unsigned long time)); -/* 79 */ -EXTERN int TclpListVolumes _ANSI_ARGS_((Tcl_Interp * interp)); -/* 80 */ -EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp * interp, - char * fileName, char * modeString, - int permissions)); +/* Slot 79 is reserved */ +/* Slot 80 is reserved */ /* 81 */ EXTERN char * TclpRealloc _ANSI_ARGS_((char * ptr, unsigned int size)); @@ -289,9 +283,7 @@ EXTERN void TclProcDeleteProc _ANSI_ARGS_((ClientData clientData)); /* 94 */ EXTERN int TclProcInterpProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); -/* 95 */ -EXTERN int TclpStat _ANSI_ARGS_((CONST char * path, - struct stat * buf)); +/* Slot 95 is reserved */ /* 96 */ EXTERN int TclRenameCommand _ANSI_ARGS_((Tcl_Interp * interp, char * oldName, char * newName)); @@ -331,9 +323,7 @@ EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock, EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock, int size)); #endif /* __WIN32__ */ -/* 105 */ -EXTERN int TclStat _ANSI_ARGS_((CONST char * path, - struct stat * buf)); +/* Slot 105 is reserved */ /* 106 */ EXTERN int TclStatDeleteProc _ANSI_ARGS_((TclStatProc_ * proc)); /* 107 */ @@ -437,16 +427,13 @@ EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void)); /* 138 */ EXTERN char * TclGetEnv _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); -/* 139 */ -EXTERN int TclpLoadFile _ANSI_ARGS_((Tcl_Interp * interp, - char * fileName, char * sym1, char * sym2, - Tcl_PackageInitProc ** proc1Ptr, - Tcl_PackageInitProc ** proc2Ptr, - ClientData * clientDataPtr)); +/* Slot 139 is reserved */ /* 140 */ EXTERN int TclLooksLikeInt _ANSI_ARGS_((char * bytes, int length)); -/* Slot 141 is reserved */ +/* 141 */ +EXTERN char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_DString * cwdPtr)); /* 142 */ EXTERN int TclSetByteCodeFromAny _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * objPtr, @@ -500,30 +487,13 @@ EXTERN int TclChannelTransform _ANSI_ARGS_((Tcl_Interp * interp, EXTERN void TclChannelEventScriptInvoker _ANSI_ARGS_(( ClientData clientData, int flags)); /* 163 */ -EXTERN int TclFileCopyCmd _ANSI_ARGS_((Tcl_Interp * interp, - int objc, Tcl_Obj *CONST objv[])); -/* 164 */ -EXTERN int TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp * interp, - int objc, Tcl_Obj *CONST objv[])); -/* 165 */ -EXTERN int TclFileDeleteCmd _ANSI_ARGS_((Tcl_Interp * interp, - int objc, Tcl_Obj *CONST objv[])); -/* 166 */ -EXTERN int TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp * interp, - int objc, Tcl_Obj *CONST objv[])); -/* 167 */ -EXTERN int TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp * interp, - int objc, Tcl_Obj *CONST objv[])); -/* 168 */ -EXTERN Tcl_Obj* TclpTempFileName _ANSI_ARGS_((void)); -/* 169 */ EXTERN void TclpSetInitialEncodings _ANSI_ARGS_((void)); typedef struct TclIntStubs { int magic; struct TclIntStubHooks *hooks; - int (*tclAccess) _ANSI_ARGS_((CONST char * path, int mode)); /* 0 */ + void *reserved0; int (*tclAccessDeleteProc) _ANSI_ARGS_((TclAccessProc_ * proc)); /* 1 */ int (*tclAccessInsertProc) _ANSI_ARGS_((TclAccessProc_ * proc)); /* 2 */ void (*tclAllocateFreeObjects) _ANSI_ARGS_((void)); /* 3 */ @@ -607,7 +577,7 @@ typedef struct TclIntStubs { int (*tclObjInvokeGlobal) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 65 */ int (*tclOpenFileChannelDeleteProc) _ANSI_ARGS_((TclOpenFileChannelProc_ * proc)); /* 66 */ int (*tclOpenFileChannelInsertProc) _ANSI_ARGS_((TclOpenFileChannelProc_ * proc)); /* 67 */ - int (*tclpAccess) _ANSI_ARGS_((CONST char * path, int mode)); /* 68 */ + void *reserved68; char * (*tclpAlloc) _ANSI_ARGS_((unsigned int size)); /* 69 */ void *reserved70; void *reserved71; @@ -618,8 +588,8 @@ typedef struct TclIntStubs { unsigned long (*tclpGetSeconds) _ANSI_ARGS_((void)); /* 76 */ void (*tclpGetTime) _ANSI_ARGS_((Tcl_Time * time)); /* 77 */ int (*tclpGetTimeZone) _ANSI_ARGS_((unsigned long time)); /* 78 */ - int (*tclpListVolumes) _ANSI_ARGS_((Tcl_Interp * interp)); /* 79 */ - Tcl_Channel (*tclpOpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, char * modeString, int permissions)); /* 80 */ + void *reserved79; + void *reserved80; char * (*tclpRealloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 81 */ void *reserved82; void *reserved83; @@ -634,7 +604,7 @@ typedef struct TclIntStubs { int (*tclProcCompileProc) _ANSI_ARGS_((Tcl_Interp * interp, Proc * procPtr, Tcl_Obj * bodyPtr, Namespace * nsPtr, CONST char * description, CONST char * procName)); /* 92 */ void (*tclProcDeleteProc) _ANSI_ARGS_((ClientData clientData)); /* 93 */ int (*tclProcInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 94 */ - int (*tclpStat) _ANSI_ARGS_((CONST char * path, struct stat * buf)); /* 95 */ + void *reserved95; int (*tclRenameCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * oldName, char * newName)); /* 96 */ void (*tclResetShadowedCmdRefs) _ANSI_ARGS_((Tcl_Interp * interp, Command * newCmdPtr)); /* 97 */ int (*tclServiceIdle) _ANSI_ARGS_((void)); /* 98 */ @@ -660,7 +630,7 @@ typedef struct TclIntStubs { #ifdef MAC_TCL void *reserved104; #endif /* MAC_TCL */ - int (*tclStat) _ANSI_ARGS_((CONST char * path, struct stat * buf)); /* 105 */ + void *reserved105; int (*tclStatDeleteProc) _ANSI_ARGS_((TclStatProc_ * proc)); /* 106 */ int (*tclStatInsertProc) _ANSI_ARGS_((TclStatProc_ * proc)); /* 107 */ void (*tclTeardownNamespace) _ANSI_ARGS_((Namespace * nsPtr)); /* 108 */ @@ -694,9 +664,9 @@ typedef struct TclIntStubs { void *reserved136; void *reserved137; char * (*tclGetEnv) _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); /* 138 */ - int (*tclpLoadFile) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, char * sym1, char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr, ClientData * clientDataPtr)); /* 139 */ + void *reserved139; int (*tclLooksLikeInt) _ANSI_ARGS_((char * bytes, int length)); /* 140 */ - void *reserved141; + char * (*tclpGetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 141 */ int (*tclSetByteCodeFromAny) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CompileHookProc * hookProc, ClientData clientData)); /* 142 */ int (*tclAddLiteralObj) _ANSI_ARGS_((struct CompileEnv * envPtr, Tcl_Obj * objPtr, LiteralEntry ** litPtrPtr)); /* 143 */ void (*tclHideLiteral) _ANSI_ARGS_((Tcl_Interp * interp, struct CompileEnv * envPtr, int index)); /* 144 */ @@ -718,13 +688,7 @@ typedef struct TclIntStubs { void *reserved160; int (*tclChannelTransform) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, Tcl_Obj * cmdObjPtr)); /* 161 */ void (*tclChannelEventScriptInvoker) _ANSI_ARGS_((ClientData clientData, int flags)); /* 162 */ - int (*tclFileCopyCmd) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 163 */ - int (*tclFileRenameCmd) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 164 */ - int (*tclFileDeleteCmd) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 165 */ - int (*tclFileMakeDirsCmd) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 166 */ - int (*tclFileAttrsCmd) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 167 */ - Tcl_Obj* (*tclpTempFileName) _ANSI_ARGS_((void)); /* 168 */ - void (*tclpSetInitialEncodings) _ANSI_ARGS_((void)); /* 169 */ + void (*tclpSetInitialEncodings) _ANSI_ARGS_((void)); /* 163 */ } TclIntStubs; #ifdef __cplusplus @@ -741,10 +705,7 @@ extern TclIntStubs *tclIntStubsPtr; * Inline function declarations: */ -#ifndef TclAccess -#define TclAccess \ - (tclIntStubsPtr->tclAccess) /* 0 */ -#endif +/* Slot 0 is reserved */ #ifndef TclAccessDeleteProc #define TclAccessDeleteProc \ (tclIntStubsPtr->tclAccessDeleteProc) /* 1 */ @@ -993,10 +954,7 @@ extern TclIntStubs *tclIntStubsPtr; #define TclOpenFileChannelInsertProc \ (tclIntStubsPtr->tclOpenFileChannelInsertProc) /* 67 */ #endif -#ifndef TclpAccess -#define TclpAccess \ - (tclIntStubsPtr->tclpAccess) /* 68 */ -#endif +/* Slot 68 is reserved */ #ifndef TclpAlloc #define TclpAlloc \ (tclIntStubsPtr->tclpAlloc) /* 69 */ @@ -1025,14 +983,8 @@ extern TclIntStubs *tclIntStubsPtr; #define TclpGetTimeZone \ (tclIntStubsPtr->tclpGetTimeZone) /* 78 */ #endif -#ifndef TclpListVolumes -#define TclpListVolumes \ - (tclIntStubsPtr->tclpListVolumes) /* 79 */ -#endif -#ifndef TclpOpenFileChannel -#define TclpOpenFileChannel \ - (tclIntStubsPtr->tclpOpenFileChannel) /* 80 */ -#endif +/* Slot 79 is reserved */ +/* Slot 80 is reserved */ #ifndef TclpRealloc #define TclpRealloc \ (tclIntStubsPtr->tclpRealloc) /* 81 */ @@ -1068,10 +1020,7 @@ extern TclIntStubs *tclIntStubsPtr; #define TclProcInterpProc \ (tclIntStubsPtr->tclProcInterpProc) /* 94 */ #endif -#ifndef TclpStat -#define TclpStat \ - (tclIntStubsPtr->tclpStat) /* 95 */ -#endif +/* Slot 95 is reserved */ #ifndef TclRenameCommand #define TclRenameCommand \ (tclIntStubsPtr->tclRenameCommand) /* 96 */ @@ -1124,10 +1073,7 @@ extern TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclSockMinimumBuffers) /* 104 */ #endif #endif /* __WIN32__ */ -#ifndef TclStat -#define TclStat \ - (tclIntStubsPtr->tclStat) /* 105 */ -#endif +/* Slot 105 is reserved */ #ifndef TclStatDeleteProc #define TclStatDeleteProc \ (tclIntStubsPtr->tclStatDeleteProc) /* 106 */ @@ -1251,15 +1197,15 @@ extern TclIntStubs *tclIntStubsPtr; #define TclGetEnv \ (tclIntStubsPtr->tclGetEnv) /* 138 */ #endif -#ifndef TclpLoadFile -#define TclpLoadFile \ - (tclIntStubsPtr->tclpLoadFile) /* 139 */ -#endif +/* Slot 139 is reserved */ #ifndef TclLooksLikeInt #define TclLooksLikeInt \ (tclIntStubsPtr->tclLooksLikeInt) /* 140 */ #endif -/* Slot 141 is reserved */ +#ifndef TclpGetCwd +#define TclpGetCwd \ + (tclIntStubsPtr->tclpGetCwd) /* 141 */ +#endif #ifndef TclSetByteCodeFromAny #define TclSetByteCodeFromAny \ (tclIntStubsPtr->tclSetByteCodeFromAny) /* 142 */ @@ -1335,33 +1281,9 @@ extern TclIntStubs *tclIntStubsPtr; #define TclChannelEventScriptInvoker \ (tclIntStubsPtr->tclChannelEventScriptInvoker) /* 162 */ #endif -#ifndef TclFileCopyCmd -#define TclFileCopyCmd \ - (tclIntStubsPtr->tclFileCopyCmd) /* 163 */ -#endif -#ifndef TclFileRenameCmd -#define TclFileRenameCmd \ - (tclIntStubsPtr->tclFileRenameCmd) /* 164 */ -#endif -#ifndef TclFileDeleteCmd -#define TclFileDeleteCmd \ - (tclIntStubsPtr->tclFileDeleteCmd) /* 165 */ -#endif -#ifndef TclFileMakeDirsCmd -#define TclFileMakeDirsCmd \ - (tclIntStubsPtr->tclFileMakeDirsCmd) /* 166 */ -#endif -#ifndef TclFileAttrsCmd -#define TclFileAttrsCmd \ - (tclIntStubsPtr->tclFileAttrsCmd) /* 167 */ -#endif -#ifndef TclpTempFileName -#define TclpTempFileName \ - (tclIntStubsPtr->tclpTempFileName) /* 168 */ -#endif #ifndef TclpSetInitialEncodings #define TclpSetInitialEncodings \ - (tclIntStubsPtr->tclpSetInitialEncodings) /* 169 */ + (tclIntStubsPtr->tclpSetInitialEncodings) /* 163 */ #endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c index 5228292..97b18b8 100644 --- a/generic/tclLoadNone.c +++ b/generic/tclLoadNone.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadNone.c,v 1.4 1999/05/07 20:07:40 stanton Exp $ + * RCS: @(#) $Id: tclLoadNone.c,v 1.5 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclInt.h" @@ -35,9 +35,9 @@ */ int -TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) +TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *fileName; /* Name of the file containing the desired + 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. */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 647b3c3..932a61b 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.55 2001/08/23 17:37:08 vincentdarley Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.56 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclInt.h" @@ -47,7 +47,7 @@ TclIntStubs tclIntStubs = { TCL_STUB_MAGIC, NULL, - TclAccess, /* 0 */ + NULL, /* 0 */ TclAccessDeleteProc, /* 1 */ TclAccessInsertProc, /* 2 */ TclAllocateFreeObjects, /* 3 */ @@ -131,7 +131,7 @@ TclIntStubs tclIntStubs = { TclObjInvokeGlobal, /* 65 */ TclOpenFileChannelDeleteProc, /* 66 */ TclOpenFileChannelInsertProc, /* 67 */ - TclpAccess, /* 68 */ + NULL, /* 68 */ TclpAlloc, /* 69 */ NULL, /* 70 */ NULL, /* 71 */ @@ -142,8 +142,8 @@ TclIntStubs tclIntStubs = { TclpGetSeconds, /* 76 */ TclpGetTime, /* 77 */ TclpGetTimeZone, /* 78 */ - TclpListVolumes, /* 79 */ - TclpOpenFileChannel, /* 80 */ + NULL, /* 79 */ + NULL, /* 80 */ TclpRealloc, /* 81 */ NULL, /* 82 */ NULL, /* 83 */ @@ -158,7 +158,7 @@ TclIntStubs tclIntStubs = { TclProcCompileProc, /* 92 */ TclProcDeleteProc, /* 93 */ TclProcInterpProc, /* 94 */ - TclpStat, /* 95 */ + NULL, /* 95 */ TclRenameCommand, /* 96 */ TclResetShadowedCmdRefs, /* 97 */ TclServiceIdle, /* 98 */ @@ -184,7 +184,7 @@ TclIntStubs tclIntStubs = { #ifdef MAC_TCL NULL, /* 104 */ #endif /* MAC_TCL */ - TclStat, /* 105 */ + NULL, /* 105 */ TclStatDeleteProc, /* 106 */ TclStatInsertProc, /* 107 */ TclTeardownNamespace, /* 108 */ @@ -218,9 +218,9 @@ TclIntStubs tclIntStubs = { NULL, /* 136 */ NULL, /* 137 */ TclGetEnv, /* 138 */ - TclpLoadFile, /* 139 */ + NULL, /* 139 */ TclLooksLikeInt, /* 140 */ - NULL, /* 141 */ + TclpGetCwd, /* 141 */ TclSetByteCodeFromAny, /* 142 */ TclAddLiteralObj, /* 143 */ TclHideLiteral, /* 144 */ @@ -242,13 +242,7 @@ TclIntStubs tclIntStubs = { NULL, /* 160 */ TclChannelTransform, /* 161 */ TclChannelEventScriptInvoker, /* 162 */ - TclFileCopyCmd, /* 163 */ - TclFileRenameCmd, /* 164 */ - TclFileDeleteCmd, /* 165 */ - TclFileMakeDirsCmd, /* 166 */ - TclFileAttrsCmd, /* 167 */ - TclpTempFileName, /* 168 */ - TclpSetInitialEncodings, /* 169 */ + TclpSetInitialEncodings, /* 163 */ }; TclIntPlatStubs tclIntPlatStubs = { diff --git a/generic/tclTest.c b/generic/tclTest.c index f6fe969..f88412a 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTest.c,v 1.27 2001/08/23 17:37:08 vincentdarley Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.28 2001/08/30 08:53:15 vincentdarley Exp $ */ #define TCL_TEST @@ -167,6 +167,8 @@ static void SpecialFree _ANSI_ARGS_((char *blockPtr)); static int StaticInitProc _ANSI_ARGS_((Tcl_Interp *interp)); static int TestaccessprocCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); +static int PretendTclpAccess _ANSI_ARGS_((CONST char *path, + int mode)); static int TestAccessProc1 _ANSI_ARGS_((CONST char *path, int mode)); static int TestAccessProc2 _ANSI_ARGS_((CONST char *path, @@ -212,7 +214,7 @@ static int TestexprparserObjCmd _ANSI_ARGS_((ClientData dummy, static int TestexprstringCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); static int TestfileCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestfeventCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); static int TestgetassocdataCmd _ANSI_ARGS_((ClientData dummy, @@ -237,6 +239,8 @@ static int TestMathFunc2 _ANSI_ARGS_((ClientData clientData, Tcl_Value *resultPtr)); static int TestmainthreadCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); +static Tcl_Channel PretendTclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp, + char *filename, char *modeString, int permissions)); static Tcl_Channel TestOpenFileChannelProc1 _ANSI_ARGS_((Tcl_Interp *interp, char *filename, char *modeString, int permissions)); static Tcl_Channel TestOpenFileChannelProc2 _ANSI_ARGS_((Tcl_Interp *interp, @@ -279,6 +283,8 @@ static int TestsetrecursionlimitCmd _ANSI_ARGS_(( int objc, Tcl_Obj *CONST objv[])); static int TeststaticpkgCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); +static int PretendTclpStat _ANSI_ARGS_((CONST char *path, + struct stat *buf)); static int TestStatProc1 _ANSI_ARGS_((CONST char *path, struct stat *buf)); static int TestStatProc2 _ANSI_ARGS_((CONST char *path, @@ -466,7 +472,7 @@ Tcltest_Init(interp) (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand(interp, "testfile", TestfileCmd, + Tcl_CreateObjCommand(interp, "testfile", TestfileCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); @@ -3445,11 +3451,12 @@ static int TestfileCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int argc; /* Number of arguments. */ + Tcl_Obj *CONST argv[]; /* The argument objects. */ { int force, i, j, result; - Tcl_DString error, name[2]; + Tcl_Obj *error = NULL; + char *subcmd; if (argc < 3) { return TCL_ERROR; @@ -3457,54 +3464,51 @@ TestfileCmd(dummy, interp, argc, argv) force = 0; i = 2; - if (strcmp(argv[2], "-force") == 0) { + if (strcmp(Tcl_GetString(argv[2]), "-force") == 0) { force = 1; i = 3; } - Tcl_DStringInit(&name[0]); - Tcl_DStringInit(&name[1]); - Tcl_DStringInit(&error); - if (argc - i > 2) { return TCL_ERROR; } for (j = i; j < argc; j++) { - argv[j] = Tcl_TranslateFileName(interp, argv[j], &name[j - i]); - if (argv[j] == NULL) { + if (Tcl_FSGetTranslatedPath(interp, argv[j]) == NULL) { return TCL_ERROR; } } - if (strcmp(argv[1], "mv") == 0) { - result = TclpRenameFile(argv[i], argv[i + 1]); - } else if (strcmp(argv[1], "cp") == 0) { - result = TclpCopyFile(argv[i], argv[i + 1]); - } else if (strcmp(argv[1], "rm") == 0) { - result = TclpDeleteFile(argv[i]); - } else if (strcmp(argv[1], "mkdir") == 0) { - result = TclpCreateDirectory(argv[i]); - } else if (strcmp(argv[1], "cpdir") == 0) { - result = TclpCopyDirectory(argv[i], argv[i + 1], &error); - } else if (strcmp(argv[1], "rmdir") == 0) { - result = TclpRemoveDirectory(argv[i], force, &error); + subcmd = Tcl_GetString(argv[1]); + + if (strcmp(subcmd, "mv") == 0) { + result = TclpObjRenameFile(argv[i], argv[i + 1]); + } else if (strcmp(subcmd, "cp") == 0) { + result = TclpObjCopyFile(argv[i], argv[i + 1]); + } else if (strcmp(subcmd, "rm") == 0) { + result = TclpObjDeleteFile(argv[i]); + } else if (strcmp(subcmd, "mkdir") == 0) { + result = TclpObjCreateDirectory(argv[i]); + } else if (strcmp(subcmd, "cpdir") == 0) { + result = TclpObjCopyDirectory(argv[i], argv[i + 1], &error); + } else if (strcmp(subcmd, "rmdir") == 0) { + result = TclpObjRemoveDirectory(argv[i], force, &error); } else { result = TCL_ERROR; goto end; } if (result != TCL_OK) { - if (Tcl_DStringValue(&error)[0] != '\0') { - Tcl_AppendResult(interp, Tcl_DStringValue(&error), " ", NULL); + if (error != NULL) { + if (Tcl_GetString(error)[0] != '\0') { + Tcl_AppendResult(interp, Tcl_GetString(error), " ", NULL); + } + Tcl_DecrRefCount(error); } Tcl_AppendResult(interp, Tcl_ErrnoId(), (char *) NULL); } end: - Tcl_DStringFree(&error); - Tcl_DStringFree(&name[0]); - Tcl_DStringFree(&name[1]); return result; } @@ -4040,7 +4044,7 @@ TeststatprocCmd (dummy, interp, argc, argv) } if (strcmp(argv[2], "TclpStat") == 0) { - proc = TclpStat; + proc = PretendTclpStat; } else if (strcmp(argv[2], "TestStatProc1") == 0) { proc = TestStatProc1; } else if (strcmp(argv[2], "TestStatProc2") == 0) { @@ -4056,7 +4060,7 @@ TeststatprocCmd (dummy, interp, argc, argv) } if (strcmp(argv[1], "insert") == 0) { - if (proc == TclpStat) { + if (proc == PretendTclpStat) { Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", "must be ", "TestStatProc1, TestStatProc2, or TestStatProc3", @@ -4080,11 +4084,23 @@ TeststatprocCmd (dummy, interp, argc, argv) return retVal; } +static int PretendTclpStat(path, buf) + CONST char *path; + struct stat *buf; +{ + int ret; + Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1); + Tcl_IncrRefCount(pathPtr); + ret = Tcl_FSStat(pathPtr, buf); + Tcl_DecrRefCount(pathPtr); + return ret; +} + /* Be careful in the compares in these tests, since the Macintosh puts a * leading : in the beginning of non-absolute paths before passing them * into the file command procedures. */ - + static int TestStatProc1(path, buf) CONST char *path; @@ -4182,7 +4198,7 @@ TestaccessprocCmd (dummy, interp, argc, argv) } if (strcmp(argv[2], "TclpAccess") == 0) { - proc = TclpAccess; + proc = PretendTclpAccess; } else if (strcmp(argv[2], "TestAccessProc1") == 0) { proc = TestAccessProc1; } else if (strcmp(argv[2], "TestAccessProc2") == 0) { @@ -4198,7 +4214,7 @@ TestaccessprocCmd (dummy, interp, argc, argv) } if (strcmp(argv[1], "insert") == 0) { - if (proc == TclpAccess) { + if (proc == PretendTclpAccess) { Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", "must be ", "TestAccessProc1, TestAccessProc2, or TestAccessProc3", @@ -4222,6 +4238,17 @@ TestaccessprocCmd (dummy, interp, argc, argv) return retVal; } +static int PretendTclpAccess(path, mode) + CONST char *path; + int mode; +{ + int ret; + Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1); + Tcl_IncrRefCount(pathPtr); + ret = Tcl_FSAccess(pathPtr, mode); + Tcl_DecrRefCount(pathPtr); + return ret; +} static int TestAccessProc1(path, mode) @@ -4283,7 +4310,7 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv) } if (strcmp(argv[2], "TclpOpenFileChannel") == 0) { - proc = TclpOpenFileChannel; + proc = PretendTclpOpenFileChannel; } else if (strcmp(argv[2], "TestOpenFileChannelProc1") == 0) { proc = TestOpenFileChannelProc1; } else if (strcmp(argv[2], "TestOpenFileChannelProc2") == 0) { @@ -4300,7 +4327,7 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv) } if (strcmp(argv[1], "insert") == 0) { - if (proc == TclpOpenFileChannel) { + if (proc == PretendTclpOpenFileChannel) { Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", "must be ", "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or ", @@ -4325,6 +4352,24 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv) return retVal; } +static Tcl_Channel +PretendTclpOpenFileChannel(interp, fileName, modeString, permissions) + Tcl_Interp *interp; /* Interpreter for error reporting; + * can be NULL. */ + char *fileName; /* 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(fileName, -1); + Tcl_IncrRefCount(pathPtr); + ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions); + Tcl_DecrRefCount(pathPtr); + return ret; +} static Tcl_Channel TestOpenFileChannelProc1(interp, fileName, modeString, permissions) @@ -4337,18 +4382,18 @@ TestOpenFileChannelProc1(interp, fileName, modeString, permissions) * file, with what modes to create * it? */ { - char *expectname="testOpenFileChannel1%.fil"; + char *expectname="testOpenFileChannel1%.fil"; Tcl_DString ds; - Tcl_DStringInit(&ds); - Tcl_JoinPath(1, &expectname, &ds); + Tcl_DStringInit(&ds); + Tcl_JoinPath(1, &expectname, &ds); if (!strcmp(Tcl_DStringValue(&ds), fileName)) { - Tcl_DStringFree(&ds); - return (TclpOpenFileChannel(interp, "__testOpenFileChannel1%__.fil", + Tcl_DStringFree(&ds); + return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel1%__.fil", modeString, permissions)); } else { - Tcl_DStringFree(&ds); + Tcl_DStringFree(&ds); return (NULL); } } @@ -4365,18 +4410,18 @@ TestOpenFileChannelProc2(interp, fileName, modeString, permissions) * file, with what modes to create * it? */ { - char *expectname="testOpenFileChannel2%.fil"; + char *expectname="testOpenFileChannel2%.fil"; Tcl_DString ds; - Tcl_DStringInit(&ds); - Tcl_JoinPath(1, &expectname, &ds); + Tcl_DStringInit(&ds); + Tcl_JoinPath(1, &expectname, &ds); if (!strcmp(Tcl_DStringValue(&ds), fileName)) { - Tcl_DStringFree(&ds); - return (TclpOpenFileChannel(interp, "__testOpenFileChannel2%__.fil", + Tcl_DStringFree(&ds); + return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel2%__.fil", modeString, permissions)); } else { - Tcl_DStringFree(&ds); + Tcl_DStringFree(&ds); return (NULL); } } @@ -4393,18 +4438,18 @@ TestOpenFileChannelProc3(interp, fileName, modeString, permissions) * file, with what modes to create * it? */ { - char *expectname="testOpenFileChannel3%.fil"; + char *expectname="testOpenFileChannel3%.fil"; Tcl_DString ds; - Tcl_DStringInit(&ds); - Tcl_JoinPath(1, &expectname, &ds); + Tcl_DStringInit(&ds); + Tcl_JoinPath(1, &expectname, &ds); if (!strcmp(Tcl_DStringValue(&ds), fileName)) { - Tcl_DStringFree(&ds); - return (TclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil", + Tcl_DStringFree(&ds); + return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil", modeString, permissions)); } else { - Tcl_DStringFree(&ds); + Tcl_DStringFree(&ds); return (NULL); } } |