merged tcl 8.1 branch back into the main trunk

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;