/*
|
/*
|
* tclFileName.c --
|
* tclFileName.c --
|
*
|
*
|
* This file contains routines for converting file names betwen
|
* This file contains routines for converting file names betwen
|
* native and network form.
|
* native and network form.
|
*
|
*
|
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
|
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
|
*
|
*
|
* See the file "license.terms" for information on usage and redistribution
|
* See the file "license.terms" for information on usage and redistribution
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
*
|
*
|
* RCS: @(#) $Id: tclFileName.c,v 1.1.1.1 2002-01-16 10:25:27 markom Exp $
|
* RCS: @(#) $Id: tclFileName.c,v 1.1.1.1 2002-01-16 10:25:27 markom Exp $
|
*/
|
*/
|
|
|
#include "tclInt.h"
|
#include "tclInt.h"
|
#include "tclPort.h"
|
#include "tclPort.h"
|
#include "tclRegexp.h"
|
#include "tclRegexp.h"
|
|
|
/*
|
/*
|
* This variable indicates whether the cleanup procedure has been
|
* This variable indicates whether the cleanup procedure has been
|
* registered for this file yet.
|
* registered for this file yet.
|
*/
|
*/
|
|
|
static int initialized = 0;
|
static int initialized = 0;
|
|
|
/*
|
/*
|
* The following regular expression matches the root portion of a Windows
|
* The following regular expression matches the root portion of a Windows
|
* absolute or volume relative path. It will match both UNC and drive relative
|
* absolute or volume relative path. It will match both UNC and drive relative
|
* paths.
|
* 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
|
* The following regular expression matches the root portion of a Macintosh
|
* absolute path. It will match degenerate Unix-style paths, tilde paths,
|
* absolute path. It will match degenerate Unix-style paths, tilde paths,
|
* Unix-style paths, and Mac paths.
|
* Unix-style paths, and Mac paths.
|
*/
|
*/
|
|
|
#define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$"
|
#define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$"
|
|
|
/*
|
/*
|
* The following variables are used to hold precompiled regular expressions
|
* The following variables are used to hold precompiled regular expressions
|
* for use in filename matching.
|
* for use in filename matching.
|
*/
|
*/
|
|
|
static regexp *winRootPatternPtr = NULL;
|
static regexp *winRootPatternPtr = NULL;
|
static regexp *macRootPatternPtr = NULL;
|
static regexp *macRootPatternPtr = NULL;
|
|
|
/*
|
/*
|
* The following variable is set in the TclPlatformInit call to one
|
* The following variable is set in the TclPlatformInit call to one
|
* of: TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, or TCL_PLATFORM_WINDOWS.
|
* of: TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, or TCL_PLATFORM_WINDOWS.
|
*/
|
*/
|
|
|
TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
|
TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
|
|
|
/*
|
/*
|
* Prototypes for local procedures defined in this file:
|
* Prototypes for local procedures defined in this file:
|
*/
|
*/
|
|
|
static char * DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
|
static char * DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
|
char *user, Tcl_DString *resultPtr));
|
char *user, Tcl_DString *resultPtr));
|
static char * ExtractWinRoot _ANSI_ARGS_((char *path,
|
static char * ExtractWinRoot _ANSI_ARGS_((char *path,
|
Tcl_DString *resultPtr, int offset));
|
Tcl_DString *resultPtr, int offset));
|
static void FileNameCleanup _ANSI_ARGS_((ClientData clientData));
|
static void FileNameCleanup _ANSI_ARGS_((ClientData clientData));
|
static int SkipToChar _ANSI_ARGS_((char **stringPtr,
|
static int SkipToChar _ANSI_ARGS_((char **stringPtr,
|
char *match));
|
char *match));
|
static char * SplitMacPath _ANSI_ARGS_((char *path,
|
static char * SplitMacPath _ANSI_ARGS_((char *path,
|
Tcl_DString *bufPtr));
|
Tcl_DString *bufPtr));
|
static char * SplitWinPath _ANSI_ARGS_((char *path,
|
static char * SplitWinPath _ANSI_ARGS_((char *path,
|
Tcl_DString *bufPtr));
|
Tcl_DString *bufPtr));
|
static char * SplitUnixPath _ANSI_ARGS_((char *path,
|
static char * SplitUnixPath _ANSI_ARGS_((char *path,
|
Tcl_DString *bufPtr));
|
Tcl_DString *bufPtr));
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* FileNameCleanup --
|
* FileNameCleanup --
|
*
|
*
|
* This procedure is a Tcl_ExitProc used to clean up the static
|
* This procedure is a Tcl_ExitProc used to clean up the static
|
* data structures used in this file.
|
* data structures used in this file.
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* Deallocates storage used by the procedures in this file.
|
* Deallocates storage used by the procedures in this file.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static void
|
static void
|
FileNameCleanup(clientData)
|
FileNameCleanup(clientData)
|
ClientData clientData; /* Not used. */
|
ClientData clientData; /* Not used. */
|
{
|
{
|
if (winRootPatternPtr != NULL) {
|
if (winRootPatternPtr != NULL) {
|
ckfree((char *)winRootPatternPtr);
|
ckfree((char *)winRootPatternPtr);
|
winRootPatternPtr = (regexp *) NULL;
|
winRootPatternPtr = (regexp *) NULL;
|
}
|
}
|
if (macRootPatternPtr != NULL) {
|
if (macRootPatternPtr != NULL) {
|
ckfree((char *)macRootPatternPtr);
|
ckfree((char *)macRootPatternPtr);
|
macRootPatternPtr = (regexp *) NULL;
|
macRootPatternPtr = (regexp *) NULL;
|
}
|
}
|
initialized = 0;
|
initialized = 0;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* ExtractWinRoot --
|
* ExtractWinRoot --
|
*
|
*
|
* Matches the root portion of a Windows path and appends it
|
* Matches the root portion of a Windows path and appends it
|
* to the specified Tcl_DString.
|
* to the specified Tcl_DString.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns the position in the path immediately after the root
|
* Returns the position in the path immediately after the root
|
* including any trailing slashes.
|
* including any trailing slashes.
|
* Appends a cleaned up version of the root to the Tcl_DString
|
* Appends a cleaned up version of the root to the Tcl_DString
|
* at the specified offest.
|
* at the specified offest.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* Modifies the specified Tcl_DString.
|
* Modifies the specified Tcl_DString.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static char *
|
static char *
|
ExtractWinRoot(path, resultPtr, offset)
|
ExtractWinRoot(path, resultPtr, offset)
|
char *path; /* Path to parse. */
|
char *path; /* Path to parse. */
|
Tcl_DString *resultPtr; /* Buffer to hold result. */
|
Tcl_DString *resultPtr; /* Buffer to hold result. */
|
int offset; /* Offset in buffer where result should be
|
int offset; /* Offset in buffer where result should be
|
* stored. */
|
* stored. */
|
{
|
{
|
int length;
|
int length;
|
|
|
/*
|
/*
|
* Initialize the path name parser for Windows path names.
|
* Initialize the path name parser for Windows path names.
|
*/
|
*/
|
|
|
if (winRootPatternPtr == NULL) {
|
if (winRootPatternPtr == NULL) {
|
winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
|
winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
|
if (!initialized) {
|
if (!initialized) {
|
Tcl_CreateExitHandler(FileNameCleanup, NULL);
|
Tcl_CreateExitHandler(FileNameCleanup, NULL);
|
initialized = 1;
|
initialized = 1;
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
* Match the root portion of a Windows path name.
|
* Match the root portion of a Windows path name.
|
*/
|
*/
|
|
|
if (!TclRegExec(winRootPatternPtr, path, path)) {
|
if (!TclRegExec(winRootPatternPtr, path, path)) {
|
return path;
|
return path;
|
}
|
}
|
|
|
Tcl_DStringSetLength(resultPtr, offset);
|
Tcl_DStringSetLength(resultPtr, offset);
|
|
|
if (winRootPatternPtr->startp[2] != NULL) {
|
if (winRootPatternPtr->startp[2] != NULL) {
|
Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[2], 2);
|
Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[2], 2);
|
if (winRootPatternPtr->startp[6] != NULL) {
|
if (winRootPatternPtr->startp[6] != NULL) {
|
Tcl_DStringAppend(resultPtr, "/", 1);
|
Tcl_DStringAppend(resultPtr, "/", 1);
|
}
|
}
|
} else if (winRootPatternPtr->startp[4] != NULL) {
|
} else if (winRootPatternPtr->startp[4] != NULL) {
|
Tcl_DStringAppend(resultPtr, "//", 2);
|
Tcl_DStringAppend(resultPtr, "//", 2);
|
length = winRootPatternPtr->endp[3]
|
length = winRootPatternPtr->endp[3]
|
- winRootPatternPtr->startp[3];
|
- winRootPatternPtr->startp[3];
|
Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[3], length);
|
Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[3], length);
|
Tcl_DStringAppend(resultPtr, "/", 1);
|
Tcl_DStringAppend(resultPtr, "/", 1);
|
length = winRootPatternPtr->endp[4]
|
length = winRootPatternPtr->endp[4]
|
- winRootPatternPtr->startp[4];
|
- winRootPatternPtr->startp[4];
|
Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[4], length);
|
Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[4], length);
|
} else {
|
} else {
|
Tcl_DStringAppend(resultPtr, "/", 1);
|
Tcl_DStringAppend(resultPtr, "/", 1);
|
}
|
}
|
return winRootPatternPtr->endp[0];
|
return winRootPatternPtr->endp[0];
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_GetPathType --
|
* Tcl_GetPathType --
|
*
|
*
|
* Determines whether a given path is relative to the current
|
* Determines whether a given path is relative to the current
|
* directory, relative to the current volume, or absolute.
|
* directory, relative to the current volume, or absolute.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
|
* Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
|
* TCL_PATH_VOLUME_RELATIVE.
|
* TCL_PATH_VOLUME_RELATIVE.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
Tcl_PathType
|
Tcl_PathType
|
Tcl_GetPathType(path)
|
Tcl_GetPathType(path)
|
char *path;
|
char *path;
|
{
|
{
|
Tcl_PathType type = TCL_PATH_ABSOLUTE;
|
Tcl_PathType type = TCL_PATH_ABSOLUTE;
|
|
|
switch (tclPlatform) {
|
switch (tclPlatform) {
|
case TCL_PLATFORM_UNIX:
|
case TCL_PLATFORM_UNIX:
|
/*
|
/*
|
* Paths that begin with / or ~ are absolute.
|
* Paths that begin with / or ~ are absolute.
|
*/
|
*/
|
|
|
if ((path[0] != '/') && (path[0] != '~')) {
|
if ((path[0] != '/') && (path[0] != '~')) {
|
type = TCL_PATH_RELATIVE;
|
type = TCL_PATH_RELATIVE;
|
}
|
}
|
break;
|
break;
|
|
|
case TCL_PLATFORM_MAC:
|
case TCL_PLATFORM_MAC:
|
if (path[0] == ':') {
|
if (path[0] == ':') {
|
type = TCL_PATH_RELATIVE;
|
type = TCL_PATH_RELATIVE;
|
} else if (path[0] != '~') {
|
} else if (path[0] != '~') {
|
|
|
/*
|
/*
|
* Since we have eliminated the easy cases, use the
|
* Since we have eliminated the easy cases, use the
|
* root pattern to look for the other types.
|
* root pattern to look for the other types.
|
*/
|
*/
|
|
|
if (!macRootPatternPtr) {
|
if (!macRootPatternPtr) {
|
macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
|
macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
|
if (!initialized) {
|
if (!initialized) {
|
Tcl_CreateExitHandler(FileNameCleanup, NULL);
|
Tcl_CreateExitHandler(FileNameCleanup, NULL);
|
initialized = 1;
|
initialized = 1;
|
}
|
}
|
}
|
}
|
if (!TclRegExec(macRootPatternPtr, path, path)
|
if (!TclRegExec(macRootPatternPtr, path, path)
|
|| (macRootPatternPtr->startp[2] != NULL)) {
|
|| (macRootPatternPtr->startp[2] != NULL)) {
|
type = TCL_PATH_RELATIVE;
|
type = TCL_PATH_RELATIVE;
|
}
|
}
|
}
|
}
|
break;
|
break;
|
|
|
case TCL_PLATFORM_WINDOWS:
|
case TCL_PLATFORM_WINDOWS:
|
if (path[0] != '~') {
|
if (path[0] != '~') {
|
|
|
/*
|
/*
|
* Since we have eliminated the easy cases, check for
|
* Since we have eliminated the easy cases, check for
|
* drive relative paths using the regular expression.
|
* drive relative paths using the regular expression.
|
*/
|
*/
|
|
|
if (!winRootPatternPtr) {
|
if (!winRootPatternPtr) {
|
winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
|
winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
|
if (!initialized) {
|
if (!initialized) {
|
Tcl_CreateExitHandler(FileNameCleanup, NULL);
|
Tcl_CreateExitHandler(FileNameCleanup, NULL);
|
initialized = 1;
|
initialized = 1;
|
}
|
}
|
}
|
}
|
if (TclRegExec(winRootPatternPtr, path, path)) {
|
if (TclRegExec(winRootPatternPtr, path, path)) {
|
if (winRootPatternPtr->startp[5]
|
if (winRootPatternPtr->startp[5]
|
|| (winRootPatternPtr->startp[2]
|
|| (winRootPatternPtr->startp[2]
|
&& !(winRootPatternPtr->startp[6]))) {
|
&& !(winRootPatternPtr->startp[6]))) {
|
type = TCL_PATH_VOLUME_RELATIVE;
|
type = TCL_PATH_VOLUME_RELATIVE;
|
}
|
}
|
} else {
|
} else {
|
type = TCL_PATH_RELATIVE;
|
type = TCL_PATH_RELATIVE;
|
}
|
}
|
}
|
}
|
break;
|
break;
|
}
|
}
|
return type;
|
return type;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_SplitPath --
|
* Tcl_SplitPath --
|
*
|
*
|
* Split a path into a list of path components. The first element
|
* Split a path into a list of path components. The first element
|
* of the list will have the same path type as the original path.
|
* of the list will have the same path type as the original path.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns a standard Tcl result. The interpreter result contains
|
* Returns a standard Tcl result. The interpreter result contains
|
* a list of path components.
|
* a list of path components.
|
* *argvPtr will be filled in with the address of an array
|
* *argvPtr will be filled in with the address of an array
|
* whose elements point to the elements of path, in order.
|
* whose elements point to the elements of path, in order.
|
* *argcPtr will get filled in with the number of valid elements
|
* *argcPtr will get filled in with the number of valid elements
|
* in the array. A single block of memory is dynamically allocated
|
* in the array. A single block of memory is dynamically allocated
|
* to hold both the argv array and a copy of the path elements.
|
* to hold both the argv array and a copy of the path elements.
|
* The caller must eventually free this memory by calling ckfree()
|
* The caller must eventually free this memory by calling ckfree()
|
* on *argvPtr. Note: *argvPtr and *argcPtr are only modified
|
* on *argvPtr. Note: *argvPtr and *argcPtr are only modified
|
* if the procedure returns normally.
|
* if the procedure returns normally.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* Allocates memory.
|
* Allocates memory.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
void
|
void
|
Tcl_SplitPath(path, argcPtr, argvPtr)
|
Tcl_SplitPath(path, argcPtr, argvPtr)
|
char *path; /* Pointer to string containing a path. */
|
char *path; /* Pointer to string containing a path. */
|
int *argcPtr; /* Pointer to location to fill in with
|
int *argcPtr; /* Pointer to location to fill in with
|
* the number of elements in the path. */
|
* the number of elements in the path. */
|
char ***argvPtr; /* Pointer to place to store pointer to array
|
char ***argvPtr; /* Pointer to place to store pointer to array
|
* of pointers to path elements. */
|
* of pointers to path elements. */
|
{
|
{
|
int i, size;
|
int i, size;
|
char *p;
|
char *p;
|
Tcl_DString buffer;
|
Tcl_DString buffer;
|
Tcl_DStringInit(&buffer);
|
Tcl_DStringInit(&buffer);
|
|
|
/*
|
/*
|
* Perform platform specific splitting. These routines will leave the
|
* Perform platform specific splitting. These routines will leave the
|
* result in the specified buffer. Individual elements are terminated
|
* result in the specified buffer. Individual elements are terminated
|
* with a null character.
|
* with a null character.
|
*/
|
*/
|
|
|
p = NULL; /* Needed only to prevent gcc warnings. */
|
p = NULL; /* Needed only to prevent gcc warnings. */
|
switch (tclPlatform) {
|
switch (tclPlatform) {
|
case TCL_PLATFORM_UNIX:
|
case TCL_PLATFORM_UNIX:
|
p = SplitUnixPath(path, &buffer);
|
p = SplitUnixPath(path, &buffer);
|
break;
|
break;
|
|
|
case TCL_PLATFORM_WINDOWS:
|
case TCL_PLATFORM_WINDOWS:
|
p = SplitWinPath(path, &buffer);
|
p = SplitWinPath(path, &buffer);
|
break;
|
break;
|
|
|
case TCL_PLATFORM_MAC:
|
case TCL_PLATFORM_MAC:
|
p = SplitMacPath(path, &buffer);
|
p = SplitMacPath(path, &buffer);
|
break;
|
break;
|
}
|
}
|
|
|
/*
|
/*
|
* Compute the number of elements in the result.
|
* Compute the number of elements in the result.
|
*/
|
*/
|
|
|
size = Tcl_DStringLength(&buffer);
|
size = Tcl_DStringLength(&buffer);
|
*argcPtr = 0;
|
*argcPtr = 0;
|
for (i = 0; i < size; i++) {
|
for (i = 0; i < size; i++) {
|
if (p[i] == '\0') {
|
if (p[i] == '\0') {
|
(*argcPtr)++;
|
(*argcPtr)++;
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
* Allocate a buffer large enough to hold the contents of the
|
* Allocate a buffer large enough to hold the contents of the
|
* DString plus the argv pointers and the terminating NULL pointer.
|
* DString plus the argv pointers and the terminating NULL pointer.
|
*/
|
*/
|
|
|
*argvPtr = (char **) ckalloc((unsigned)
|
*argvPtr = (char **) ckalloc((unsigned)
|
((((*argcPtr) + 1) * sizeof(char *)) + size));
|
((((*argcPtr) + 1) * sizeof(char *)) + size));
|
|
|
/*
|
/*
|
* Position p after the last argv pointer and copy the contents of
|
* Position p after the last argv pointer and copy the contents of
|
* the DString.
|
* the DString.
|
*/
|
*/
|
|
|
p = (char *) &(*argvPtr)[(*argcPtr) + 1];
|
p = (char *) &(*argvPtr)[(*argcPtr) + 1];
|
memcpy((VOID *) p, (VOID *) Tcl_DStringValue(&buffer), (size_t) size);
|
memcpy((VOID *) p, (VOID *) Tcl_DStringValue(&buffer), (size_t) size);
|
|
|
/*
|
/*
|
* Now set up the argv pointers.
|
* Now set up the argv pointers.
|
*/
|
*/
|
|
|
for (i = 0; i < *argcPtr; i++) {
|
for (i = 0; i < *argcPtr; i++) {
|
(*argvPtr)[i] = p;
|
(*argvPtr)[i] = p;
|
while ((*p++) != '\0') {}
|
while ((*p++) != '\0') {}
|
}
|
}
|
(*argvPtr)[i] = NULL;
|
(*argvPtr)[i] = NULL;
|
|
|
Tcl_DStringFree(&buffer);
|
Tcl_DStringFree(&buffer);
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* SplitUnixPath --
|
* SplitUnixPath --
|
*
|
*
|
* This routine is used by Tcl_SplitPath to handle splitting
|
* This routine is used by Tcl_SplitPath to handle splitting
|
* Unix paths.
|
* Unix paths.
|
*
|
*
|
* Results:
|
* Results:
|
* Stores a null separated array of strings in the specified
|
* Stores a null separated array of strings in the specified
|
* Tcl_DString.
|
* Tcl_DString.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static char *
|
static char *
|
SplitUnixPath(path, bufPtr)
|
SplitUnixPath(path, bufPtr)
|
char *path; /* Pointer to string containing a path. */
|
char *path; /* Pointer to string containing a path. */
|
Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
|
Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
|
{
|
{
|
int length;
|
int length;
|
char *p, *elementStart;
|
char *p, *elementStart;
|
|
|
/*
|
/*
|
* Deal with the root directory as a special case.
|
* Deal with the root directory as a special case.
|
*/
|
*/
|
|
|
if (path[0] == '/') {
|
if (path[0] == '/') {
|
Tcl_DStringAppend(bufPtr, "/", 2);
|
Tcl_DStringAppend(bufPtr, "/", 2);
|
p = path+1;
|
p = path+1;
|
} else {
|
} else {
|
p = path;
|
p = path;
|
}
|
}
|
|
|
/*
|
/*
|
* Split on slashes. Embedded elements that start with tilde will be
|
* Split on slashes. Embedded elements that start with tilde will be
|
* prefixed with "./" so they are not affected by tilde substitution.
|
* prefixed with "./" so they are not affected by tilde substitution.
|
*/
|
*/
|
|
|
for (;;) {
|
for (;;) {
|
elementStart = p;
|
elementStart = p;
|
while ((*p != '\0') && (*p != '/')) {
|
while ((*p != '\0') && (*p != '/')) {
|
p++;
|
p++;
|
}
|
}
|
length = p - elementStart;
|
length = p - elementStart;
|
if (length > 0) {
|
if (length > 0) {
|
if ((elementStart[0] == '~') && (elementStart != path)) {
|
if ((elementStart[0] == '~') && (elementStart != path)) {
|
Tcl_DStringAppend(bufPtr, "./", 2);
|
Tcl_DStringAppend(bufPtr, "./", 2);
|
}
|
}
|
Tcl_DStringAppend(bufPtr, elementStart, length);
|
Tcl_DStringAppend(bufPtr, elementStart, length);
|
Tcl_DStringAppend(bufPtr, "", 1);
|
Tcl_DStringAppend(bufPtr, "", 1);
|
}
|
}
|
if (*p++ == '\0') {
|
if (*p++ == '\0') {
|
break;
|
break;
|
}
|
}
|
}
|
}
|
return Tcl_DStringValue(bufPtr);
|
return Tcl_DStringValue(bufPtr);
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* SplitWinPath --
|
* SplitWinPath --
|
*
|
*
|
* This routine is used by Tcl_SplitPath to handle splitting
|
* This routine is used by Tcl_SplitPath to handle splitting
|
* Windows paths.
|
* Windows paths.
|
*
|
*
|
* Results:
|
* Results:
|
* Stores a null separated array of strings in the specified
|
* Stores a null separated array of strings in the specified
|
* Tcl_DString.
|
* Tcl_DString.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static char *
|
static char *
|
SplitWinPath(path, bufPtr)
|
SplitWinPath(path, bufPtr)
|
char *path; /* Pointer to string containing a path. */
|
char *path; /* Pointer to string containing a path. */
|
Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
|
Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
|
{
|
{
|
int length;
|
int length;
|
char *p, *elementStart;
|
char *p, *elementStart;
|
|
|
p = ExtractWinRoot(path, bufPtr, 0);
|
p = ExtractWinRoot(path, bufPtr, 0);
|
|
|
/*
|
/*
|
* Terminate the root portion, if we matched something.
|
* Terminate the root portion, if we matched something.
|
*/
|
*/
|
|
|
if (p != path) {
|
if (p != path) {
|
Tcl_DStringAppend(bufPtr, "", 1);
|
Tcl_DStringAppend(bufPtr, "", 1);
|
}
|
}
|
|
|
/*
|
/*
|
* Split on slashes. Embedded elements that start with tilde will be
|
* Split on slashes. Embedded elements that start with tilde will be
|
* prefixed with "./" so they are not affected by tilde substitution.
|
* prefixed with "./" so they are not affected by tilde substitution.
|
*/
|
*/
|
|
|
do {
|
do {
|
elementStart = p;
|
elementStart = p;
|
while ((*p != '\0') && (*p != '/') && (*p != '\\')) {
|
while ((*p != '\0') && (*p != '/') && (*p != '\\')) {
|
p++;
|
p++;
|
}
|
}
|
length = p - elementStart;
|
length = p - elementStart;
|
if (length > 0) {
|
if (length > 0) {
|
if ((elementStart[0] == '~') && (elementStart != path)) {
|
if ((elementStart[0] == '~') && (elementStart != path)) {
|
Tcl_DStringAppend(bufPtr, "./", 2);
|
Tcl_DStringAppend(bufPtr, "./", 2);
|
}
|
}
|
Tcl_DStringAppend(bufPtr, elementStart, length);
|
Tcl_DStringAppend(bufPtr, elementStart, length);
|
Tcl_DStringAppend(bufPtr, "", 1);
|
Tcl_DStringAppend(bufPtr, "", 1);
|
}
|
}
|
} while (*p++ != '\0');
|
} while (*p++ != '\0');
|
|
|
return Tcl_DStringValue(bufPtr);
|
return Tcl_DStringValue(bufPtr);
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* SplitMacPath --
|
* SplitMacPath --
|
*
|
*
|
* This routine is used by Tcl_SplitPath to handle splitting
|
* This routine is used by Tcl_SplitPath to handle splitting
|
* Macintosh paths.
|
* Macintosh paths.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns a newly allocated argv array.
|
* Returns a newly allocated argv array.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static char *
|
static char *
|
SplitMacPath(path, bufPtr)
|
SplitMacPath(path, bufPtr)
|
char *path; /* Pointer to string containing a path. */
|
char *path; /* Pointer to string containing a path. */
|
Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
|
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 isMac = 0; /* 1 if is Mac-style, 0 if Unix-style path. */
|
int i, length;
|
int i, length;
|
char *p, *elementStart;
|
char *p, *elementStart;
|
|
|
/*
|
/*
|
* Initialize the path name parser for Macintosh path names.
|
* Initialize the path name parser for Macintosh path names.
|
*/
|
*/
|
|
|
if (macRootPatternPtr == NULL) {
|
if (macRootPatternPtr == NULL) {
|
macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
|
macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
|
if (!initialized) {
|
if (!initialized) {
|
Tcl_CreateExitHandler(FileNameCleanup, NULL);
|
Tcl_CreateExitHandler(FileNameCleanup, NULL);
|
initialized = 1;
|
initialized = 1;
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
* Match the root portion of a Mac path name.
|
* Match the root portion of a Mac path name.
|
*/
|
*/
|
|
|
i = 0; /* Needed only to prevent gcc warnings. */
|
i = 0; /* Needed only to prevent gcc warnings. */
|
if (TclRegExec(macRootPatternPtr, path, path) == 1) {
|
if (TclRegExec(macRootPatternPtr, path, path) == 1) {
|
/*
|
/*
|
* Treat degenerate absolute paths like / and /../.. as
|
* Treat degenerate absolute paths like / and /../.. as
|
* Mac relative file names for lack of anything else to do.
|
* Mac relative file names for lack of anything else to do.
|
*/
|
*/
|
|
|
if (macRootPatternPtr->startp[2] != NULL) {
|
if (macRootPatternPtr->startp[2] != NULL) {
|
Tcl_DStringAppend(bufPtr, ":", 1);
|
Tcl_DStringAppend(bufPtr, ":", 1);
|
Tcl_DStringAppend(bufPtr, path, macRootPatternPtr->endp[0]
|
Tcl_DStringAppend(bufPtr, path, macRootPatternPtr->endp[0]
|
- macRootPatternPtr->startp[0] + 1);
|
- macRootPatternPtr->startp[0] + 1);
|
return Tcl_DStringValue(bufPtr);
|
return Tcl_DStringValue(bufPtr);
|
}
|
}
|
|
|
if (macRootPatternPtr->startp[5] != NULL) {
|
if (macRootPatternPtr->startp[5] != NULL) {
|
|
|
/*
|
/*
|
* Unix-style tilde prefixed paths.
|
* Unix-style tilde prefixed paths.
|
*/
|
*/
|
|
|
isMac = 0;
|
isMac = 0;
|
i = 5;
|
i = 5;
|
} else if (macRootPatternPtr->startp[7] != NULL) {
|
} else if (macRootPatternPtr->startp[7] != NULL) {
|
|
|
/*
|
/*
|
* Mac-style tilde prefixed paths.
|
* Mac-style tilde prefixed paths.
|
*/
|
*/
|
|
|
isMac = 1;
|
isMac = 1;
|
i = 7;
|
i = 7;
|
} else if (macRootPatternPtr->startp[10] != NULL) {
|
} else if (macRootPatternPtr->startp[10] != NULL) {
|
|
|
/*
|
/*
|
* Normal Unix style paths.
|
* Normal Unix style paths.
|
*/
|
*/
|
|
|
isMac = 0;
|
isMac = 0;
|
i = 10;
|
i = 10;
|
} else if (macRootPatternPtr->startp[12] != NULL) {
|
} else if (macRootPatternPtr->startp[12] != NULL) {
|
|
|
/*
|
/*
|
* Normal Mac style paths.
|
* Normal Mac style paths.
|
*/
|
*/
|
|
|
isMac = 1;
|
isMac = 1;
|
i = 12;
|
i = 12;
|
}
|
}
|
|
|
length = macRootPatternPtr->endp[i]
|
length = macRootPatternPtr->endp[i]
|
- macRootPatternPtr->startp[i];
|
- macRootPatternPtr->startp[i];
|
|
|
/*
|
/*
|
* Append the element and terminate it with a : and a null. Note that
|
* 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.
|
* we are forcing the DString to contain an extra null at the end.
|
*/
|
*/
|
|
|
Tcl_DStringAppend(bufPtr, macRootPatternPtr->startp[i], length);
|
Tcl_DStringAppend(bufPtr, macRootPatternPtr->startp[i], length);
|
Tcl_DStringAppend(bufPtr, ":", 2);
|
Tcl_DStringAppend(bufPtr, ":", 2);
|
p = macRootPatternPtr->endp[i];
|
p = macRootPatternPtr->endp[i];
|
} else {
|
} else {
|
isMac = (strchr(path, ':') != NULL);
|
isMac = (strchr(path, ':') != NULL);
|
p = path;
|
p = path;
|
}
|
}
|
|
|
if (isMac) {
|
if (isMac) {
|
|
|
/*
|
/*
|
* p is pointing at the first colon in the path. There
|
* p is pointing at the first colon in the path. There
|
* will always be one, since this is a Mac-style path.
|
* will always be one, since this is a Mac-style path.
|
*/
|
*/
|
|
|
elementStart = p++;
|
elementStart = p++;
|
while ((p = strchr(p, ':')) != NULL) {
|
while ((p = strchr(p, ':')) != NULL) {
|
length = p - elementStart;
|
length = p - elementStart;
|
if (length == 1) {
|
if (length == 1) {
|
while (*p == ':') {
|
while (*p == ':') {
|
Tcl_DStringAppend(bufPtr, "::", 3);
|
Tcl_DStringAppend(bufPtr, "::", 3);
|
elementStart = p++;
|
elementStart = p++;
|
}
|
}
|
} else {
|
} else {
|
/*
|
/*
|
* If this is a simple component, drop the leading colon.
|
* If this is a simple component, drop the leading colon.
|
*/
|
*/
|
|
|
if ((elementStart[1] != '~')
|
if ((elementStart[1] != '~')
|
&& (strchr(elementStart+1, '/') == NULL)) {
|
&& (strchr(elementStart+1, '/') == NULL)) {
|
elementStart++;
|
elementStart++;
|
length--;
|
length--;
|
}
|
}
|
Tcl_DStringAppend(bufPtr, elementStart, length);
|
Tcl_DStringAppend(bufPtr, elementStart, length);
|
Tcl_DStringAppend(bufPtr, "", 1);
|
Tcl_DStringAppend(bufPtr, "", 1);
|
elementStart = p++;
|
elementStart = p++;
|
}
|
}
|
}
|
}
|
if (elementStart[1] != '\0' || elementStart == path) {
|
if (elementStart[1] != '\0' || elementStart == path) {
|
if ((elementStart[1] != '~') && (elementStart[1] != '\0')
|
if ((elementStart[1] != '~') && (elementStart[1] != '\0')
|
&& (strchr(elementStart+1, '/') == NULL)) {
|
&& (strchr(elementStart+1, '/') == NULL)) {
|
elementStart++;
|
elementStart++;
|
}
|
}
|
Tcl_DStringAppend(bufPtr, elementStart, -1);
|
Tcl_DStringAppend(bufPtr, elementStart, -1);
|
Tcl_DStringAppend(bufPtr, "", 1);
|
Tcl_DStringAppend(bufPtr, "", 1);
|
}
|
}
|
} else {
|
} else {
|
|
|
/*
|
/*
|
* Split on slashes, suppress extra /'s, and convert .. to ::.
|
* Split on slashes, suppress extra /'s, and convert .. to ::.
|
*/
|
*/
|
|
|
for (;;) {
|
for (;;) {
|
elementStart = p;
|
elementStart = p;
|
while ((*p != '\0') && (*p != '/')) {
|
while ((*p != '\0') && (*p != '/')) {
|
p++;
|
p++;
|
}
|
}
|
length = p - elementStart;
|
length = p - elementStart;
|
if (length > 0) {
|
if (length > 0) {
|
if ((length == 1) && (elementStart[0] == '.')) {
|
if ((length == 1) && (elementStart[0] == '.')) {
|
Tcl_DStringAppend(bufPtr, ":", 2);
|
Tcl_DStringAppend(bufPtr, ":", 2);
|
} else if ((length == 2) && (elementStart[0] == '.')
|
} else if ((length == 2) && (elementStart[0] == '.')
|
&& (elementStart[1] == '.')) {
|
&& (elementStart[1] == '.')) {
|
Tcl_DStringAppend(bufPtr, "::", 3);
|
Tcl_DStringAppend(bufPtr, "::", 3);
|
} else {
|
} else {
|
if (*elementStart == '~') {
|
if (*elementStart == '~') {
|
Tcl_DStringAppend(bufPtr, ":", 1);
|
Tcl_DStringAppend(bufPtr, ":", 1);
|
}
|
}
|
Tcl_DStringAppend(bufPtr, elementStart, length);
|
Tcl_DStringAppend(bufPtr, elementStart, length);
|
Tcl_DStringAppend(bufPtr, "", 1);
|
Tcl_DStringAppend(bufPtr, "", 1);
|
}
|
}
|
}
|
}
|
if (*p++ == '\0') {
|
if (*p++ == '\0') {
|
break;
|
break;
|
}
|
}
|
}
|
}
|
}
|
}
|
return Tcl_DStringValue(bufPtr);
|
return Tcl_DStringValue(bufPtr);
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_JoinPath --
|
* Tcl_JoinPath --
|
*
|
*
|
* Combine a list of paths in a platform specific manner.
|
* Combine a list of paths in a platform specific manner.
|
*
|
*
|
* Results:
|
* Results:
|
* Appends the joined path to the end of the specified
|
* Appends the joined path to the end of the specified
|
* returning a pointer to the resulting string. Note that
|
* returning a pointer to the resulting string. Note that
|
* the Tcl_DString must already be initialized.
|
* the Tcl_DString must already be initialized.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* Modifies the Tcl_DString.
|
* Modifies the Tcl_DString.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
char *
|
char *
|
Tcl_JoinPath(argc, argv, resultPtr)
|
Tcl_JoinPath(argc, argv, resultPtr)
|
int argc;
|
int argc;
|
char **argv;
|
char **argv;
|
Tcl_DString *resultPtr; /* Pointer to previously initialized DString. */
|
Tcl_DString *resultPtr; /* Pointer to previously initialized DString. */
|
{
|
{
|
int oldLength, length, i, needsSep;
|
int oldLength, length, i, needsSep;
|
Tcl_DString buffer;
|
Tcl_DString buffer;
|
char *p, c, *dest;
|
char *p, c, *dest;
|
|
|
Tcl_DStringInit(&buffer);
|
Tcl_DStringInit(&buffer);
|
oldLength = Tcl_DStringLength(resultPtr);
|
oldLength = Tcl_DStringLength(resultPtr);
|
|
|
switch (tclPlatform) {
|
switch (tclPlatform) {
|
case TCL_PLATFORM_UNIX:
|
case TCL_PLATFORM_UNIX:
|
for (i = 0; i < argc; i++) {
|
for (i = 0; i < argc; i++) {
|
p = argv[i];
|
p = argv[i];
|
/*
|
/*
|
* If the path is absolute, reset the result buffer.
|
* If the path is absolute, reset the result buffer.
|
* Consume any duplicate leading slashes or a ./ in
|
* Consume any duplicate leading slashes or a ./ in
|
* front of a tilde prefixed path that isn't at the
|
* front of a tilde prefixed path that isn't at the
|
* beginning of the path.
|
* beginning of the path.
|
*/
|
*/
|
|
|
if (*p == '/') {
|
if (*p == '/') {
|
Tcl_DStringSetLength(resultPtr, oldLength);
|
Tcl_DStringSetLength(resultPtr, oldLength);
|
Tcl_DStringAppend(resultPtr, "/", 1);
|
Tcl_DStringAppend(resultPtr, "/", 1);
|
while (*p == '/') {
|
while (*p == '/') {
|
p++;
|
p++;
|
}
|
}
|
} else if (*p == '~') {
|
} else if (*p == '~') {
|
Tcl_DStringSetLength(resultPtr, oldLength);
|
Tcl_DStringSetLength(resultPtr, oldLength);
|
} else if ((Tcl_DStringLength(resultPtr) != oldLength)
|
} else if ((Tcl_DStringLength(resultPtr) != oldLength)
|
&& (p[0] == '.') && (p[1] == '/')
|
&& (p[0] == '.') && (p[1] == '/')
|
&& (p[2] == '~')) {
|
&& (p[2] == '~')) {
|
p += 2;
|
p += 2;
|
}
|
}
|
|
|
if (*p == '\0') {
|
if (*p == '\0') {
|
continue;
|
continue;
|
}
|
}
|
|
|
/*
|
/*
|
* Append a separator if needed.
|
* Append a separator if needed.
|
*/
|
*/
|
|
|
length = Tcl_DStringLength(resultPtr);
|
length = Tcl_DStringLength(resultPtr);
|
if ((length != oldLength)
|
if ((length != oldLength)
|
&& (Tcl_DStringValue(resultPtr)[length-1] != '/')) {
|
&& (Tcl_DStringValue(resultPtr)[length-1] != '/')) {
|
Tcl_DStringAppend(resultPtr, "/", 1);
|
Tcl_DStringAppend(resultPtr, "/", 1);
|
length++;
|
length++;
|
}
|
}
|
|
|
/*
|
/*
|
* Append the element, eliminating duplicate and trailing
|
* Append the element, eliminating duplicate and trailing
|
* slashes.
|
* slashes.
|
*/
|
*/
|
|
|
Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p)));
|
Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p)));
|
dest = Tcl_DStringValue(resultPtr) + length;
|
dest = Tcl_DStringValue(resultPtr) + length;
|
for (; *p != '\0'; p++) {
|
for (; *p != '\0'; p++) {
|
if (*p == '/') {
|
if (*p == '/') {
|
while (p[1] == '/') {
|
while (p[1] == '/') {
|
p++;
|
p++;
|
}
|
}
|
if (p[1] != '\0') {
|
if (p[1] != '\0') {
|
*dest++ = '/';
|
*dest++ = '/';
|
}
|
}
|
} else {
|
} else {
|
*dest++ = *p;
|
*dest++ = *p;
|
}
|
}
|
}
|
}
|
length = dest - Tcl_DStringValue(resultPtr);
|
length = dest - Tcl_DStringValue(resultPtr);
|
Tcl_DStringSetLength(resultPtr, length);
|
Tcl_DStringSetLength(resultPtr, length);
|
}
|
}
|
break;
|
break;
|
|
|
case TCL_PLATFORM_WINDOWS:
|
case TCL_PLATFORM_WINDOWS:
|
/*
|
/*
|
* Iterate over all of the components. If a component is
|
* Iterate over all of the components. If a component is
|
* absolute, then reset the result and start building the
|
* absolute, then reset the result and start building the
|
* path from the current component on.
|
* path from the current component on.
|
*/
|
*/
|
|
|
for (i = 0; i < argc; i++) {
|
for (i = 0; i < argc; i++) {
|
p = ExtractWinRoot(argv[i], resultPtr, oldLength);
|
p = ExtractWinRoot(argv[i], resultPtr, oldLength);
|
length = Tcl_DStringLength(resultPtr);
|
length = Tcl_DStringLength(resultPtr);
|
|
|
/*
|
/*
|
* If the pointer didn't move, then this is a relative path
|
* If the pointer didn't move, then this is a relative path
|
* or a tilde prefixed path.
|
* or a tilde prefixed path.
|
*/
|
*/
|
|
|
if (p == argv[i]) {
|
if (p == argv[i]) {
|
/*
|
/*
|
* Remove the ./ from tilde prefixed elements unless
|
* Remove the ./ from tilde prefixed elements unless
|
* it is the first component.
|
* it is the first component.
|
*/
|
*/
|
|
|
if ((length != oldLength)
|
if ((length != oldLength)
|
&& (p[0] == '.')
|
&& (p[0] == '.')
|
&& ((p[1] == '/') || (p[1] == '\\'))
|
&& ((p[1] == '/') || (p[1] == '\\'))
|
&& (p[2] == '~')) {
|
&& (p[2] == '~')) {
|
p += 2;
|
p += 2;
|
} else if (*p == '~') {
|
} else if (*p == '~') {
|
Tcl_DStringSetLength(resultPtr, oldLength);
|
Tcl_DStringSetLength(resultPtr, oldLength);
|
length = oldLength;
|
length = oldLength;
|
}
|
}
|
}
|
}
|
|
|
if (*p != '\0') {
|
if (*p != '\0') {
|
/*
|
/*
|
* Check to see if we need to append a separator.
|
* Check to see if we need to append a separator.
|
*/
|
*/
|
|
|
|
|
if (length != oldLength) {
|
if (length != oldLength) {
|
c = Tcl_DStringValue(resultPtr)[length-1];
|
c = Tcl_DStringValue(resultPtr)[length-1];
|
if ((c != '/') && (c != ':')) {
|
if ((c != '/') && (c != ':')) {
|
Tcl_DStringAppend(resultPtr, "/", 1);
|
Tcl_DStringAppend(resultPtr, "/", 1);
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
* Append the element, eliminating duplicate and
|
* Append the element, eliminating duplicate and
|
* trailing slashes.
|
* trailing slashes.
|
*/
|
*/
|
|
|
length = Tcl_DStringLength(resultPtr);
|
length = Tcl_DStringLength(resultPtr);
|
Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p)));
|
Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p)));
|
dest = Tcl_DStringValue(resultPtr) + length;
|
dest = Tcl_DStringValue(resultPtr) + length;
|
for (; *p != '\0'; p++) {
|
for (; *p != '\0'; p++) {
|
if ((*p == '/') || (*p == '\\')) {
|
if ((*p == '/') || (*p == '\\')) {
|
while ((p[1] == '/') || (p[1] == '\\')) {
|
while ((p[1] == '/') || (p[1] == '\\')) {
|
p++;
|
p++;
|
}
|
}
|
if (p[1] != '\0') {
|
if (p[1] != '\0') {
|
*dest++ = '/';
|
*dest++ = '/';
|
}
|
}
|
} else {
|
} else {
|
*dest++ = *p;
|
*dest++ = *p;
|
}
|
}
|
}
|
}
|
length = dest - Tcl_DStringValue(resultPtr);
|
length = dest - Tcl_DStringValue(resultPtr);
|
Tcl_DStringSetLength(resultPtr, length);
|
Tcl_DStringSetLength(resultPtr, length);
|
}
|
}
|
}
|
}
|
break;
|
break;
|
|
|
case TCL_PLATFORM_MAC:
|
case TCL_PLATFORM_MAC:
|
needsSep = 1;
|
needsSep = 1;
|
for (i = 0; i < argc; i++) {
|
for (i = 0; i < argc; i++) {
|
Tcl_DStringSetLength(&buffer, 0);
|
Tcl_DStringSetLength(&buffer, 0);
|
p = SplitMacPath(argv[i], &buffer);
|
p = SplitMacPath(argv[i], &buffer);
|
if ((*p != ':') && (*p != '\0')
|
if ((*p != ':') && (*p != '\0')
|
&& (strchr(p, ':') != NULL)) {
|
&& (strchr(p, ':') != NULL)) {
|
Tcl_DStringSetLength(resultPtr, oldLength);
|
Tcl_DStringSetLength(resultPtr, oldLength);
|
length = strlen(p);
|
length = strlen(p);
|
Tcl_DStringAppend(resultPtr, p, length);
|
Tcl_DStringAppend(resultPtr, p, length);
|
needsSep = 0;
|
needsSep = 0;
|
p += length+1;
|
p += length+1;
|
}
|
}
|
|
|
/*
|
/*
|
* Now append the rest of the path elements, skipping
|
* Now append the rest of the path elements, skipping
|
* : unless it is the first element of the path, and
|
* : unless it is the first element of the path, and
|
* watching out for :: et al. so we don't end up with
|
* watching out for :: et al. so we don't end up with
|
* too many colons in the result.
|
* too many colons in the result.
|
*/
|
*/
|
|
|
for (; *p != '\0'; p += length+1) {
|
for (; *p != '\0'; p += length+1) {
|
if (p[0] == ':' && p[1] == '\0') {
|
if (p[0] == ':' && p[1] == '\0') {
|
if (Tcl_DStringLength(resultPtr) != oldLength) {
|
if (Tcl_DStringLength(resultPtr) != oldLength) {
|
p++;
|
p++;
|
} else {
|
} else {
|
needsSep = 0;
|
needsSep = 0;
|
}
|
}
|
} else {
|
} else {
|
c = p[1];
|
c = p[1];
|
if (*p == ':') {
|
if (*p == ':') {
|
if (!needsSep) {
|
if (!needsSep) {
|
p++;
|
p++;
|
}
|
}
|
} else {
|
} else {
|
if (needsSep) {
|
if (needsSep) {
|
Tcl_DStringAppend(resultPtr, ":", 1);
|
Tcl_DStringAppend(resultPtr, ":", 1);
|
}
|
}
|
}
|
}
|
needsSep = (c == ':') ? 0 : 1;
|
needsSep = (c == ':') ? 0 : 1;
|
}
|
}
|
length = strlen(p);
|
length = strlen(p);
|
Tcl_DStringAppend(resultPtr, p, length);
|
Tcl_DStringAppend(resultPtr, p, length);
|
}
|
}
|
}
|
}
|
break;
|
break;
|
|
|
}
|
}
|
Tcl_DStringFree(&buffer);
|
Tcl_DStringFree(&buffer);
|
return Tcl_DStringValue(resultPtr);
|
return Tcl_DStringValue(resultPtr);
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_TranslateFileName --
|
* Tcl_TranslateFileName --
|
*
|
*
|
* Converts a file name into a form usable by the native system
|
* Converts a file name into a form usable by the native system
|
* interfaces. If the name starts with a tilde, it will produce
|
* interfaces. If the name starts with a tilde, it will produce
|
* a name where the tilde and following characters have been
|
* a name where the tilde and following characters have been
|
* replaced by the home directory location for the named user.
|
* replaced by the home directory location for the named user.
|
*
|
*
|
* Results:
|
* Results:
|
* The result is a pointer to a static string containing
|
* The result is a pointer to a static string containing
|
* the new name. If there was an error in processing the
|
* the new name. If there was an error in processing the
|
* name, then an error message is left in interp->result
|
* name, then an error message is left in interp->result
|
* and the return value is NULL. The result will be stored
|
* and the return value is NULL. The result will be stored
|
* in bufferPtr; the caller must call Tcl_DStringFree(bufferPtr)
|
* in bufferPtr; the caller must call Tcl_DStringFree(bufferPtr)
|
* to free the name if the return value was not NULL.
|
* to free the name if the return value was not NULL.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* Information may be left in bufferPtr.
|
* Information may be left in bufferPtr.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
char *
|
char *
|
Tcl_TranslateFileName(interp, name, bufferPtr)
|
Tcl_TranslateFileName(interp, name, bufferPtr)
|
Tcl_Interp *interp; /* Interpreter in which to store error
|
Tcl_Interp *interp; /* Interpreter in which to store error
|
* message (if necessary). */
|
* message (if necessary). */
|
char *name; /* File name, which may begin with "~"
|
char *name; /* File name, which may begin with "~"
|
* (to indicate current user's home directory)
|
* (to indicate current user's home directory)
|
* or "~<user>" (to indicate any user's
|
* or "~<user>" (to indicate any user's
|
* home directory). */
|
* home directory). */
|
Tcl_DString *bufferPtr; /* May be used to hold result. Must not hold
|
Tcl_DString *bufferPtr; /* May be used to hold result. Must not hold
|
* anything at the time of the call, and need
|
* anything at the time of the call, and need
|
* not even be initialized. */
|
* not even be initialized. */
|
{
|
{
|
register char *p;
|
register char *p;
|
|
|
/*
|
/*
|
* Handle tilde substitutions, if needed.
|
* Handle tilde substitutions, if needed.
|
*/
|
*/
|
|
|
if (name[0] == '~') {
|
if (name[0] == '~') {
|
int argc, length;
|
int argc, length;
|
char **argv;
|
char **argv;
|
Tcl_DString temp;
|
Tcl_DString temp;
|
|
|
Tcl_SplitPath(name, &argc, &argv);
|
Tcl_SplitPath(name, &argc, &argv);
|
|
|
/*
|
/*
|
* Strip the trailing ':' off of a Mac path
|
* Strip the trailing ':' off of a Mac path
|
* before passing the user name to DoTildeSubst.
|
* before passing the user name to DoTildeSubst.
|
*/
|
*/
|
|
|
if (tclPlatform == TCL_PLATFORM_MAC) {
|
if (tclPlatform == TCL_PLATFORM_MAC) {
|
length = strlen(argv[0]);
|
length = strlen(argv[0]);
|
argv[0][length-1] = '\0';
|
argv[0][length-1] = '\0';
|
}
|
}
|
|
|
Tcl_DStringInit(&temp);
|
Tcl_DStringInit(&temp);
|
argv[0] = DoTildeSubst(interp, argv[0]+1, &temp);
|
argv[0] = DoTildeSubst(interp, argv[0]+1, &temp);
|
if (argv[0] == NULL) {
|
if (argv[0] == NULL) {
|
Tcl_DStringFree(&temp);
|
Tcl_DStringFree(&temp);
|
ckfree((char *)argv);
|
ckfree((char *)argv);
|
return NULL;
|
return NULL;
|
}
|
}
|
Tcl_DStringInit(bufferPtr);
|
Tcl_DStringInit(bufferPtr);
|
Tcl_JoinPath(argc, argv, bufferPtr);
|
Tcl_JoinPath(argc, argv, bufferPtr);
|
Tcl_DStringFree(&temp);
|
Tcl_DStringFree(&temp);
|
ckfree((char*)argv);
|
ckfree((char*)argv);
|
} else {
|
} else {
|
Tcl_DStringInit(bufferPtr);
|
Tcl_DStringInit(bufferPtr);
|
Tcl_JoinPath(1, &name, bufferPtr);
|
Tcl_JoinPath(1, &name, bufferPtr);
|
}
|
}
|
|
|
/*
|
/*
|
* Convert forward slashes to backslashes in Windows paths because
|
* Convert forward slashes to backslashes in Windows paths because
|
* some system interfaces don't accept forward slashes.
|
* some system interfaces don't accept forward slashes.
|
*/
|
*/
|
|
|
#ifndef __CYGWIN__
|
#ifndef __CYGWIN__
|
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
|
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
|
for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
|
for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
|
if (*p == '/') {
|
if (*p == '/') {
|
*p = '\\';
|
*p = '\\';
|
}
|
}
|
}
|
}
|
}
|
}
|
#endif
|
#endif
|
return Tcl_DStringValue(bufferPtr);
|
return Tcl_DStringValue(bufferPtr);
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* TclGetExtension --
|
* TclGetExtension --
|
*
|
*
|
* This function returns a pointer to the beginning of the
|
* This function returns a pointer to the beginning of the
|
* extension part of a file name.
|
* extension part of a file name.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns a pointer into name which indicates where the extension
|
* Returns a pointer into name which indicates where the extension
|
* starts. If there is no extension, returns NULL.
|
* starts. If there is no extension, returns NULL.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
char *
|
char *
|
TclGetExtension(name)
|
TclGetExtension(name)
|
char *name; /* File name to parse. */
|
char *name; /* File name to parse. */
|
{
|
{
|
char *p, *lastSep;
|
char *p, *lastSep;
|
|
|
/*
|
/*
|
* First find the last directory separator.
|
* First find the last directory separator.
|
*/
|
*/
|
|
|
lastSep = NULL; /* Needed only to prevent gcc warnings. */
|
lastSep = NULL; /* Needed only to prevent gcc warnings. */
|
switch (tclPlatform) {
|
switch (tclPlatform) {
|
case TCL_PLATFORM_UNIX:
|
case TCL_PLATFORM_UNIX:
|
lastSep = strrchr(name, '/');
|
lastSep = strrchr(name, '/');
|
break;
|
break;
|
|
|
case TCL_PLATFORM_MAC:
|
case TCL_PLATFORM_MAC:
|
if (strchr(name, ':') == NULL) {
|
if (strchr(name, ':') == NULL) {
|
lastSep = strrchr(name, '/');
|
lastSep = strrchr(name, '/');
|
} else {
|
} else {
|
lastSep = strrchr(name, ':');
|
lastSep = strrchr(name, ':');
|
}
|
}
|
break;
|
break;
|
|
|
case TCL_PLATFORM_WINDOWS:
|
case TCL_PLATFORM_WINDOWS:
|
lastSep = NULL;
|
lastSep = NULL;
|
for (p = name; *p != '\0'; p++) {
|
for (p = name; *p != '\0'; p++) {
|
if (strchr("/\\:", *p) != NULL) {
|
if (strchr("/\\:", *p) != NULL) {
|
lastSep = p;
|
lastSep = p;
|
}
|
}
|
}
|
}
|
break;
|
break;
|
}
|
}
|
p = strrchr(name, '.');
|
p = strrchr(name, '.');
|
if ((p != NULL) && (lastSep != NULL)
|
if ((p != NULL) && (lastSep != NULL)
|
&& (lastSep > p)) {
|
&& (lastSep > p)) {
|
p = NULL;
|
p = NULL;
|
}
|
}
|
|
|
/*
|
/*
|
* Back up to the first period in a series of contiguous dots.
|
* Back up to the first period in a series of contiguous dots.
|
* This is needed so foo..o will be split on the first dot.
|
* This is needed so foo..o will be split on the first dot.
|
*/
|
*/
|
|
|
if (p != NULL) {
|
if (p != NULL) {
|
while ((p > name) && *(p-1) == '.') {
|
while ((p > name) && *(p-1) == '.') {
|
p--;
|
p--;
|
}
|
}
|
}
|
}
|
return p;
|
return p;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* DoTildeSubst --
|
* DoTildeSubst --
|
*
|
*
|
* Given a string following a tilde, this routine returns the
|
* Given a string following a tilde, this routine returns the
|
* corresponding home directory.
|
* corresponding home directory.
|
*
|
*
|
* Results:
|
* Results:
|
* The result is a pointer to a static string containing the home
|
* The result is a pointer to a static string containing the home
|
* directory in native format. If there was an error in processing
|
* directory in native format. If there was an error in processing
|
* the substitution, then an error message is left in interp->result
|
* the substitution, then an error message is left in interp->result
|
* and the return value is NULL. On success, the results are appended
|
* and the return value is NULL. On success, the results are appended
|
* to resultPtr, and the contents of resultPtr are returned.
|
* to resultPtr, and the contents of resultPtr are returned.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* Information may be left in resultPtr.
|
* Information may be left in resultPtr.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static char *
|
static char *
|
DoTildeSubst(interp, user, resultPtr)
|
DoTildeSubst(interp, user, resultPtr)
|
Tcl_Interp *interp; /* Interpreter in which to store error
|
Tcl_Interp *interp; /* Interpreter in which to store error
|
* message (if necessary). */
|
* message (if necessary). */
|
char *user; /* Name of user whose home directory should be
|
char *user; /* Name of user whose home directory should be
|
* substituted, or "" for current user. */
|
* substituted, or "" for current user. */
|
Tcl_DString *resultPtr; /* May be used to hold result. Must not hold
|
Tcl_DString *resultPtr; /* May be used to hold result. Must not hold
|
* anything at the time of the call, and need
|
* anything at the time of the call, and need
|
* not even be initialized. */
|
* not even be initialized. */
|
{
|
{
|
char *dir;
|
char *dir;
|
|
|
if (*user == '\0') {
|
if (*user == '\0') {
|
dir = TclGetEnv("HOME");
|
dir = TclGetEnv("HOME");
|
if (dir == NULL) {
|
if (dir == NULL) {
|
if (interp) {
|
if (interp) {
|
Tcl_ResetResult(interp);
|
Tcl_ResetResult(interp);
|
Tcl_AppendResult(interp, "couldn't find HOME environment ",
|
Tcl_AppendResult(interp, "couldn't find HOME environment ",
|
"variable to expand path", (char *) NULL);
|
"variable to expand path", (char *) NULL);
|
}
|
}
|
return NULL;
|
return NULL;
|
}
|
}
|
Tcl_JoinPath(1, &dir, resultPtr);
|
Tcl_JoinPath(1, &dir, resultPtr);
|
} else {
|
} else {
|
|
|
/* lint, TclGetuserHome() always NULL under windows. */
|
/* lint, TclGetuserHome() always NULL under windows. */
|
if (TclGetUserHome(user, resultPtr) == NULL) {
|
if (TclGetUserHome(user, resultPtr) == NULL) {
|
if (interp) {
|
if (interp) {
|
Tcl_ResetResult(interp);
|
Tcl_ResetResult(interp);
|
Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
|
Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
|
(char *) NULL);
|
(char *) NULL);
|
}
|
}
|
return NULL;
|
return NULL;
|
}
|
}
|
}
|
}
|
return resultPtr->string;
|
return resultPtr->string;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_GlobCmd --
|
* Tcl_GlobCmd --
|
*
|
*
|
* This procedure is invoked to process the "glob" Tcl command.
|
* This procedure is invoked to process the "glob" Tcl command.
|
* See the user documentation for details on what it does.
|
* See the user documentation for details on what it does.
|
*
|
*
|
* Results:
|
* Results:
|
* A standard Tcl result.
|
* A standard Tcl result.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* See the user documentation.
|
* See the user documentation.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
/* ARGSUSED */
|
/* ARGSUSED */
|
int
|
int
|
Tcl_GlobCmd(dummy, interp, argc, argv)
|
Tcl_GlobCmd(dummy, interp, argc, argv)
|
ClientData dummy; /* Not used. */
|
ClientData dummy; /* Not used. */
|
Tcl_Interp *interp; /* Current interpreter. */
|
Tcl_Interp *interp; /* Current interpreter. */
|
int argc; /* Number of arguments. */
|
int argc; /* Number of arguments. */
|
char **argv; /* Argument strings. */
|
char **argv; /* Argument strings. */
|
{
|
{
|
int i, noComplain, firstArg;
|
int i, noComplain, firstArg;
|
char c;
|
char c;
|
int result = TCL_OK;
|
int result = TCL_OK;
|
Tcl_DString buffer;
|
Tcl_DString buffer;
|
char *separators, *head, *tail;
|
char *separators, *head, *tail;
|
|
|
noComplain = 0;
|
noComplain = 0;
|
for (firstArg = 1; (firstArg < argc) && (argv[firstArg][0] == '-');
|
for (firstArg = 1; (firstArg < argc) && (argv[firstArg][0] == '-');
|
firstArg++) {
|
firstArg++) {
|
if (strcmp(argv[firstArg], "-nocomplain") == 0) {
|
if (strcmp(argv[firstArg], "-nocomplain") == 0) {
|
noComplain = 1;
|
noComplain = 1;
|
} else if (strcmp(argv[firstArg], "--") == 0) {
|
} else if (strcmp(argv[firstArg], "--") == 0) {
|
firstArg++;
|
firstArg++;
|
break;
|
break;
|
} else {
|
} else {
|
Tcl_AppendResult(interp, "bad switch \"", argv[firstArg],
|
Tcl_AppendResult(interp, "bad switch \"", argv[firstArg],
|
"\": must be -nocomplain or --", (char *) NULL);
|
"\": must be -nocomplain or --", (char *) NULL);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
}
|
}
|
if (firstArg >= argc) {
|
if (firstArg >= argc) {
|
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
" ?switches? name ?name ...?\"", (char *) NULL);
|
" ?switches? name ?name ...?\"", (char *) NULL);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
Tcl_DStringInit(&buffer);
|
Tcl_DStringInit(&buffer);
|
separators = NULL; /* Needed only to prevent gcc warnings. */
|
separators = NULL; /* Needed only to prevent gcc warnings. */
|
for (i = firstArg; i < argc; i++) {
|
for (i = firstArg; i < argc; i++) {
|
switch (tclPlatform) {
|
switch (tclPlatform) {
|
case TCL_PLATFORM_UNIX:
|
case TCL_PLATFORM_UNIX:
|
separators = "/";
|
separators = "/";
|
break;
|
break;
|
case TCL_PLATFORM_WINDOWS:
|
case TCL_PLATFORM_WINDOWS:
|
separators = "/\\:";
|
separators = "/\\:";
|
break;
|
break;
|
case TCL_PLATFORM_MAC:
|
case TCL_PLATFORM_MAC:
|
separators = (strchr(argv[i], ':') == NULL) ? "/" : ":";
|
separators = (strchr(argv[i], ':') == NULL) ? "/" : ":";
|
break;
|
break;
|
}
|
}
|
|
|
Tcl_DStringSetLength(&buffer, 0);
|
Tcl_DStringSetLength(&buffer, 0);
|
|
|
/*
|
/*
|
* Perform tilde substitution, if needed.
|
* Perform tilde substitution, if needed.
|
*/
|
*/
|
|
|
if (argv[i][0] == '~') {
|
if (argv[i][0] == '~') {
|
char *p;
|
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++) {
|
for (tail = argv[i]; *tail != '\0'; tail++) {
|
if (*tail == '\\') {
|
if (*tail == '\\') {
|
if (strchr(separators, tail[1]) != NULL) {
|
if (strchr(separators, tail[1]) != NULL) {
|
break;
|
break;
|
}
|
}
|
} else if (strchr(separators, *tail) != NULL) {
|
} else if (strchr(separators, *tail) != NULL) {
|
break;
|
break;
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
* Determine the home directory for the specified user. Note that
|
* Determine the home directory for the specified user. Note that
|
* we don't allow special characters in the user name.
|
* we don't allow special characters in the user name.
|
*/
|
*/
|
|
|
c = *tail;
|
c = *tail;
|
*tail = '\0';
|
*tail = '\0';
|
p = strpbrk(argv[i]+1, "\\[]*?{}");
|
p = strpbrk(argv[i]+1, "\\[]*?{}");
|
if (p == NULL) {
|
if (p == NULL) {
|
head = DoTildeSubst(interp, argv[i]+1, &buffer);
|
head = DoTildeSubst(interp, argv[i]+1, &buffer);
|
} else {
|
} else {
|
if (!noComplain) {
|
if (!noComplain) {
|
Tcl_ResetResult(interp);
|
Tcl_ResetResult(interp);
|
Tcl_AppendResult(interp, "globbing characters not ",
|
Tcl_AppendResult(interp, "globbing characters not ",
|
"supported in user names", (char *) NULL);
|
"supported in user names", (char *) NULL);
|
}
|
}
|
head = NULL;
|
head = NULL;
|
}
|
}
|
*tail = c;
|
*tail = c;
|
if (head == NULL) {
|
if (head == NULL) {
|
if (noComplain) {
|
if (noComplain) {
|
Tcl_ResetResult(interp);
|
Tcl_ResetResult(interp);
|
continue;
|
continue;
|
} else {
|
} else {
|
result = TCL_ERROR;
|
result = TCL_ERROR;
|
goto done;
|
goto done;
|
}
|
}
|
}
|
}
|
if (head != Tcl_DStringValue(&buffer)) {
|
if (head != Tcl_DStringValue(&buffer)) {
|
Tcl_DStringAppend(&buffer, head, -1);
|
Tcl_DStringAppend(&buffer, head, -1);
|
}
|
}
|
} else {
|
} else {
|
tail = argv[i];
|
tail = argv[i];
|
}
|
}
|
|
|
result = TclDoGlob(interp, separators, &buffer, tail);
|
result = TclDoGlob(interp, separators, &buffer, tail);
|
if (result != TCL_OK) {
|
if (result != TCL_OK) {
|
if (noComplain) {
|
if (noComplain) {
|
/*
|
/*
|
* We should in fact pass down the nocomplain flag
|
* 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 mecanism
|
* so the interp result is not mangled on errors in that case.
|
* so the interp result is not mangled on errors in that case.
|
* but that would a bigger change than reasonable for a patch
|
* but that would a bigger change than reasonable for a patch
|
* release.
|
* release.
|
* (see fileName.test 15.2-15.4 for expected behaviour)
|
* (see fileName.test 15.2-15.4 for expected behaviour)
|
*/
|
*/
|
Tcl_ResetResult(interp);
|
Tcl_ResetResult(interp);
|
result = TCL_OK;
|
result = TCL_OK;
|
continue;
|
continue;
|
} else {
|
} else {
|
goto done;
|
goto done;
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
if ((*interp->result == 0) && !noComplain) {
|
if ((*interp->result == 0) && !noComplain) {
|
char *sep = "";
|
char *sep = "";
|
|
|
Tcl_AppendResult(interp, "no files matched glob pattern",
|
Tcl_AppendResult(interp, "no files matched glob pattern",
|
(argc == 2) ? " \"" : "s \"", (char *) NULL);
|
(argc == 2) ? " \"" : "s \"", (char *) NULL);
|
for (i = firstArg; i < argc; i++) {
|
for (i = firstArg; i < argc; i++) {
|
Tcl_AppendResult(interp, sep, argv[i], (char *) NULL);
|
Tcl_AppendResult(interp, sep, argv[i], (char *) NULL);
|
sep = " ";
|
sep = " ";
|
}
|
}
|
Tcl_AppendResult(interp, "\"", (char *) NULL);
|
Tcl_AppendResult(interp, "\"", (char *) NULL);
|
result = TCL_ERROR;
|
result = TCL_ERROR;
|
}
|
}
|
done:
|
done:
|
Tcl_DStringFree(&buffer);
|
Tcl_DStringFree(&buffer);
|
return result;
|
return result;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* SkipToChar --
|
* SkipToChar --
|
*
|
*
|
* This function traverses a glob pattern looking for the next
|
* This function traverses a glob pattern looking for the next
|
* unquoted occurance of the specified character at the same braces
|
* unquoted occurance of the specified character at the same braces
|
* nesting level.
|
* nesting level.
|
*
|
*
|
* Results:
|
* Results:
|
* Updates stringPtr to point to the matching character, or to
|
* Updates stringPtr to point to the matching character, or to
|
* the end of the string if nothing matched. The return value
|
* the end of the string if nothing matched. The return value
|
* is 1 if a match was found at the top level, otherwise it is 0.
|
* is 1 if a match was found at the top level, otherwise it is 0.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static int
|
static int
|
SkipToChar(stringPtr, match)
|
SkipToChar(stringPtr, match)
|
char **stringPtr; /* Pointer string to check. */
|
char **stringPtr; /* Pointer string to check. */
|
char *match; /* Pointer to character to find. */
|
char *match; /* Pointer to character to find. */
|
{
|
{
|
int quoted, level;
|
int quoted, level;
|
register char *p;
|
register char *p;
|
|
|
quoted = 0;
|
quoted = 0;
|
level = 0;
|
level = 0;
|
|
|
for (p = *stringPtr; *p != '\0'; p++) {
|
for (p = *stringPtr; *p != '\0'; p++) {
|
if (quoted) {
|
if (quoted) {
|
quoted = 0;
|
quoted = 0;
|
continue;
|
continue;
|
}
|
}
|
if ((level == 0) && (*p == *match)) {
|
if ((level == 0) && (*p == *match)) {
|
*stringPtr = p;
|
*stringPtr = p;
|
return 1;
|
return 1;
|
}
|
}
|
if (*p == '{') {
|
if (*p == '{') {
|
level++;
|
level++;
|
} else if (*p == '}') {
|
} else if (*p == '}') {
|
level--;
|
level--;
|
} else if (*p == '\\') {
|
} else if (*p == '\\') {
|
quoted = 1;
|
quoted = 1;
|
}
|
}
|
}
|
}
|
*stringPtr = p;
|
*stringPtr = p;
|
return 0;
|
return 0;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* TclDoGlob --
|
* TclDoGlob --
|
*
|
*
|
* This recursive procedure forms the heart of the globbing
|
* This recursive procedure forms the heart of the globbing
|
* code. It performs a depth-first traversal of the tree
|
* code. It performs a depth-first traversal of the tree
|
* given by the path name to be globbed. The directory and
|
* given by the path name to be globbed. The directory and
|
* remainder are assumed to be native format paths.
|
* remainder are assumed to be native format paths.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is a standard Tcl result indicating whether
|
* The return value is a standard Tcl result indicating whether
|
* an error occurred in globbing. After a normal return the
|
* an error occurred in globbing. After a normal return the
|
* result in interp will be set to hold all of the file names
|
* result in interp will be set to hold all of the file names
|
* given by the dir and rem arguments. After an error the
|
* given by the dir and rem arguments. After an error the
|
* result in interp will hold an error message.
|
* result in interp will hold an error message.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
TclDoGlob(interp, separators, headPtr, tail)
|
TclDoGlob(interp, separators, headPtr, tail)
|
Tcl_Interp *interp; /* Interpreter to use for error reporting
|
Tcl_Interp *interp; /* Interpreter to use for error reporting
|
* (e.g. unmatched brace). */
|
* (e.g. unmatched brace). */
|
char *separators; /* String containing separator characters
|
char *separators; /* String containing separator characters
|
* that should be used to identify globbing
|
* that should be used to identify globbing
|
* boundaries. */
|
* boundaries. */
|
Tcl_DString *headPtr; /* Completely expanded prefix. */
|
Tcl_DString *headPtr; /* Completely expanded prefix. */
|
char *tail; /* The unexpanded remainder of the path. */
|
char *tail; /* The unexpanded remainder of the path. */
|
{
|
{
|
int baseLength, quoted, count;
|
int baseLength, quoted, count;
|
int result = TCL_OK;
|
int result = TCL_OK;
|
char *p, *openBrace, *closeBrace, *name, *firstSpecialChar, savedChar;
|
char *p, *openBrace, *closeBrace, *name, *firstSpecialChar, savedChar;
|
char lastChar = 0;
|
char lastChar = 0;
|
int length = Tcl_DStringLength(headPtr);
|
int length = Tcl_DStringLength(headPtr);
|
|
|
if (length > 0) {
|
if (length > 0) {
|
lastChar = Tcl_DStringValue(headPtr)[length-1];
|
lastChar = Tcl_DStringValue(headPtr)[length-1];
|
}
|
}
|
|
|
/*
|
/*
|
* Consume any leading directory separators, leaving tail pointing
|
* Consume any leading directory separators, leaving tail pointing
|
* just past the last initial separator.
|
* just past the last initial separator.
|
*/
|
*/
|
|
|
count = 0;
|
count = 0;
|
name = tail;
|
name = tail;
|
for (; *tail != '\0'; tail++) {
|
for (; *tail != '\0'; tail++) {
|
if ((*tail == '\\') && (strchr(separators, tail[1]) != NULL)) {
|
if ((*tail == '\\') && (strchr(separators, tail[1]) != NULL)) {
|
tail++;
|
tail++;
|
} else if (strchr(separators, *tail) == NULL) {
|
} else if (strchr(separators, *tail) == NULL) {
|
break;
|
break;
|
}
|
}
|
count++;
|
count++;
|
}
|
}
|
|
|
/*
|
/*
|
* Deal with path separators. On the Mac, we have to watch out
|
* Deal with path separators. On the Mac, we have to watch out
|
* for multiple separators, since they are special in Mac-style
|
* for multiple separators, since they are special in Mac-style
|
* paths.
|
* paths.
|
*/
|
*/
|
|
|
switch (tclPlatform) {
|
switch (tclPlatform) {
|
case TCL_PLATFORM_MAC:
|
case TCL_PLATFORM_MAC:
|
if (*separators == '/') {
|
if (*separators == '/') {
|
if (((length == 0) && (count == 0))
|
if (((length == 0) && (count == 0))
|
|| ((length > 0) && (lastChar != ':'))) {
|
|| ((length > 0) && (lastChar != ':'))) {
|
Tcl_DStringAppend(headPtr, ":", 1);
|
Tcl_DStringAppend(headPtr, ":", 1);
|
}
|
}
|
} else {
|
} else {
|
if (count == 0) {
|
if (count == 0) {
|
if ((length > 0) && (lastChar != ':')) {
|
if ((length > 0) && (lastChar != ':')) {
|
Tcl_DStringAppend(headPtr, ":", 1);
|
Tcl_DStringAppend(headPtr, ":", 1);
|
}
|
}
|
} else {
|
} else {
|
if (lastChar == ':') {
|
if (lastChar == ':') {
|
count--;
|
count--;
|
}
|
}
|
while (count-- > 0) {
|
while (count-- > 0) {
|
Tcl_DStringAppend(headPtr, ":", 1);
|
Tcl_DStringAppend(headPtr, ":", 1);
|
}
|
}
|
}
|
}
|
}
|
}
|
break;
|
break;
|
case TCL_PLATFORM_WINDOWS:
|
case TCL_PLATFORM_WINDOWS:
|
/*
|
/*
|
* If this is a drive relative path, add the colon and the
|
* If this is a drive relative path, add the colon and the
|
* trailing slash if needed. Otherwise add the slash if
|
* trailing slash if needed. Otherwise add the slash if
|
* this is the first absolute element, or a later relative
|
* this is the first absolute element, or a later relative
|
* element. Add an extra slash if this is a UNC path.
|
* element. Add an extra slash if this is a UNC path.
|
*/
|
*/
|
|
|
if (*name == ':') {
|
if (*name == ':') {
|
Tcl_DStringAppend(headPtr, ":", 1);
|
Tcl_DStringAppend(headPtr, ":", 1);
|
if (count > 1) {
|
if (count > 1) {
|
Tcl_DStringAppend(headPtr, "/", 1);
|
Tcl_DStringAppend(headPtr, "/", 1);
|
}
|
}
|
} else if ((*tail != '\0')
|
} else if ((*tail != '\0')
|
&& (((length > 0)
|
&& (((length > 0)
|
&& (strchr(separators, lastChar) == NULL))
|
&& (strchr(separators, lastChar) == NULL))
|
|| ((length == 0) && (count > 0)))) {
|
|| ((length == 0) && (count > 0)))) {
|
Tcl_DStringAppend(headPtr, "/", 1);
|
Tcl_DStringAppend(headPtr, "/", 1);
|
if ((length == 0) && (count > 1)) {
|
if ((length == 0) && (count > 1)) {
|
Tcl_DStringAppend(headPtr, "/", 1);
|
Tcl_DStringAppend(headPtr, "/", 1);
|
}
|
}
|
}
|
}
|
|
|
break;
|
break;
|
case TCL_PLATFORM_UNIX:
|
case TCL_PLATFORM_UNIX:
|
/*
|
/*
|
* Add a separator if this is the first absolute element, or
|
* Add a separator if this is the first absolute element, or
|
* a later relative element.
|
* a later relative element.
|
*/
|
*/
|
|
|
if ((*tail != '\0')
|
if ((*tail != '\0')
|
&& (((length > 0)
|
&& (((length > 0)
|
&& (strchr(separators, lastChar) == NULL))
|
&& (strchr(separators, lastChar) == NULL))
|
|| ((length == 0) && (count > 0)))) {
|
|| ((length == 0) && (count > 0)))) {
|
Tcl_DStringAppend(headPtr, "/", 1);
|
Tcl_DStringAppend(headPtr, "/", 1);
|
}
|
}
|
break;
|
break;
|
}
|
}
|
|
|
/*
|
/*
|
* Look for the first matching pair of braces or the first
|
* Look for the first matching pair of braces or the first
|
* directory separator that is not inside a pair of braces.
|
* directory separator that is not inside a pair of braces.
|
*/
|
*/
|
|
|
openBrace = closeBrace = NULL;
|
openBrace = closeBrace = NULL;
|
quoted = 0;
|
quoted = 0;
|
for (p = tail; *p != '\0'; p++) {
|
for (p = tail; *p != '\0'; p++) {
|
if (quoted) {
|
if (quoted) {
|
quoted = 0;
|
quoted = 0;
|
} else if (*p == '\\') {
|
} else if (*p == '\\') {
|
quoted = 1;
|
quoted = 1;
|
if (strchr(separators, p[1]) != NULL) {
|
if (strchr(separators, p[1]) != NULL) {
|
break; /* Quoted directory separator. */
|
break; /* Quoted directory separator. */
|
}
|
}
|
} else if (strchr(separators, *p) != NULL) {
|
} else if (strchr(separators, *p) != NULL) {
|
break; /* Unquoted directory separator. */
|
break; /* Unquoted directory separator. */
|
} else if (*p == '{') {
|
} else if (*p == '{') {
|
openBrace = p;
|
openBrace = p;
|
p++;
|
p++;
|
if (SkipToChar(&p, "}")) {
|
if (SkipToChar(&p, "}")) {
|
closeBrace = p; /* Balanced braces. */
|
closeBrace = p; /* Balanced braces. */
|
break;
|
break;
|
}
|
}
|
Tcl_SetResult(interp, "unmatched open-brace in file name",
|
Tcl_SetResult(interp, "unmatched open-brace in file name",
|
TCL_STATIC);
|
TCL_STATIC);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
} else if (*p == '}') {
|
} else if (*p == '}') {
|
Tcl_SetResult(interp, "unmatched close-brace in file name",
|
Tcl_SetResult(interp, "unmatched close-brace in file name",
|
TCL_STATIC);
|
TCL_STATIC);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
* Substitute the alternate patterns from the braces and recurse.
|
* Substitute the alternate patterns from the braces and recurse.
|
*/
|
*/
|
|
|
if (openBrace != NULL) {
|
if (openBrace != NULL) {
|
char *element;
|
char *element;
|
Tcl_DString newName;
|
Tcl_DString newName;
|
Tcl_DStringInit(&newName);
|
Tcl_DStringInit(&newName);
|
|
|
/*
|
/*
|
* For each element within in the outermost pair of braces,
|
* For each element within in the outermost pair of braces,
|
* append the element and the remainder to the fixed portion
|
* append the element and the remainder to the fixed portion
|
* before the first brace and recursively call TclDoGlob.
|
* before the first brace and recursively call TclDoGlob.
|
*/
|
*/
|
|
|
Tcl_DStringAppend(&newName, tail, openBrace-tail);
|
Tcl_DStringAppend(&newName, tail, openBrace-tail);
|
baseLength = Tcl_DStringLength(&newName);
|
baseLength = Tcl_DStringLength(&newName);
|
length = Tcl_DStringLength(headPtr);
|
length = Tcl_DStringLength(headPtr);
|
*closeBrace = '\0';
|
*closeBrace = '\0';
|
for (p = openBrace; p != closeBrace; ) {
|
for (p = openBrace; p != closeBrace; ) {
|
p++;
|
p++;
|
element = p;
|
element = p;
|
SkipToChar(&p, ",");
|
SkipToChar(&p, ",");
|
Tcl_DStringSetLength(headPtr, length);
|
Tcl_DStringSetLength(headPtr, length);
|
Tcl_DStringSetLength(&newName, baseLength);
|
Tcl_DStringSetLength(&newName, baseLength);
|
Tcl_DStringAppend(&newName, element, p-element);
|
Tcl_DStringAppend(&newName, element, p-element);
|
Tcl_DStringAppend(&newName, closeBrace+1, -1);
|
Tcl_DStringAppend(&newName, closeBrace+1, -1);
|
result = TclDoGlob(interp, separators,
|
result = TclDoGlob(interp, separators,
|
headPtr, Tcl_DStringValue(&newName));
|
headPtr, Tcl_DStringValue(&newName));
|
if (result != TCL_OK) {
|
if (result != TCL_OK) {
|
break;
|
break;
|
}
|
}
|
}
|
}
|
*closeBrace = '}';
|
*closeBrace = '}';
|
Tcl_DStringFree(&newName);
|
Tcl_DStringFree(&newName);
|
return result;
|
return result;
|
}
|
}
|
|
|
/*
|
/*
|
* At this point, there are no more brace substitutions to perform on
|
* At this point, there are no more brace substitutions to perform on
|
* this path component. The variable p is pointing at a quoted or
|
* this path component. The variable p is pointing at a quoted or
|
* unquoted directory separator or the end of the string. So we need
|
* unquoted directory separator or the end of the string. So we need
|
* to check for special globbing characters in the current pattern.
|
* to check for special globbing characters in the current pattern.
|
* We avoid modifying tail if p is pointing at the end of the string.
|
* We avoid modifying tail if p is pointing at the end of the string.
|
*/
|
*/
|
|
|
if (*p != '\0') {
|
if (*p != '\0') {
|
savedChar = *p;
|
savedChar = *p;
|
*p = '\0';
|
*p = '\0';
|
firstSpecialChar = strpbrk(tail, "*[]?\\");
|
firstSpecialChar = strpbrk(tail, "*[]?\\");
|
*p = savedChar;
|
*p = savedChar;
|
} else {
|
} else {
|
firstSpecialChar = strpbrk(tail, "*[]?\\");
|
firstSpecialChar = strpbrk(tail, "*[]?\\");
|
}
|
}
|
|
|
if (firstSpecialChar != NULL) {
|
if (firstSpecialChar != NULL) {
|
/*
|
/*
|
* Look for matching files in the current directory. The
|
* Look for matching files in the current directory. The
|
* implementation of this function is platform specific, but may
|
* implementation of this function is platform specific, but may
|
* recursively call TclDoGlob. For each file that matches, it will
|
* 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->result, or call TclDoGlob if there
|
* are more characters to be processed.
|
* are more characters to be processed.
|
*/
|
*/
|
|
|
return TclMatchFiles(interp, separators, headPtr, tail, p);
|
return TclMatchFiles(interp, separators, headPtr, tail, p);
|
}
|
}
|
Tcl_DStringAppend(headPtr, tail, p-tail);
|
Tcl_DStringAppend(headPtr, tail, p-tail);
|
if (*p != '\0') {
|
if (*p != '\0') {
|
return TclDoGlob(interp, separators, headPtr, p);
|
return TclDoGlob(interp, separators, headPtr, p);
|
}
|
}
|
|
|
/*
|
/*
|
* There are no more wildcards in the pattern and no more unprocessed
|
* There are no more wildcards in the pattern and no more unprocessed
|
* characters in the tail, so now we can construct the path and verify
|
* characters in the tail, so now we can construct the path and verify
|
* the existence of the file.
|
* the existence of the file.
|
*/
|
*/
|
|
|
switch (tclPlatform) {
|
switch (tclPlatform) {
|
case TCL_PLATFORM_MAC:
|
case TCL_PLATFORM_MAC:
|
if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) {
|
if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) {
|
Tcl_DStringAppend(headPtr, ":", 1);
|
Tcl_DStringAppend(headPtr, ":", 1);
|
}
|
}
|
name = Tcl_DStringValue(headPtr);
|
name = Tcl_DStringValue(headPtr);
|
if (TclAccess(name, F_OK) == 0) {
|
if (TclAccess(name, F_OK) == 0) {
|
if ((name[1] != '\0') && (strchr(name+1, ':') == NULL)) {
|
if ((name[1] != '\0') && (strchr(name+1, ':') == NULL)) {
|
Tcl_AppendElement(interp, name+1);
|
Tcl_AppendElement(interp, name+1);
|
} else {
|
} else {
|
Tcl_AppendElement(interp, name);
|
Tcl_AppendElement(interp, name);
|
}
|
}
|
}
|
}
|
break;
|
break;
|
case TCL_PLATFORM_WINDOWS: {
|
case TCL_PLATFORM_WINDOWS: {
|
int exists;
|
int exists;
|
#ifndef __CYGWIN__
|
#ifndef __CYGWIN__
|
/*
|
/*
|
* We need to convert slashes to backslashes before checking
|
* We need to convert slashes to backslashes before checking
|
* for the existence of the file. Once we are done, we need
|
* for the existence of the file. Once we are done, we need
|
* to convert the slashes back.
|
* to convert the slashes back.
|
*/
|
*/
|
|
|
if (Tcl_DStringLength(headPtr) == 0) {
|
if (Tcl_DStringLength(headPtr) == 0) {
|
if (((*name == '\\') && (name[1] == '/' || name[1] == '\\'))
|
if (((*name == '\\') && (name[1] == '/' || name[1] == '\\'))
|
|| (*name == '/')) {
|
|| (*name == '/')) {
|
Tcl_DStringAppend(headPtr, "\\", 1);
|
Tcl_DStringAppend(headPtr, "\\", 1);
|
} else {
|
} else {
|
Tcl_DStringAppend(headPtr, ".", 1);
|
Tcl_DStringAppend(headPtr, ".", 1);
|
}
|
}
|
} else {
|
} else {
|
for (p = Tcl_DStringValue(headPtr); *p != '\0'; p++) {
|
for (p = Tcl_DStringValue(headPtr); *p != '\0'; p++) {
|
if (*p == '/') {
|
if (*p == '/') {
|
*p = '\\';
|
*p = '\\';
|
}
|
}
|
}
|
}
|
}
|
}
|
#endif
|
#endif
|
name = Tcl_DStringValue(headPtr);
|
name = Tcl_DStringValue(headPtr);
|
exists = (TclAccess(name, F_OK) == 0);
|
exists = (TclAccess(name, F_OK) == 0);
|
for (p = name; *p != '\0'; p++) {
|
for (p = name; *p != '\0'; p++) {
|
if (*p == '\\') {
|
if (*p == '\\') {
|
*p = '/';
|
*p = '/';
|
}
|
}
|
}
|
}
|
if (exists) {
|
if (exists) {
|
Tcl_AppendElement(interp, name);
|
Tcl_AppendElement(interp, name);
|
}
|
}
|
break;
|
break;
|
}
|
}
|
case TCL_PLATFORM_UNIX:
|
case TCL_PLATFORM_UNIX:
|
if (Tcl_DStringLength(headPtr) == 0) {
|
if (Tcl_DStringLength(headPtr) == 0) {
|
if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
|
if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
|
Tcl_DStringAppend(headPtr, "/", 1);
|
Tcl_DStringAppend(headPtr, "/", 1);
|
} else {
|
} else {
|
Tcl_DStringAppend(headPtr, ".", 1);
|
Tcl_DStringAppend(headPtr, ".", 1);
|
}
|
}
|
}
|
}
|
name = Tcl_DStringValue(headPtr);
|
name = Tcl_DStringValue(headPtr);
|
if (TclAccess(name, F_OK) == 0) {
|
if (TclAccess(name, F_OK) == 0) {
|
Tcl_AppendElement(interp, name);
|
Tcl_AppendElement(interp, name);
|
}
|
}
|
break;
|
break;
|
}
|
}
|
|
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
