summaryrefslogtreecommitdiffstats
path: root/generic/tclFileName.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclFileName.c')
-rw-r--r--generic/tclFileName.c481
1 files changed, 171 insertions, 310 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 9b9d283..a8360fc 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -4,8 +4,8 @@
* This file contains routines for converting file names betwen native
* and network form.
*
- * Copyright © 1995-1998 Sun Microsystems, Inc.
- * Copyright © 1998-1999 Scriptics Corporation.
+ * Copyright (c) 1995-1998 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -37,27 +37,6 @@ static Tcl_Obj * SplitUnixPath(const char *path);
static int DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr,
const char *separators, Tcl_Obj *pathPtr, int flags,
char *pattern, Tcl_GlobTypeData *types);
-static int TclGlob(Tcl_Interp *interp, char *pattern,
- Tcl_Obj *pathPrefix, int globFlags,
- Tcl_GlobTypeData *types);
-
-/* Flag values used by TclGlob() */
-
-#ifdef TCL_NO_DEPRECATED
-# define TCL_GLOBMODE_NO_COMPLAIN 1
-# define TCL_GLOBMODE_DIR 4
-# define TCL_GLOBMODE_TAILS 8
-#endif
-
-/*
- * When there is no support for getting the block size of a file in a stat()
- * call, use this as a guess. Allow it to be overridden in the platform-
- * specific files.
- */
-
-#if (!defined(HAVE_STRUCT_STAT_ST_BLKSIZE) && !defined(GUESSED_BLOCK_SIZE))
-#define GUESSED_BLOCK_SIZE 1024
-#endif
/*
*----------------------------------------------------------------------
@@ -83,9 +62,9 @@ SetResultLength(
{
Tcl_DStringSetLength(resultPtr, offset);
if (extended == 2) {
- TclDStringAppendLiteral(resultPtr, "//?/UNC/");
+ Tcl_DStringAppend(resultPtr, "//?/UNC/", 8);
} else if (extended == 1) {
- TclDStringAppendLiteral(resultPtr, "//?/");
+ Tcl_DStringAppend(resultPtr, "//?/", 4);
}
}
@@ -100,7 +79,7 @@ SetResultLength(
* Results:
* Returns the position in the path immediately after the root including
* any trailing slashes. Appends a cleaned up version of the root to the
- * Tcl_DString at the specified offset.
+ * Tcl_DString at the specified offest.
*
* Side effects:
* Modifies the specified Tcl_DString.
@@ -142,7 +121,7 @@ ExtractWinRoot(
if (path[1] != '/' && path[1] != '\\') {
SetResultLength(resultPtr, offset, extended);
*typePtr = TCL_PATH_VOLUME_RELATIVE;
- TclDStringAppendLiteral(resultPtr, "/");
+ Tcl_DStringAppend(resultPtr, "/", 1);
return &path[1];
}
host = &path[2];
@@ -172,7 +151,7 @@ ExtractWinRoot(
*/
*typePtr = TCL_PATH_VOLUME_RELATIVE;
- TclDStringAppendLiteral(resultPtr, "/");
+ Tcl_DStringAppend(resultPtr, "/", 1);
return &path[2];
}
SetResultLength(resultPtr, offset, extended);
@@ -191,9 +170,9 @@ ExtractWinRoot(
break;
}
}
- TclDStringAppendLiteral(resultPtr, "//");
+ Tcl_DStringAppend(resultPtr, "//", 2);
Tcl_DStringAppend(resultPtr, host, hlen);
- TclDStringAppendLiteral(resultPtr, "/");
+ Tcl_DStringAppend(resultPtr, "/", 1);
Tcl_DStringAppend(resultPtr, share, slen);
tail = &share[slen];
@@ -232,7 +211,7 @@ ExtractWinRoot(
*typePtr = TCL_PATH_ABSOLUTE;
Tcl_DStringAppend(resultPtr, path, 2);
- TclDStringAppendLiteral(resultPtr, "/");
+ Tcl_DStringAppend(resultPtr, "/", 1);
return tail;
}
@@ -253,7 +232,7 @@ ExtractWinRoot(
if (path[4] == '\0') {
abs = 4;
- } else if (path[4] == ':' && path[5] == '\0') {
+ } else if (path [4] == ':' && path[5] == '\0') {
abs = 5;
}
@@ -275,7 +254,7 @@ ExtractWinRoot(
if (path[4] == '\0') {
abs = 4;
- } else if (path[4] == ':' && path[5] == '\0') {
+ } else if (path [4] == ':' && path[5] == '\0') {
abs = 5;
}
}
@@ -398,7 +377,7 @@ TclpGetNativePathType(
{
Tcl_PathType type = TCL_PATH_ABSOLUTE;
int pathLen;
- const char *path = TclGetStringFromObj(pathPtr, &pathLen);
+ const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
if (path[0] == '~') {
/*
@@ -424,6 +403,7 @@ TclpGetNativePathType(
if (path[0] == '/') {
++path;
+#if defined(__CYGWIN__) || defined(__QNX__)
/*
* Check for "//" network path prefix
*/
@@ -432,10 +412,22 @@ TclpGetNativePathType(
while (*path && *path != '/') {
++path;
}
+#if defined(__CYGWIN__)
+ /* UNC paths need to be followed by a share name */
+ if (*path++ && (*path && *path != '/')) {
+ ++path;
+ while (*path && *path != '/') {
+ ++path;
+ }
+ } else {
+ path = origPath + 1;
+ }
+#endif
}
+#endif
if (driveNameLengthPtr != NULL) {
/*
- * We need this addition in case the "//" code was used.
+ * We need this addition in case the QNX or Cygwin code was used.
*/
*driveNameLengthPtr = (path - origPath);
@@ -454,7 +446,8 @@ TclpGetNativePathType(
if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
*driveNameLengthPtr = rootEnd - path;
if (driveNameRef != NULL) {
- *driveNameRef = Tcl_DStringToObj(&ds);
+ *driveNameRef = Tcl_NewStringObj(Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
Tcl_IncrRefCount(*driveNameRef);
}
}
@@ -502,11 +495,11 @@ TclpNativeSplitPath(
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
- resultPtr = SplitUnixPath(TclGetString(pathPtr));
+ resultPtr = SplitUnixPath(Tcl_GetString(pathPtr));
break;
case TCL_PLATFORM_WINDOWS:
- resultPtr = SplitWinPath(TclGetString(pathPtr));
+ resultPtr = SplitWinPath(Tcl_GetString(pathPtr));
break;
}
@@ -515,7 +508,7 @@ TclpNativeSplitPath(
*/
if (lenPtr != NULL) {
- TclListObjLength(NULL, resultPtr, lenPtr);
+ Tcl_ListObjLength(NULL, resultPtr, lenPtr);
}
return resultPtr;
}
@@ -545,7 +538,6 @@ TclpNativeSplitPath(
*----------------------------------------------------------------------
*/
-#undef Tcl_SplitPath
void
Tcl_SplitPath(
const char *path, /* Pointer to string containing a path. */
@@ -577,7 +569,7 @@ Tcl_SplitPath(
size = 1;
for (i = 0; i < *argcPtr; i++) {
Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
- TclGetStringFromObj(eltPtr, &len);
+ Tcl_GetStringFromObj(eltPtr, &len);
size += len + 1;
}
@@ -586,7 +578,7 @@ Tcl_SplitPath(
* plus the argv pointers and the terminating NULL pointer.
*/
- *argvPtr = (const char **)ckalloc(
+ *argvPtr = (const char **) ckalloc((unsigned)
((((*argcPtr) + 1) * sizeof(char *)) + size));
/*
@@ -597,8 +589,8 @@ Tcl_SplitPath(
p = (char *) &(*argvPtr)[(*argcPtr) + 1];
for (i = 0; i < *argcPtr; i++) {
Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
- str = TclGetStringFromObj(eltPtr, &len);
- memcpy(p, str, len + 1);
+ str = Tcl_GetStringFromObj(eltPtr, &len);
+ memcpy(p, str, (size_t) len+1);
p += len+1;
}
@@ -644,16 +636,16 @@ SplitUnixPath(
{
int length;
const char *origPath = path, *elementStart;
- Tcl_Obj *result;
+ Tcl_Obj *result = Tcl_NewObj();
/*
* Deal with the root directory as a special case.
*/
- TclNewObj(result);
if (*path == '/') {
Tcl_Obj *rootElt;
++path;
+#if defined(__CYGWIN__) || defined(__QNX__)
/*
* Check for "//" network path prefix
*/
@@ -662,7 +654,19 @@ SplitUnixPath(
while (*path && *path != '/') {
++path;
}
+#if defined(__CYGWIN__)
+ /* UNC paths need to be followed by a share name */
+ if (*path++ && (*path && *path != '/')) {
+ ++path;
+ while (*path && *path != '/') {
+ ++path;
+ }
+ } else {
+ path = origPath + 1;
+ }
+#endif
}
+#endif
rootElt = Tcl_NewStringObj(origPath, path - origPath);
Tcl_ListObjAppendElement(NULL, result, rootElt);
while (*path == '/') {
@@ -723,10 +727,9 @@ SplitWinPath(
const char *p, *elementStart;
Tcl_PathType type = TCL_PATH_ABSOLUTE;
Tcl_DString buf;
- Tcl_Obj *result;
+ Tcl_Obj *result = Tcl_NewObj();
Tcl_DStringInit(&buf);
- TclNewObj(result);
p = ExtractWinRoot(path, &buf, 0, &type);
/*
@@ -734,7 +737,8 @@ SplitWinPath(
*/
if (p != path) {
- Tcl_ListObjAppendElement(NULL, result, Tcl_DStringToObj(&buf));
+ Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(
+ Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)));
}
Tcl_DStringFree(&buf);
@@ -796,28 +800,32 @@ Tcl_FSJoinToPath(
int objc, /* Number of array elements to join */
Tcl_Obj *const objv[]) /* Path elements to join. */
{
+ int i;
+ Tcl_Obj *lobj, *ret;
+
if (pathPtr == NULL) {
- return TclJoinPath(objc, objv, 0);
- }
- if (objc == 0) {
- return TclJoinPath(1, &pathPtr, 0);
+ lobj = Tcl_NewListObj(0, NULL);
+ } else {
+ lobj = Tcl_NewListObj(1, &pathPtr);
}
- if (objc == 1) {
- Tcl_Obj *pair[2];
- pair[0] = pathPtr;
- pair[1] = objv[0];
- return TclJoinPath(2, pair, 0);
- } else {
- int elemc = objc + 1;
- Tcl_Obj *ret, **elemv = (Tcl_Obj**)ckalloc(elemc*sizeof(Tcl_Obj *));
-
- elemv[0] = pathPtr;
- memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
- ret = TclJoinPath(elemc, elemv, 0);
- ckfree(elemv);
- return ret;
+ for (i = 0; i<objc;i++) {
+ Tcl_ListObjAppendElement(NULL, lobj, objv[i]);
}
+ ret = Tcl_FSJoinPath(lobj, -1);
+
+ /*
+ * It is possible that 'ret' is just a member of the list and is therefore
+ * going to be freed here. Therefore we must adjust the refCount manually.
+ * (It would be better if we changed the documentation of this function
+ * and Tcl_FSJoinPath so that the returned object already has a refCount
+ * for the caller, hence avoiding these subtleties (and code ugliness)).
+ */
+
+ Tcl_IncrRefCount(ret);
+ Tcl_DecrRefCount(lobj);
+ ret->refCount--;
+ return ret;
}
/*
@@ -846,7 +854,7 @@ TclpNativeJoinPath(
const char *p;
const char *start;
- start = TclGetStringFromObj(prefix, &length);
+ start = Tcl_GetStringFromObj(prefix, &length);
/*
* Remove the ./ from tilde prefixed elements, and drive-letter prefixed
@@ -874,7 +882,7 @@ TclpNativeJoinPath(
if (length > 0 && (start[length-1] != '/')) {
Tcl_AppendToObj(prefix, "/", 1);
- TclGetStringFromObj(prefix, &length);
+ Tcl_GetStringFromObj(prefix, &length);
}
needsSep = 0;
@@ -910,7 +918,7 @@ TclpNativeJoinPath(
if ((length > 0) &&
(start[length-1] != '/') && (start[length-1] != ':')) {
Tcl_AppendToObj(prefix, "/", 1);
- TclGetStringFromObj(prefix, &length);
+ Tcl_GetStringFromObj(prefix, &length);
}
needsSep = 0;
@@ -919,7 +927,7 @@ TclpNativeJoinPath(
*/
Tcl_SetObjLength(prefix, length + (int) strlen(p));
- dest = TclGetString(prefix) + length;
+ dest = Tcl_GetString(prefix) + length;
for (; *p != '\0'; p++) {
if ((*p == '/') || (*p == '\\')) {
while ((p[1] == '/') || (p[1] == '\\')) {
@@ -966,7 +974,7 @@ Tcl_JoinPath(
Tcl_DString *resultPtr) /* Pointer to previously initialized DString */
{
int i, len;
- Tcl_Obj *listObj;
+ Tcl_Obj *listObj = Tcl_NewObj();
Tcl_Obj *resultObj;
const char *resultStr;
@@ -974,7 +982,6 @@ Tcl_JoinPath(
* Build the list of paths.
*/
- TclNewObj(listObj);
for (i = 0; i < argc; i++) {
Tcl_ListObjAppendElement(NULL, listObj,
Tcl_NewStringObj(argv[i], -1));
@@ -993,7 +1000,7 @@ Tcl_JoinPath(
* Store the result.
*/
- resultStr = TclGetStringFromObj(resultObj, &len);
+ resultStr = Tcl_GetStringFromObj(resultObj, &len);
Tcl_DStringAppend(resultPtr, resultStr, len);
Tcl_DecrRefCount(resultObj);
@@ -1052,7 +1059,7 @@ Tcl_TranslateFileName(
}
Tcl_DStringInit(bufferPtr);
- TclDStringAppendObj(bufferPtr, transPtr);
+ Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1);
Tcl_DecrRefCount(path);
Tcl_DecrRefCount(transPtr);
@@ -1062,7 +1069,7 @@ Tcl_TranslateFileName(
*/
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
- char *p;
+ register char *p;
for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
if (*p == '/') {
*p = '\\';
@@ -1169,10 +1176,9 @@ DoTildeSubst(
dir = TclGetEnv("HOME", &dirString);
if (dir == NULL) {
if (interp) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "couldn't find HOME environment "
- "variable to expand path", -1));
- Tcl_SetErrorCode(interp, "TCL", "FILENAME", "NO_HOME", (void *)NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't find HOME environment "
+ "variable to expand path", NULL);
}
return NULL;
}
@@ -1181,9 +1187,8 @@ DoTildeSubst(
} else if (TclpGetUserHome(user, resultPtr) == NULL) {
if (interp) {
Tcl_ResetResult(interp);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "user \"%s\" doesn't exist", user));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, (void *)NULL);
+ Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
+ NULL);
}
return NULL;
}
@@ -1207,9 +1212,10 @@ DoTildeSubst(
*----------------------------------------------------------------------
*/
+ /* ARGSUSED */
int
Tcl_GlobObjCmd(
- TCL_UNUSED(ClientData),
+ ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -1217,14 +1223,14 @@ Tcl_GlobObjCmd(
int index, i, globFlags, length, join, dir, result;
char *string;
const char *separators;
- Tcl_Obj *typePtr, *look;
+ Tcl_Obj *typePtr, *resultPtr, *look;
Tcl_Obj *pathOrDir = NULL;
Tcl_DString prefix;
- static const char *const options[] = {
+ static const char *options[] = {
"-directory", "-join", "-nocomplain", "-path", "-tails",
"-types", "--", NULL
};
- enum globOptionsEnum {
+ enum options {
GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS,
GLOB_TYPE, GLOB_LAST
};
@@ -1238,7 +1244,7 @@ Tcl_GlobObjCmd(
for (i = 1; i < objc; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
&index) != TCL_OK) {
- string = TclGetStringFromObj(objv[i], &length);
+ string = Tcl_GetStringFromObj(objv[i], &length);
if (string[0] == '-') {
/*
* It looks like the command contains an option so signal an
@@ -1257,7 +1263,7 @@ Tcl_GlobObjCmd(
}
}
- switch ((enum globOptionsEnum) index) {
+ switch (index) {
case GLOB_NOCOMPLAIN: /* -nocomplain */
globFlags |= TCL_GLOBMODE_NO_COMPLAIN;
break;
@@ -1265,17 +1271,11 @@ Tcl_GlobObjCmd(
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing argument to \"-directory\"", -1));
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (void *)NULL);
return TCL_ERROR;
}
if (dir != PATH_NONE) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- dir == PATH_DIR
- ? "\"-directory\" may only be used once"
- : "\"-directory\" cannot be used with \"-path\"",
- -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
- "BADOPTIONCOMBINATION", (void *)NULL);
+ "\"-directory\" cannot be used with \"-path\"", -1));
return TCL_ERROR;
}
dir = PATH_DIR;
@@ -1293,17 +1293,11 @@ Tcl_GlobObjCmd(
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing argument to \"-path\"", -1));
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (void *)NULL);
return TCL_ERROR;
}
if (dir != PATH_NONE) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- dir == PATH_GENERAL
- ? "\"-path\" may only be used once"
- : "\"-path\" cannot be used with \"-dictionary\"",
- -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
- "BADOPTIONCOMBINATION", (void *)NULL);
+ "\"-path\" cannot be used with \"-directory\"", -1));
return TCL_ERROR;
}
dir = PATH_GENERAL;
@@ -1314,11 +1308,10 @@ Tcl_GlobObjCmd(
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing argument to \"-types\"", -1));
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (void *)NULL);
return TCL_ERROR;
}
typePtr = objv[i+1];
- if (TclListObjLength(interp, typePtr, &length) != TCL_OK) {
+ if (Tcl_ListObjLength(interp, typePtr, &length) != TCL_OK) {
return TCL_ERROR;
}
i++;
@@ -1330,16 +1323,18 @@ Tcl_GlobObjCmd(
}
endOfForLoop:
+ if (objc - i < 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?");
+ return TCL_ERROR;
+ }
if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tcl_AppendResult(interp,
"\"-tails\" must be used with either "
- "\"-directory\" or \"-path\"", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
- "BADOPTIONCOMBINATION", (void *)NULL);
+ "\"-directory\" or \"-path\"", NULL);
return TCL_ERROR;
}
- separators = NULL;
+ separators = NULL; /* lint. */
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
separators = "/";
@@ -1352,7 +1347,7 @@ Tcl_GlobObjCmd(
if (dir == PATH_GENERAL) {
int pathlength;
const char *last;
- const char *first = TclGetStringFromObj(pathOrDir,&pathlength);
+ const char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);
/*
* Find the last path separator in the path
@@ -1399,15 +1394,11 @@ Tcl_GlobObjCmd(
* We must ensure that we haven't cut off too much, and turned
* a valid path like '/' or 'C:/' into an incorrect path like
* '' or 'C:'. The way we do this is to add a separator if
- * there are none presently in the prefix. Similar treatment
- * for the zipfs volume.
+ * there are none presently in the prefix.
*/
- const char *temp = Tcl_GetString(pathOrDir);
- if (strpbrk(temp, "\\/") == NULL) {
+ if (strpbrk(Tcl_GetString(pathOrDir), "\\/") == NULL) {
Tcl_AppendToObj(pathOrDir, last-1, 1);
- } else if (!strcmp(temp, "//zipfs:")) {
- Tcl_AppendToObj(pathOrDir, "/", 1);
}
}
@@ -1419,7 +1410,7 @@ Tcl_GlobObjCmd(
search = Tcl_DStringValue(&pref);
while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) {
Tcl_DStringAppend(&prefix, search, find-search);
- TclDStringAppendLiteral(&prefix, "\\");
+ Tcl_DStringAppend(&prefix, "\\", 1);
Tcl_DStringAppend(&prefix, find, 1);
search = find+1;
if (*search == '\0') {
@@ -1444,11 +1435,12 @@ Tcl_GlobObjCmd(
* platform.
*/
- TclListObjLength(interp, typePtr, &length);
+ Tcl_ListObjLength(interp, typePtr, &length);
if (length <= 0) {
goto skipTypes;
}
- globTypes = (Tcl_GlobTypeData *)TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
+ globTypes = (Tcl_GlobTypeData*)
+ TclStackAlloc(interp,sizeof(Tcl_GlobTypeData));
globTypes->type = 0;
globTypes->perm = 0;
globTypes->macType = NULL;
@@ -1459,7 +1451,7 @@ Tcl_GlobObjCmd(
const char *str;
Tcl_ListObjIndex(interp, typePtr, length, &look);
- str = TclGetStringFromObj(look, &len);
+ str = Tcl_GetStringFromObj(look, &len);
if (strcmp("readonly", str) == 0) {
globTypes->perm |= TCL_GLOB_PERM_RONLY;
} else if (strcmp("hidden", str) == 0) {
@@ -1514,7 +1506,7 @@ Tcl_GlobObjCmd(
} else {
Tcl_Obj *item;
- if ((TclListObjLength(NULL, look, &len) == TCL_OK)
+ if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK)
&& (len == 3)) {
Tcl_ListObjIndex(interp, look, 0, &item);
if (!strcmp("macintosh", Tcl_GetString(item))) {
@@ -1545,10 +1537,10 @@ Tcl_GlobObjCmd(
*/
badTypesArg:
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad argument to \"-types\": %s",
- Tcl_GetString(look)));
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", (void *)NULL);
+ TclNewObj(resultPtr);
+ Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
+ Tcl_AppendObjToObj(resultPtr, look);
+ Tcl_SetObjResult(interp, resultPtr);
result = TCL_ERROR;
join = 0;
goto endOfGlob;
@@ -1558,7 +1550,6 @@ Tcl_GlobObjCmd(
"only one MacOS type or creator argument"
" to \"-types\" allowed", -1));
result = TCL_ERROR;
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", (void *)NULL);
join = 0;
goto endOfGlob;
}
@@ -1581,7 +1572,8 @@ Tcl_GlobObjCmd(
Tcl_DStringInit(&prefix);
}
for (i = 0; i < objc; i++) {
- TclDStringAppendObj(&prefix, objv[i]);
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ Tcl_DStringAppend(&prefix, string, length);
if (i != objc -1) {
Tcl_DStringAppend(&prefix, separators, 1);
}
@@ -1594,13 +1586,14 @@ Tcl_GlobObjCmd(
} else if (dir == PATH_GENERAL) {
Tcl_DString str;
- Tcl_DStringInit(&str);
for (i = 0; i < objc; i++) {
- Tcl_DStringSetLength(&str, 0);
+ Tcl_DStringInit(&str);
if (dir == PATH_GENERAL) {
- TclDStringAppendDString(&str, &prefix);
+ Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix),
+ Tcl_DStringLength(&prefix));
}
- TclDStringAppendObj(&str, objv[i]);
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ Tcl_DStringAppend(&str, string, length);
if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir, globFlags,
globTypes) != TCL_OK) {
result = TCL_ERROR;
@@ -1621,7 +1614,7 @@ Tcl_GlobObjCmd(
}
if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) {
- if (TclListObjLength(interp, Tcl_GetObjResult(interp),
+ if (Tcl_ListObjLength(interp, Tcl_GetObjResult(interp),
&length) != TCL_OK) {
/*
* This should never happen. Maybe we should be more dramatic.
@@ -1632,25 +1625,19 @@ Tcl_GlobObjCmd(
}
if (length == 0) {
- Tcl_Obj *errorMsg =
- Tcl_ObjPrintf("no files matched glob pattern%s \"",
- (join || (objc == 1)) ? "" : "s");
-
+ Tcl_AppendResult(interp, "no files matched glob pattern",
+ (join || (objc == 1)) ? " \"" : "s \"", NULL);
if (join) {
- Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1);
+ Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL);
} else {
const char *sep = "";
-
for (i = 0; i < objc; i++) {
- Tcl_AppendPrintfToObj(errorMsg, "%s%s",
- sep, Tcl_GetString(objv[i]));
+ string = Tcl_GetString(objv[i]);
+ Tcl_AppendResult(interp, sep, string, NULL);
sep = " ";
}
}
- Tcl_AppendToObj(errorMsg, "\"", -1);
- Tcl_SetObjResult(interp, errorMsg);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH",
- (void *)NULL);
+ Tcl_AppendResult(interp, "\"", NULL);
result = TCL_ERROR;
}
}
@@ -1679,8 +1666,9 @@ Tcl_GlobObjCmd(
*
* TclGlob --
*
- * Sets the separator string based on the platform, performs tilde
- * substitution, and calls DoGlob.
+ * This procedure prepares arguments for the DoGlob call. It sets the
+ * separator string based on the platform, performs * tilde substitution,
+ * and calls DoGlob.
*
* The interpreter's result, on entry to this function, must be a valid
* Tcl list (e.g. it could be empty), since we will lappend any new
@@ -1703,7 +1691,8 @@ Tcl_GlobObjCmd(
*----------------------------------------------------------------------
*/
-static int
+ /* ARGSUSED */
+int
TclGlob(
Tcl_Interp *interp, /* Interpreter for returning error message or
* appending list of matching file names. */
@@ -1721,7 +1710,7 @@ TclGlob(
int result;
Tcl_Obj *filenamesObj, *savedResultObj;
- separators = NULL;
+ separators = NULL; /* lint. */
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
separators = "/";
@@ -1771,7 +1760,8 @@ TclGlob(
if (head != Tcl_DStringValue(&buffer)) {
Tcl_DStringAppend(&buffer, head, -1);
}
- pathPrefix = Tcl_DStringToObj(&buffer);
+ pathPrefix = Tcl_NewStringObj(Tcl_DStringValue(&buffer),
+ Tcl_DStringLength(&buffer));
Tcl_IncrRefCount(pathPrefix);
globFlags |= TCL_GLOBMODE_DIR;
if (c != '\0') {
@@ -1878,7 +1868,7 @@ TclGlob(
separators = "/\\";
} else if (tclPlatform == TCL_PLATFORM_UNIX) {
- if (pathPrefix == NULL && tail[0] == '/' && tail[1] != '/') {
+ if (pathPrefix == NULL && tail[0] == '/') {
pathPrefix = Tcl_NewStringObj(tail, 1);
tail++;
Tcl_IncrRefCount(pathPrefix);
@@ -1901,10 +1891,10 @@ TclGlob(
}
/*
- * To process a [glob] invocation, this function may be called multiple
+ * To process a [glob] invokation, this function may be called multiple
* times. Each time, the previously discovered filenames are in the
* interpreter result. We stash that away here so the result is free for
- * error messages.
+ * error messsages.
*/
savedResultObj = Tcl_GetObjResult(interp);
@@ -1989,7 +1979,7 @@ TclGlob(
Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL");
}
- pre = TclGetStringFromObj(pathPrefix, &prefixLen);
+ pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen);
if (prefixLen > 0
&& (strchr(separators, pre[prefixLen-1]) == NULL)) {
/*
@@ -2004,10 +1994,10 @@ TclGlob(
}
}
- TclListObjGetElements(NULL, filenamesObj, &objc, &objv);
+ Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv);
for (i = 0; i< objc; i++) {
int len;
- const char *oldStr = TclGetStringFromObj(objv[i], &len);
+ const char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
Tcl_Obj *elem;
if (len == prefixLen) {
@@ -2055,7 +2045,7 @@ TclGlob(
* SkipToChar --
*
* This function traverses a glob pattern looking for the next unquoted
- * occurrence of the specified character at the same braces nesting level.
+ * occurance of the specified character at the same braces nesting level.
*
* Results:
* Updates stringPtr to point to the matching character, or to the end of
@@ -2074,7 +2064,7 @@ SkipToChar(
int match) /* Character to find. */
{
int quoted, level;
- char *p;
+ register char *p;
quoted = 0;
level = 0;
@@ -2145,7 +2135,7 @@ DoGlob(
Tcl_GlobTypeData *types) /* List object containing list of acceptable
* types. May be NULL. */
{
- int baseLength, quoted;
+ int baseLength, quoted, count;
int result = TCL_OK;
char *name, *p, *openBrace, *closeBrace, *firstSpecialChar;
Tcl_Obj *joinedPtr;
@@ -2155,6 +2145,7 @@ DoGlob(
* past the last initial separator.
*/
+ count = 0;
name = pattern;
for (; *pattern != '\0'; pattern++) {
if (*pattern == '\\') {
@@ -2174,6 +2165,7 @@ DoGlob(
} else if (strchr(separators, *pattern) == NULL) {
break;
}
+ count++;
}
/*
@@ -2213,17 +2205,13 @@ DoGlob(
closeBrace = p;
break;
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unmatched open-brace in file name", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
- (void *)NULL);
+ Tcl_SetResult(interp, "unmatched open-brace in file name",
+ TCL_STATIC);
return TCL_ERROR;
} else if (*p == '}') {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unmatched close-brace in file name", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
- (void *)NULL);
+ Tcl_SetResult(interp, "unmatched close-brace in file name",
+ TCL_STATIC);
return TCL_ERROR;
}
}
@@ -2331,13 +2319,13 @@ DoGlob(
int subdirc, i, repair = -1;
Tcl_Obj **subdirv;
- result = TclListObjGetElements(interp, subdirsPtr,
+ result = Tcl_ListObjGetElements(interp, subdirsPtr,
&subdirc, &subdirv);
for (i=0; result==TCL_OK && i<subdirc; i++) {
Tcl_Obj *copy = NULL;
if (pathPtr == NULL && Tcl_GetString(subdirv[i])[0] == '~') {
- TclListObjLength(NULL, matchesObj, &repair);
+ Tcl_ListObjLength(NULL, matchesObj, &repair);
copy = subdirv[i];
subdirv[i] = Tcl_NewStringObj("./", 2);
Tcl_AppendObjToObj(subdirv[i], copy);
@@ -2350,14 +2338,14 @@ DoGlob(
Tcl_DecrRefCount(subdirv[i]);
subdirv[i] = copy;
- TclListObjLength(NULL, matchesObj, &end);
+ Tcl_ListObjLength(NULL, matchesObj, &end);
while (repair < end) {
const char *bytes;
int numBytes;
Tcl_Obj *fixme, *newObj;
Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
- bytes = TclGetStringFromObj(fixme, &numBytes);
+ bytes = Tcl_GetStringFromObj(fixme, &numBytes);
newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
1, &newObj);
@@ -2395,7 +2383,7 @@ DoGlob(
Tcl_DStringAppend(&append, pattern, p-pattern);
if (pathPtr != NULL) {
- (void) TclGetStringFromObj(pathPtr, &length);
+ (void) Tcl_GetStringFromObj(pathPtr, &length);
} else {
length = 0;
}
@@ -2405,9 +2393,9 @@ DoGlob(
if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
if (((*name == '\\') && (name[1] == '/' ||
name[1] == '\\')) || (*name == '/')) {
- TclDStringAppendLiteral(&append, "/");
+ Tcl_DStringAppend(&append, "/", 1);
} else {
- TclDStringAppendLiteral(&append, ".");
+ Tcl_DStringAppend(&append, ".", 1);
}
}
@@ -2416,9 +2404,9 @@ DoGlob(
case TCL_PLATFORM_UNIX:
if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
- TclDStringAppendLiteral(&append, "/");
+ Tcl_DStringAppend(&append, "/", 1);
} else {
- TclDStringAppendLiteral(&append, ".");
+ Tcl_DStringAppend(&append, ".", 1);
}
}
break;
@@ -2429,7 +2417,8 @@ DoGlob(
*/
if (pathPtr == NULL) {
- joinedPtr = Tcl_DStringToObj(&append);
+ joinedPtr = Tcl_NewStringObj(Tcl_DStringValue(&append),
+ Tcl_DStringLength(&append));
} else if (flags) {
joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append),
Tcl_DStringLength(&append));
@@ -2441,9 +2430,9 @@ DoGlob(
*/
int len;
- const char *joined = TclGetStringFromObj(joinedPtr,&len);
+ const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
- if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
+ if (strchr(separators, joined[len-1]) == NULL) {
Tcl_AppendToObj(joinedPtr, "/", 1);
}
}
@@ -2478,9 +2467,9 @@ DoGlob(
*/
int len;
- const char *joined = TclGetStringFromObj(joinedPtr,&len);
+ const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
- if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
+ if (strchr(separators, joined[len-1]) == NULL) {
if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
Tcl_AppendToObj(joinedPtr, "/", 1);
}
@@ -2518,138 +2507,10 @@ DoGlob(
Tcl_StatBuf *
Tcl_AllocStatBuf(void)
{
- return (Tcl_StatBuf *)ckalloc(sizeof(Tcl_StatBuf));
+ return (Tcl_StatBuf *) ckalloc(sizeof(Tcl_StatBuf));
}
/*
- *---------------------------------------------------------------------------
- *
- * Access functions for Tcl_StatBuf --
- *
- * These functions provide portable read-only access to the portable
- * fields of the Tcl_StatBuf structure (really a 'struct stat', 'struct
- * stat64' or something else related). [TIP #316]
- *
- * Results:
- * The value from the field being retrieved.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-unsigned
-Tcl_GetFSDeviceFromStat(
- const Tcl_StatBuf *statPtr)
-{
- return statPtr->st_dev;
-}
-
-unsigned
-Tcl_GetFSInodeFromStat(
- const Tcl_StatBuf *statPtr)
-{
- return statPtr->st_ino;
-}
-
-unsigned
-Tcl_GetModeFromStat(
- const Tcl_StatBuf *statPtr)
-{
- return statPtr->st_mode;
-}
-
-int
-Tcl_GetLinkCountFromStat(
- const Tcl_StatBuf *statPtr)
-{
- return (int)statPtr->st_nlink;
-}
-
-int
-Tcl_GetUserIdFromStat(
- const Tcl_StatBuf *statPtr)
-{
- return (int) statPtr->st_uid;
-}
-
-int
-Tcl_GetGroupIdFromStat(
- const Tcl_StatBuf *statPtr)
-{
- return (int) statPtr->st_gid;
-}
-
-int
-Tcl_GetDeviceTypeFromStat(
- const Tcl_StatBuf *statPtr)
-{
- return (int) statPtr->st_rdev;
-}
-
-long long
-Tcl_GetAccessTimeFromStat(
- const Tcl_StatBuf *statPtr)
-{
- return (long long) statPtr->st_atime;
-}
-
-long long
-Tcl_GetModificationTimeFromStat(
- const Tcl_StatBuf *statPtr)
-{
- return (long long) statPtr->st_mtime;
-}
-
-long long
-Tcl_GetChangeTimeFromStat(
- const Tcl_StatBuf *statPtr)
-{
- return (long long) statPtr->st_ctime;
-}
-
-unsigned long long
-Tcl_GetSizeFromStat(
- const Tcl_StatBuf *statPtr)
-{
- return (unsigned long long) statPtr->st_size;
-}
-
-unsigned long long
-Tcl_GetBlocksFromStat(
- const Tcl_StatBuf *statPtr)
-{
-#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
- return (unsigned long long) statPtr->st_blocks;
-#else
- unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr);
-
- return ((unsigned long long) statPtr->st_size + blksize - 1) / blksize;
-#endif
-}
-
-#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
-unsigned
-Tcl_GetBlockSizeFromStat(
- const Tcl_StatBuf *statPtr)
-{
- return statPtr->st_blksize;
-}
-#else
-unsigned
-Tcl_GetBlockSizeFromStat(
- TCL_UNUSED(const Tcl_StatBuf *))
-{
- /*
- * Not a great guess, but will do...
- */
-
- return GUESSED_BLOCK_SIZE;
-}
-#endif
-
-/*
* Local Variables:
* mode: c
* c-basic-offset: 4
generated by cgit v0.12 at 2025-12-20 11:17:27 (GMT)