summaryrefslogtreecommitdiffstats
path: root/generic/tclFileName.c
diff options
context:
space:
mode:
authorstanton <stanton>1999-04-16 00:46:29 (GMT)
committerstanton <stanton>1999-04-16 00:46:29 (GMT)
commit97464e6cba8eb0008cf2727c15718671992b913f (patch)
treece9959f2747257d98d52ec8d18bf3b0de99b9535 /generic/tclFileName.c
parenta8c96ddb94d1483a9de5e340b740cb74ef6cafa7 (diff)
downloadtcl-97464e6cba8eb0008cf2727c15718671992b913f.zip
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.gz
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.bz2
merged tcl 8.1 branch back into the main trunk
Diffstat (limited to 'generic/tclFileName.c')
-rw-r--r--generic/tclFileName.c604
1 files changed, 356 insertions, 248 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 7be9c0e..06e83a3 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -4,12 +4,13 @@
* This file contains routines for converting file names betwen
* native and network form.
*
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1998 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclFileName.c,v 1.5 1999/03/10 05:52:48 stanton Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.6 1999/04/16 00:46:46 stanton Exp $
*/
#include "tclInt.h"
@@ -17,19 +18,12 @@
#include "tclRegexp.h"
/*
- * This variable indicates whether the cleanup procedure has been
- * registered for this file yet.
- */
-
-static int initialized = 0;
-
-/*
* The following regular expression matches the root portion of a Windows
* absolute or volume relative path. It will match both UNC and drive relative
* paths.
*/
-#define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\][/\\]+([^/\\]+)[/\\]+([^/\\]+)|([/\\]))([/\\])*"
+#define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\\\][/\\\\]+([^/\\\\]+)[/\\\\]+([^/\\\\]+)|([/\\\\]))([/\\\\])*"
/*
* The following regular expression matches the root portion of a Macintosh
@@ -44,8 +38,13 @@ static int initialized = 0;
* for use in filename matching.
*/
-static regexp *winRootPatternPtr = NULL;
-static regexp *macRootPatternPtr = NULL;
+typedef struct ThreadSpecificData {
+ int initialized;
+ Tcl_Obj *winRootPatternPtr;
+ Tcl_Obj *macRootPatternPtr;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
/*
* The following variable is set in the TclPlatformInit call to one
@@ -59,22 +58,51 @@ TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
*/
static char * DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
- char *user, Tcl_DString *resultPtr));
-static char * ExtractWinRoot _ANSI_ARGS_((char *path,
+ CONST char *user, Tcl_DString *resultPtr));
+static CONST char * ExtractWinRoot _ANSI_ARGS_((CONST char *path,
Tcl_DString *resultPtr, int offset));
static void FileNameCleanup _ANSI_ARGS_((ClientData clientData));
+static void FileNameInit _ANSI_ARGS_((void));
static int SkipToChar _ANSI_ARGS_((char **stringPtr,
char *match));
-static char * SplitMacPath _ANSI_ARGS_((char *path,
+static char * SplitMacPath _ANSI_ARGS_((CONST char *path,
Tcl_DString *bufPtr));
-static char * SplitWinPath _ANSI_ARGS_((char *path,
+static char * SplitWinPath _ANSI_ARGS_((CONST char *path,
Tcl_DString *bufPtr));
-static char * SplitUnixPath _ANSI_ARGS_((char *path,
+static char * SplitUnixPath _ANSI_ARGS_((CONST char *path,
Tcl_DString *bufPtr));
/*
*----------------------------------------------------------------------
*
+ * FileNameInit --
+ *
+ * This procedure initializes the patterns used by this module.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Compiles the regular expressions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileNameInit()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ tsdPtr->winRootPatternPtr = Tcl_NewStringObj(WIN_ROOT_PATTERN, -1);
+ tsdPtr->macRootPatternPtr = Tcl_NewStringObj(MAC_ROOT_PATTERN, -1);
+ Tcl_CreateThreadExitHandler(FileNameCleanup, NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* FileNameCleanup --
*
* This procedure is a Tcl_ExitProc used to clean up the static
@@ -93,15 +121,10 @@ static void
FileNameCleanup(clientData)
ClientData clientData; /* Not used. */
{
- if (winRootPatternPtr != NULL) {
- ckfree((char *)winRootPatternPtr);
- winRootPatternPtr = (regexp *) NULL;
- }
- if (macRootPatternPtr != NULL) {
- ckfree((char *)macRootPatternPtr);
- macRootPatternPtr = (regexp *) NULL;
- }
- initialized = 0;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Tcl_DecrRefCount(tsdPtr->winRootPatternPtr);
+ Tcl_DecrRefCount(tsdPtr->macRootPatternPtr);
+ tsdPtr->initialized = 0;
}
/*
@@ -124,55 +147,59 @@ FileNameCleanup(clientData)
*----------------------------------------------------------------------
*/
-static char *
+static CONST char *
ExtractWinRoot(path, resultPtr, offset)
- char *path; /* Path to parse. */
+ CONST char *path; /* Path to parse. */
Tcl_DString *resultPtr; /* Buffer to hold result. */
int offset; /* Offset in buffer where result should be
* stored. */
{
int length;
+ Tcl_RegExp re;
+ char *dummy, *tail, *drive, *hostStart, *hostEnd, *shareStart,
+ *shareEnd, *lastSlash;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Initialize the path name parser for Windows path names.
*/
- if (winRootPatternPtr == NULL) {
- winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
- if (!initialized) {
- Tcl_CreateExitHandler(FileNameCleanup, NULL);
- initialized = 1;
- }
- }
+ FileNameInit();
+
+ re = Tcl_GetRegExpFromObj(NULL, tsdPtr->winRootPatternPtr, REG_ADVANCED);
/*
* Match the root portion of a Windows path name.
*/
- if (!TclRegExec(winRootPatternPtr, path, path)) {
+ if (!Tcl_RegExpExec(NULL, re, path, path)) {
return path;
}
Tcl_DStringSetLength(resultPtr, offset);
- if (winRootPatternPtr->startp[2] != NULL) {
- Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[2], 2);
- if (winRootPatternPtr->startp[6] != NULL) {
+ Tcl_RegExpRange(re, 0, &dummy, &tail);
+ Tcl_RegExpRange(re, 2, &drive, &dummy);
+ Tcl_RegExpRange(re, 3, &hostStart, &hostEnd);
+ Tcl_RegExpRange(re, 4, &shareStart, &shareEnd);
+ Tcl_RegExpRange(re, 6, &lastSlash, &dummy);
+
+ if (drive != NULL) {
+ Tcl_DStringAppend(resultPtr, drive, 2);
+ if (lastSlash != NULL) {
Tcl_DStringAppend(resultPtr, "/", 1);
}
- } else if (winRootPatternPtr->startp[4] != NULL) {
+ } else if (shareStart != NULL) {
Tcl_DStringAppend(resultPtr, "//", 2);
- length = winRootPatternPtr->endp[3]
- - winRootPatternPtr->startp[3];
- Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[3], length);
+ length = hostEnd - hostStart;
+ Tcl_DStringAppend(resultPtr, hostStart, length);
Tcl_DStringAppend(resultPtr, "/", 1);
- length = winRootPatternPtr->endp[4]
- - winRootPatternPtr->startp[4];
- Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[4], length);
+ length = shareEnd - shareStart;
+ Tcl_DStringAppend(resultPtr, shareStart, length);
} else {
Tcl_DStringAppend(resultPtr, "/", 1);
}
- return winRootPatternPtr->endp[0];
+ return tail;
}
/*
@@ -197,7 +224,9 @@ Tcl_PathType
Tcl_GetPathType(path)
char *path;
{
+ ThreadSpecificData *tsdPtr;
Tcl_PathType type = TCL_PATH_ABSOLUTE;
+ Tcl_RegExp re;
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
@@ -214,45 +243,51 @@ Tcl_GetPathType(path)
if (path[0] == ':') {
type = TCL_PATH_RELATIVE;
} else if (path[0] != '~') {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Since we have eliminated the easy cases, use the
* root pattern to look for the other types.
*/
- if (!macRootPatternPtr) {
- macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
- if (!initialized) {
- Tcl_CreateExitHandler(FileNameCleanup, NULL);
- initialized = 1;
- }
- }
- if (!TclRegExec(macRootPatternPtr, path, path)
- || (macRootPatternPtr->startp[2] != NULL)) {
+ FileNameInit();
+ re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr,
+ REG_ADVANCED);
+
+ if (!Tcl_RegExpExec(NULL, re, path, path)) {
type = TCL_PATH_RELATIVE;
+ } else {
+ char *unixRoot, *dummy;
+
+ Tcl_RegExpRange(re, 2, &unixRoot, &dummy);
+ if (unixRoot) {
+ type = TCL_PATH_RELATIVE;
+ }
}
}
break;
case TCL_PLATFORM_WINDOWS:
if (path[0] != '~') {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Since we have eliminated the easy cases, check for
* drive relative paths using the regular expression.
*/
- if (!winRootPatternPtr) {
- winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
- if (!initialized) {
- Tcl_CreateExitHandler(FileNameCleanup, NULL);
- initialized = 1;
- }
- }
- if (TclRegExec(winRootPatternPtr, path, path)) {
- if (winRootPatternPtr->startp[5]
- || (winRootPatternPtr->startp[2]
- && !(winRootPatternPtr->startp[6]))) {
+ FileNameInit();
+ re = Tcl_GetRegExpFromObj(NULL, tsdPtr->winRootPatternPtr,
+ REG_ADVANCED);
+
+ if (Tcl_RegExpExec(NULL, re, path, path)) {
+ char *drive, *dummy, *unixRoot, *lastSlash;
+
+ Tcl_RegExpRange(re, 2, &drive, &dummy);
+ Tcl_RegExpRange(re, 5, &unixRoot, &dummy);
+ Tcl_RegExpRange(re, 6, &lastSlash, &dummy);
+
+ if (unixRoot || (drive && !lastSlash)) {
type = TCL_PATH_VOLUME_RELATIVE;
}
} else {
@@ -292,7 +327,7 @@ Tcl_GetPathType(path)
void
Tcl_SplitPath(path, argcPtr, argvPtr)
- char *path; /* Pointer to string containing a path. */
+ CONST char *path; /* Pointer to string containing a path. */
int *argcPtr; /* Pointer to location to fill in with
* the number of elements in the path. */
char ***argvPtr; /* Pointer to place to store pointer to array
@@ -301,6 +336,7 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
int i, size;
char *p;
Tcl_DString buffer;
+
Tcl_DStringInit(&buffer);
/*
@@ -385,11 +421,11 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
static char *
SplitUnixPath(path, bufPtr)
- char *path; /* Pointer to string containing a path. */
+ CONST char *path; /* Pointer to string containing a path. */
Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
{
int length;
- char *p, *elementStart;
+ CONST char *p, *elementStart;
/*
* Deal with the root directory as a special case.
@@ -447,11 +483,11 @@ SplitUnixPath(path, bufPtr)
static char *
SplitWinPath(path, bufPtr)
- char *path; /* Pointer to string containing a path. */
+ CONST char *path; /* Pointer to string containing a path. */
Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
{
int length;
- char *p, *elementStart;
+ CONST char *p, *elementStart;
p = ExtractWinRoot(path, bufPtr, 0);
@@ -505,88 +541,98 @@ SplitWinPath(path, bufPtr)
static char *
SplitMacPath(path, bufPtr)
- char *path; /* Pointer to string containing a path. */
+ CONST char *path; /* Pointer to string containing a path. */
Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
{
int isMac = 0; /* 1 if is Mac-style, 0 if Unix-style path. */
int i, length;
- char *p, *elementStart;
+ CONST char *p, *elementStart;
+ Tcl_RegExp re;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Initialize the path name parser for Macintosh path names.
*/
- if (macRootPatternPtr == NULL) {
- macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
- if (!initialized) {
- Tcl_CreateExitHandler(FileNameCleanup, NULL);
- initialized = 1;
- }
- }
+ FileNameInit();
/*
* Match the root portion of a Mac path name.
*/
i = 0; /* Needed only to prevent gcc warnings. */
- if (TclRegExec(macRootPatternPtr, path, path) == 1) {
+
+ re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr, REG_ADVANCED);
+
+ if (Tcl_RegExpExec(NULL, re, path, path) == 1) {
+ char *start, *end;
+
/*
* Treat degenerate absolute paths like / and /../.. as
* Mac relative file names for lack of anything else to do.
*/
- if (macRootPatternPtr->startp[2] != NULL) {
+ Tcl_RegExpRange(re, 2, &start, &end);
+ if (start) {
Tcl_DStringAppend(bufPtr, ":", 1);
- Tcl_DStringAppend(bufPtr, path, macRootPatternPtr->endp[0]
- - macRootPatternPtr->startp[0] + 1);
+ Tcl_RegExpRange(re, 0, &start, &end);
+ Tcl_DStringAppend(bufPtr, path, end - start + 1);
return Tcl_DStringValue(bufPtr);
}
- if (macRootPatternPtr->startp[5] != NULL) {
-
+ Tcl_RegExpRange(re, 5, &start, &end);
+ if (start) {
/*
* Unix-style tilde prefixed paths.
*/
isMac = 0;
i = 5;
- } else if (macRootPatternPtr->startp[7] != NULL) {
-
- /*
- * Mac-style tilde prefixed paths.
- */
+ } else {
+ Tcl_RegExpRange(re, 7, &start, &end);
+ if (start) {
+ /*
+ * Mac-style tilde prefixed paths.
+ */
- isMac = 1;
- i = 7;
- } else if (macRootPatternPtr->startp[10] != NULL) {
+ isMac = 1;
+ i = 7;
+ } else {
+ Tcl_RegExpRange(re, 10, &start, &end);
+ if (start) {
- /*
- * Normal Unix style paths.
- */
+ /*
+ * Normal Unix style paths.
+ */
- isMac = 0;
- i = 10;
- } else if (macRootPatternPtr->startp[12] != NULL) {
+ isMac = 0;
+ i = 10;
+ } else {
+ Tcl_RegExpRange(re, 12, &start, &end);
+ if (start) {
- /*
- * Normal Mac style paths.
- */
+ /*
+ * Normal Mac style paths.
+ */
- isMac = 1;
- i = 12;
+ isMac = 1;
+ i = 12;
+ }
+ }
+ }
}
- length = macRootPatternPtr->endp[i]
- - macRootPatternPtr->startp[i];
+ Tcl_RegExpRange(re, i, &start, &end);
+ length = end - start;
/*
* Append the element and terminate it with a : and a null. Note that
* we are forcing the DString to contain an extra null at the end.
*/
- Tcl_DStringAppend(bufPtr, macRootPatternPtr->startp[i], length);
+ Tcl_DStringAppend(bufPtr, start, length);
Tcl_DStringAppend(bufPtr, ":", 2);
- p = macRootPatternPtr->endp[i];
+ p = end;
} else {
isMac = (strchr(path, ':') != NULL);
p = path;
@@ -690,7 +736,8 @@ Tcl_JoinPath(argc, argv, resultPtr)
{
int oldLength, length, i, needsSep;
Tcl_DString buffer;
- char *p, c, *dest;
+ char c, *dest;
+ CONST char *p;
Tcl_DStringInit(&buffer);
oldLength = Tcl_DStringLength(resultPtr);
@@ -884,25 +931,27 @@ Tcl_JoinPath(argc, argv, resultPtr)
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* Tcl_TranslateFileName --
*
* Converts a file name into a form usable by the native system
- * interfaces. If the name starts with a tilde, it will produce
- * a name where the tilde and following characters have been
- * replaced by the home directory location for the named user.
+ * interfaces. If the name starts with a tilde, it will produce a
+ * name where the tilde and following characters have been replaced
+ * by the home directory location for the named user.
*
* Results:
- * The result is a pointer to a static string containing
- * the new name. If there was an error in processing the
- * name, then an error message is left in interp->result
- * and the return value is NULL. The result will be stored
- * in bufferPtr; the caller must call Tcl_DStringFree(bufferPtr)
- * to free the name if the return value was not NULL.
+ * The return value is a pointer to a string containing the name
+ * after tilde substitution. If there was no tilde substitution,
+ * the return value is a pointer to a copy of the original string.
+ * If there was an error in processing the name, then an error
+ * message is left in the interp's result (if interp was not NULL)
+ * and the return value is NULL. Space for the return value is
+ * allocated in bufferPtr; the caller must call Tcl_DStringFree()
+ * to free the space if the return value was not NULL.
*
* Side effects:
- * Information may be left in bufferPtr.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -911,13 +960,12 @@ char *
Tcl_TranslateFileName(interp, name, bufferPtr)
Tcl_Interp *interp; /* Interpreter in which to store error
* message (if necessary). */
- char *name; /* File name, which may begin with "~"
- * (to indicate current user's home directory)
- * or "~<user>" (to indicate any user's
- * home directory). */
- Tcl_DString *bufferPtr; /* May be used to hold result. Must not hold
- * anything at the time of the call, and need
- * not even be initialized. */
+ char *name; /* File name, which may begin with "~" (to
+ * indicate current user's home directory) or
+ * "~<user>" (to indicate any user's home
+ * directory). */
+ Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
+ * with name after tilde substitution. */
{
register char *p;
@@ -933,8 +981,8 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
Tcl_SplitPath(name, &argc, &argv);
/*
- * Strip the trailing ':' off of a Mac path
- * before passing the user name to DoTildeSubst.
+ * Strip the trailing ':' off of a Mac path before passing the user
+ * name to DoTildeSubst.
*/
if (tclPlatform == TCL_PLATFORM_MAC) {
@@ -1051,9 +1099,10 @@ TclGetExtension(name)
* Results:
* The result is a pointer to a static string containing the home
* directory in native format. If there was an error in processing
- * the substitution, then an error message is left in interp->result
- * and the return value is NULL. On success, the results are appended
- * to resultPtr, and the contents of resultPtr are returned.
+ * the substitution, then an error message is left in the interp's
+ * result and the return value is NULL. On success, the results
+ * are appended to resultPtr, and the contents of resultPtr are
+ * returned.
*
* Side effects:
* Information may be left in resultPtr.
@@ -1065,16 +1114,17 @@ static char *
DoTildeSubst(interp, user, resultPtr)
Tcl_Interp *interp; /* Interpreter in which to store error
* message (if necessary). */
- char *user; /* Name of user whose home directory should be
+ CONST char *user; /* Name of user whose home directory should be
* substituted, or "" for current user. */
- Tcl_DString *resultPtr; /* May be used to hold result. Must not hold
- * anything at the time of the call, and need
- * not even be initialized. */
+ Tcl_DString *resultPtr; /* Initialized DString filled with name
+ * after tilde substitution. */
{
char *dir;
if (*user == '\0') {
- dir = TclGetEnv("HOME");
+ Tcl_DString dirString;
+
+ dir = TclGetEnv("HOME", &dirString);
if (dir == NULL) {
if (interp) {
Tcl_ResetResult(interp);
@@ -1084,13 +1134,16 @@ DoTildeSubst(interp, user, resultPtr)
return NULL;
}
Tcl_JoinPath(1, &dir, resultPtr);
- } else if (TclGetUserHome(user, resultPtr) == NULL) {
- if (interp) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
- (char *) NULL);
+ Tcl_DStringFree(&dirString);
+ } else {
+ if (TclpGetUserHome(user, resultPtr) == NULL) {
+ if (interp) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
+ (char *) NULL);
+ }
+ return NULL;
}
- return NULL;
}
return resultPtr->string;
}
@@ -1098,7 +1151,7 @@ DoTildeSubst(interp, user, resultPtr)
/*
*----------------------------------------------------------------------
*
- * Tcl_GlobCmd --
+ * Tcl_GlobObjCmd --
*
* This procedure is invoked to process the "glob" Tcl command.
* See the user documentation for details on what it does.
@@ -1114,42 +1167,104 @@ DoTildeSubst(interp, user, resultPtr)
/* ARGSUSED */
int
-Tcl_GlobCmd(dummy, interp, argc, argv)
+Tcl_GlobObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int i, noComplain, firstArg;
- char c;
- int result = TCL_OK;
- Tcl_DString buffer;
- char *separators, *head, *tail;
+ int index, i, noComplain, skip, length;
+ char *string;
+ static char *options[] = {"-nocomplain", "--", NULL};
+ enum options {GLOB_NOCOMPLAIN, GLOB_LAST};
noComplain = 0;
- for (firstArg = 1; (firstArg < argc) && (argv[firstArg][0] == '-');
- firstArg++) {
- if (strcmp(argv[firstArg], "-nocomplain") == 0) {
- noComplain = 1;
- } else if (strcmp(argv[firstArg], "--") == 0) {
- firstArg++;
+ for (skip = 1; skip < objc; skip++) {
+ string = Tcl_GetString(objv[skip]);
+ if (string[0] != '-') {
break;
- } else {
- Tcl_AppendResult(interp, "bad switch \"", argv[firstArg],
- "\": must be -nocomplain or --", (char *) NULL);
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch",
+ TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
+ if (index == GLOB_NOCOMPLAIN) {
+ noComplain = 1;
+ } else {
+ skip++;
+ break;
+ }
}
- if (firstArg >= argc) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ?switches? name ?name ...?\"", (char *) NULL);
+ if (skip >= objc) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?");
return TCL_ERROR;
}
- Tcl_DStringInit(&buffer);
- separators = NULL; /* Needed only to prevent gcc warnings. */
- for (i = firstArg; i < argc; i++) {
- switch (tclPlatform) {
+ for (i = skip; i < objc; i++) {
+ string = Tcl_GetString(objv[i]);
+ if (TclGlob(interp, string, noComplain) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (noComplain == 0) {
+ Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
+ if (length == 0) {
+ char *sep = "";
+
+ Tcl_AppendResult(interp, "no files matched glob pattern",
+ (objc == 2) ? " \"" : "s \"", (char *) NULL);
+ for (i = skip; i < objc; i++) {
+ string = Tcl_GetString(objv[i]);
+ Tcl_AppendResult(interp, sep, string, (char *) NULL);
+ sep = " ";
+ }
+ Tcl_AppendResult(interp, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGlob --
+ *
+ * This procedure prepares arguments for the TclDoGlob call.
+ * It sets the separator string based on the platform, performs
+ * tilde substitution, and calls TclDoGlob.
+ *
+ * Results:
+ * The return value is a standard Tcl result indicating whether
+ * an error occurred in globbing. After a normal return the
+ * result in interp (set by TclDoGlob) holds all of the file names
+ * given by the dir and rem arguments. After an error the
+ * result in interp will hold an error message.
+ *
+ * Side effects:
+ * The currentArgString is written to.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TclGlob(interp, pattern, noComplain)
+ Tcl_Interp *interp; /* Interpreter for returning error message
+ * or appending list of matching file names. */
+ char *pattern; /* Glob pattern to match. Must not refer
+ * to a static string. */
+ int noComplain; /* Flag to turn off storing error messages
+ * in interp. */
+{
+ char *separators;
+ char *head, *tail;
+ char c;
+ int result;
+ Tcl_DString buffer;
+
+ separators = NULL; /* lint. */
+ switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
separators = "/";
break;
@@ -1157,102 +1272,84 @@ Tcl_GlobCmd(dummy, interp, argc, argv)
separators = "/\\:";
break;
case TCL_PLATFORM_MAC:
- separators = (strchr(argv[i], ':') == NULL) ? "/" : ":";
+ separators = (strchr(pattern, ':') == NULL)
+ ? "/" : ":";
break;
- }
+ }
- Tcl_DStringSetLength(&buffer, 0);
+ Tcl_DStringInit(&buffer);
- /*
- * Perform tilde substitution, if needed.
- */
+ /*
+ * Perform tilde substitution, if needed.
+ */
- if (argv[i][0] == '~') {
- char *p;
+ if (pattern[0] == '~') {
+ char *p;
- /*
- * Find the first path separator after the tilde.
- */
+ /*
+ * Find the first path separator after the tilde.
+ */
- for (tail = argv[i]; *tail != '\0'; tail++) {
- if (*tail == '\\') {
- if (strchr(separators, tail[1]) != NULL) {
- break;
- }
- } else if (strchr(separators, *tail) != NULL) {
+ for (tail = pattern; *tail != '\0'; tail++) {
+ if (*tail == '\\') {
+ if (strchr(separators, tail[1]) != NULL) {
break;
}
+ } else if (strchr(separators, *tail) != NULL) {
+ break;
}
+ }
- /*
- * Determine the home directory for the specified user. Note that
- * we don't allow special characters in the user name.
- */
-
- c = *tail;
- *tail = '\0';
- p = strpbrk(argv[i]+1, "\\[]*?{}");
- if (p == NULL) {
- head = DoTildeSubst(interp, argv[i]+1, &buffer);
- } else {
- if (!noComplain) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "globbing characters not ",
- "supported in user names", (char *) NULL);
- }
- head = NULL;
- }
- *tail = c;
- if (head == NULL) {
- if (noComplain) {
- Tcl_ResetResult(interp);
- continue;
- } else {
- result = TCL_ERROR;
- goto done;
- }
- }
- if (head != Tcl_DStringValue(&buffer)) {
- Tcl_DStringAppend(&buffer, head, -1);
- }
+ /*
+ * Determine the home directory for the specified user. Note that
+ * we don't allow special characters in the user name.
+ */
+
+ c = *tail;
+ *tail = '\0';
+ p = strpbrk(pattern+1, "\\[]*?{}");
+ if (p == NULL) {
+ head = DoTildeSubst(interp, pattern+1, &buffer);
} else {
- tail = argv[i];
+ if (!noComplain) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "globbing characters not ",
+ "supported in user names", (char *) NULL);
+ }
+ head = NULL;
}
-
- result = TclDoGlob(interp, separators, &buffer, tail);
- if (result != TCL_OK) {
+ *tail = c;
+ if (head == NULL) {
if (noComplain) {
/*
* We should in fact pass down the nocomplain flag
- * or save the interp result or use another mecanism
+ * or save the interp result or use another mechanism
* so the interp result is not mangled on errors in that case.
* but that would a bigger change than reasonable for a patch
* release.
* (see fileName.test 15.2-15.4 for expected behaviour)
*/
Tcl_ResetResult(interp);
- result = TCL_OK;
- continue;
+ return TCL_OK;
} else {
- goto done;
+ return TCL_ERROR;
}
}
+ if (head != Tcl_DStringValue(&buffer)) {
+ Tcl_DStringAppend(&buffer, head, -1);
+ }
+ } else {
+ tail = pattern;
}
- if ((*interp->result == 0) && !noComplain) {
- char *sep = "";
-
- Tcl_AppendResult(interp, "no files matched glob pattern",
- (argc == 2) ? " \"" : "s \"", (char *) NULL);
- for (i = firstArg; i < argc; i++) {
- Tcl_AppendResult(interp, sep, argv[i], (char *) NULL);
- sep = " ";
+ result = TclDoGlob(interp, separators, &buffer, tail);
+ Tcl_DStringFree(&buffer);
+ if (result != TCL_OK) {
+ if (noComplain) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
}
- Tcl_AppendResult(interp, "\"", (char *) NULL);
- result = TCL_ERROR;
}
-done:
- Tcl_DStringFree(&buffer);
return result;
}
@@ -1339,11 +1436,12 @@ TclDoGlob(interp, separators, headPtr, tail)
* that should be used to identify globbing
* boundaries. */
Tcl_DString *headPtr; /* Completely expanded prefix. */
- char *tail; /* The unexpanded remainder of the path. */
+ char *tail; /* The unexpanded remainder of the path.
+ * Must not be a pointer to a static string. */
{
int baseLength, quoted, count;
int result = TCL_OK;
- char *p, *openBrace, *closeBrace, *name, *firstSpecialChar, savedChar;
+ char *name, *p, *openBrace, *closeBrace, *firstSpecialChar, savedChar;
char lastChar = 0;
int length = Tcl_DStringLength(headPtr);
@@ -1515,6 +1613,12 @@ TclDoGlob(interp, separators, headPtr, tail)
*/
if (*p != '\0') {
+
+ /*
+ * Note that we are modifying the string in place. This won't work
+ * if the string is a static.
+ */
+
savedChar = *p;
*p = '\0';
firstSpecialChar = strpbrk(tail, "*[]?\\");
@@ -1528,11 +1632,11 @@ TclDoGlob(interp, separators, headPtr, tail)
* Look for matching files in the current directory. The
* implementation of this function is platform specific, but may
* recursively call TclDoGlob. For each file that matches, it will
- * add the match onto the interp->result, or call TclDoGlob if there
+ * add the match onto the interp's result, or call TclDoGlob if there
* are more characters to be processed.
*/
- return TclMatchFiles(interp, separators, headPtr, tail, p);
+ return TclpMatchFiles(interp, separators, headPtr, tail, p);
}
Tcl_DStringAppend(headPtr, tail, p-tail);
if (*p != '\0') {
@@ -1546,21 +1650,23 @@ TclDoGlob(interp, separators, headPtr, tail)
*/
switch (tclPlatform) {
- case TCL_PLATFORM_MAC:
+ case TCL_PLATFORM_MAC: {
if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) {
Tcl_DStringAppend(headPtr, ":", 1);
}
name = Tcl_DStringValue(headPtr);
- if (TclAccess(name, F_OK) == 0) {
+ if (TclpAccess(name, F_OK) == 0) {
if ((name[1] != '\0') && (strchr(name+1, ':') == NULL)) {
- Tcl_AppendElement(interp, name+1);
+ Tcl_AppendElement(interp, name + 1);
} else {
Tcl_AppendElement(interp, name);
}
}
break;
+ }
case TCL_PLATFORM_WINDOWS: {
int exists;
+
/*
* We need to convert slashes to backslashes before checking
* for the existence of the file. Once we are done, we need
@@ -1582,7 +1688,8 @@ TclDoGlob(interp, separators, headPtr, tail)
}
}
name = Tcl_DStringValue(headPtr);
- exists = (TclAccess(name, F_OK) == 0);
+ exists = (TclpAccess(name, F_OK) == 0);
+
for (p = name; *p != '\0'; p++) {
if (*p == '\\') {
*p = '/';
@@ -1593,7 +1700,7 @@ TclDoGlob(interp, separators, headPtr, tail)
}
break;
}
- case TCL_PLATFORM_UNIX:
+ case TCL_PLATFORM_UNIX: {
if (Tcl_DStringLength(headPtr) == 0) {
if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
Tcl_DStringAppend(headPtr, "/", 1);
@@ -1602,10 +1709,11 @@ TclDoGlob(interp, separators, headPtr, tail)
}
}
name = Tcl_DStringValue(headPtr);
- if (TclAccess(name, F_OK) == 0) {
+ if (TclpAccess(name, F_OK) == 0) {
Tcl_AppendElement(interp, name);
}
break;
+ }
}
return TCL_OK;