summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.decls8
-rw-r--r--generic/tclFCmd.c6
-rw-r--r--generic/tclFileName.c247
-rw-r--r--generic/tclIOUtil.c145
-rw-r--r--generic/tclInt.decls86
-rw-r--r--generic/tclInt.h23
-rw-r--r--generic/tclIntDecls.h142
-rw-r--r--generic/tclLoadNone.c6
-rw-r--r--generic/tclStubInit.c26
-rw-r--r--generic/tclTest.c155
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);
}
}
generated by cgit v0.12 at 2024-11-05 09:01:19 (GMT)