summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclEncoding.c4
-rw-r--r--generic/tclFileName.c501
-rw-r--r--generic/tclInt.decls8
-rw-r--r--generic/tclInt.h42
-rw-r--r--generic/tclIntDecls.h16
-rw-r--r--generic/tclStubInit.c3
6 files changed, 502 insertions, 72 deletions
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index ad86495..89453f5 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclEncoding.c,v 1.3 1999/12/02 02:03:22 redman Exp $
+ * RCS: @(#) $Id: tclEncoding.c,v 1.4 1999/12/12 22:46:41 hobbs Exp $
*/
#include "tclInt.h"
@@ -588,7 +588,7 @@ Tcl_GetEncodingNames(interp)
strcpy(globArgString, "*.enc");
if ((Tcl_Chdir(string) == 0)
&& (Tcl_Chdir("encoding") == 0)
- && (TclGlob(interp, globArgString, 0) == TCL_OK)) {
+ && (TclGlob(interp, globArgString, NULL, 0, NULL) == TCL_OK)) {
objc2 = 0;
Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), &objc2,
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 06e83a3..cee1901 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclFileName.c,v 1.6 1999/04/16 00:46:46 stanton Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.7 1999/12/12 22:46:42 hobbs Exp $
*/
#include "tclInt.h"
@@ -54,6 +54,15 @@ static Tcl_ThreadDataKey dataKey;
TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
/*
+ * The "globParameters" argument of the globbing functions is an
+ * or'ed combination of the following values:
+ */
+
+#define GLOBMODE_NO_COMPLAIN 1
+#define GLOBMODE_JOIN 2
+#define GLOBMODE_DIR 4
+
+/*
* Prototypes for local procedures defined in this file:
*/
@@ -1173,56 +1182,381 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int index, i, noComplain, skip, length;
- char *string;
- static char *options[] = {"-nocomplain", "--", NULL};
- enum options {GLOB_NOCOMPLAIN, GLOB_LAST};
-
- noComplain = 0;
- for (skip = 1; skip < objc; skip++) {
- string = Tcl_GetString(objv[skip]);
- if (string[0] != '-') {
- break;
- }
- if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch",
- TCL_EXACT, &index) != TCL_OK) {
- return TCL_ERROR;
+ int index, i, globFlags, pathlength, length, join, dir, result;
+ char *string, *pathOrDir, *separators;
+ Tcl_Obj *typePtr, *resultPtr, *look;
+ Tcl_DString prefix, directory;
+ static char *options[] = {
+ "-directory", "-join", "-nocomplain", "-path", "-types", "--", NULL
+ };
+ enum options {
+ GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TYPE, GLOB_LAST
+ };
+ enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1};
+ GlobTypeData *globTypes = NULL;
+
+ globFlags = 0;
+ join = 0;
+ dir = PATH_NONE;
+ pathOrDir = NULL;
+ typePtr = NULL;
+ resultPtr = Tcl_GetObjResult(interp);
+ for (i = 1; i < objc; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
+ != TCL_OK) {
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ if (string[0] == '-') {
+ /*
+ * It looks like the command contains an option so signal
+ * an error
+ */
+ return TCL_ERROR;
+ } else {
+ /*
+ * This clearly isn't an option; assume it's the first
+ * glob pattern. We must clear the error
+ */
+ Tcl_ResetResult(interp);
+ break;
+ }
}
- if (index == GLOB_NOCOMPLAIN) {
- noComplain = 1;
- } else {
- skip++;
- break;
+ switch (index) {
+ case GLOB_NOCOMPLAIN: /* -nocomplain */
+ globFlags |= GLOBMODE_NO_COMPLAIN;
+ break;
+ case GLOB_DIR: /* -dir */
+ if (i == (objc-1)) {
+ Tcl_AppendToObj(resultPtr,
+ "missing argument to \"-directory\"", -1);
+ return TCL_ERROR;
+ }
+ if (dir != -1) {
+ Tcl_AppendToObj(resultPtr,
+ "\"-directory\" cannot be used with \"-path\"",
+ -1);
+ return TCL_ERROR;
+ }
+ dir = PATH_DIR;
+ globFlags |= GLOBMODE_DIR;
+ pathOrDir = Tcl_GetStringFromObj(objv[i+1], &pathlength);
+ i++;
+ break;
+ case GLOB_JOIN: /* -join */
+ join = 1;
+ break;
+ case GLOB_PATH: /* -path */
+ if (i == (objc-1)) {
+ Tcl_AppendToObj(resultPtr,
+ "missing argument to \"-path\"", -1);
+ return TCL_ERROR;
+ }
+ if (dir != -1) {
+ Tcl_AppendToObj(resultPtr,
+ "\"-path\" cannot be used with \"-directory\"",
+ -1);
+ return TCL_ERROR;
+ }
+ dir = PATH_GENERAL;
+ pathOrDir = Tcl_GetStringFromObj(objv[i+1], &pathlength);
+ i++;
+ break;
+ case GLOB_TYPE: /* -types */
+ if (i == (objc-1)) {
+ Tcl_AppendToObj(resultPtr,
+ "missing argument to \"-types\"", -1);
+ return TCL_ERROR;
+ }
+ typePtr = objv[i+1];
+ if (Tcl_ListObjLength(interp, typePtr, &length) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ i++;
+ break;
+ case GLOB_LAST: /* -- */
+ i++;
+ goto endOfForLoop;
+ break;
}
}
- if (skip >= objc) {
+ endOfForLoop:
+ if (objc - i < 1) {
Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?");
return TCL_ERROR;
}
- for (i = skip; i < objc; i++) {
- string = Tcl_GetString(objv[i]);
- if (TclGlob(interp, string, noComplain) != TCL_OK) {
- return TCL_ERROR;
+ separators = NULL; /* lint. */
+ switch (tclPlatform) {
+ case TCL_PLATFORM_UNIX:
+ separators = "/";
+ break;
+ case TCL_PLATFORM_WINDOWS:
+ separators = "/\\:";
+ break;
+ case TCL_PLATFORM_MAC:
+ if ((pathOrDir != NULL) && (strchr(pathOrDir, ':') == NULL)) {
+ separators = "/";
+ } else {
+ separators = ":";
+ }
+ break;
+ }
+ if (dir == PATH_GENERAL) {
+ char *last;
+
+ /*
+ * Find the last path separator in the path
+ */
+ last = pathOrDir + pathlength;
+ for (; last != pathOrDir; last--) {
+ if (strchr(separators, *(last-1)) != NULL) {
+ break;
+ }
+ }
+ if (last == pathOrDir + pathlength) {
+ /* It's really a directory */
+ dir = 1;
+ } else {
+ Tcl_DString pref;
+ char *search, *find;
+ Tcl_DStringInit(&pref);
+ Tcl_DStringInit(&directory);
+ if (last == pathOrDir) {
+ /* The whole thing is a prefix */
+ Tcl_DStringAppend(&pref, pathOrDir, -1);
+ pathOrDir = NULL;
+ } else {
+ /* Have to split off the end */
+ Tcl_DStringAppend(&pref, last, pathOrDir+pathlength-last);
+ Tcl_DStringAppend(&directory, pathOrDir, last-pathOrDir-1);
+ pathOrDir = Tcl_DStringValue(&directory);
+ }
+ /* Need to quote 'prefix' */
+ Tcl_DStringInit(&prefix);
+ search = Tcl_DStringValue(&pref);
+ while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) {
+ Tcl_DStringAppend(&prefix, search, find-search);
+ Tcl_DStringAppend(&prefix, "\\", 1);
+ Tcl_DStringAppend(&prefix, find, 1);
+ search = find+1;
+ if (*search == '\0') {
+ break;
+ }
+ }
+ if (*search != '\0') {
+ Tcl_DStringAppend(&prefix, search, -1);
+ }
+ Tcl_DStringFree(&pref);
}
}
- 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++) {
+ if (typePtr != NULL) {
+ /*
+ * The rest of the possible type arguments (except 'd') are
+ * platform specific. We don't complain when they are used
+ * on an incompatible platform.
+ */
+ Tcl_ListObjLength(interp, typePtr, &length);
+ globTypes = (GlobTypeData*) ckalloc(sizeof(GlobTypeData));
+ globTypes->type = 0;
+ globTypes->perm = 0;
+ globTypes->macType = NULL;
+ globTypes->macCreator = NULL;
+ while(--length >= 0) {
+ int len;
+ char *str;
+ Tcl_ListObjIndex(interp, typePtr, length, &look);
+ str = Tcl_GetStringFromObj(look, &len);
+ if (strcmp("readonly", str) == 0) {
+ globTypes->perm |= TCL_GLOB_PERM_RONLY;
+ } else if (strcmp("hidden", str) == 0) {
+ globTypes->perm |= TCL_GLOB_PERM_HIDDEN;
+ } else if (len == 1) {
+ switch (str[0]) {
+ case 'r':
+ globTypes->perm |= TCL_GLOB_PERM_R;
+ break;
+ case 'w':
+ globTypes->perm |= TCL_GLOB_PERM_W;
+ break;
+ case 'x':
+ globTypes->perm |= TCL_GLOB_PERM_X;
+ break;
+ case 'b':
+ globTypes->type |= TCL_GLOB_TYPE_BLOCK;
+ break;
+ case 'c':
+ globTypes->type |= TCL_GLOB_TYPE_CHAR;
+ break;
+ case 'd':
+ globTypes->type |= TCL_GLOB_TYPE_DIR;
+ break;
+ case 'p':
+ globTypes->type |= TCL_GLOB_TYPE_PIPE;
+ break;
+ case 'f':
+ globTypes->type |= TCL_GLOB_TYPE_FILE;
+ break;
+ case 'l':
+ globTypes->type |= TCL_GLOB_TYPE_LINK;
+ break;
+ case 's':
+ globTypes->type |= TCL_GLOB_TYPE_SOCK;
+ break;
+ default:
+ goto badTypesArg;
+ }
+ } else if (len == 4) {
+ /* This is assumed to be a MacOS file type */
+ if (globTypes->macType != NULL) {
+ goto badMacTypesArg;
+ }
+ globTypes->macType = look;
+ Tcl_IncrRefCount(look);
+ } else {
+ Tcl_Obj* item;
+ if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) &&
+ (len == 3)) {
+ Tcl_ListObjIndex(interp, look, 0, &item);
+ if (!strcmp("macintosh", Tcl_GetString(item))) {
+ Tcl_ListObjIndex(interp, look, 1, &item);
+ if (!strcmp("type", Tcl_GetString(item))) {
+ Tcl_ListObjIndex(interp, look, 2, &item);
+ if (globTypes->macType != NULL) {
+ goto badMacTypesArg;
+ }
+ globTypes->macType = item;
+ Tcl_IncrRefCount(item);
+ continue;
+ } else if (!strcmp("creator", Tcl_GetString(item))) {
+ Tcl_ListObjIndex(interp, look, 2, &item);
+ if (globTypes->macCreator != NULL) {
+ goto badMacTypesArg;
+ }
+ globTypes->macCreator = item;
+ Tcl_IncrRefCount(item);
+ continue;
+ }
+ }
+ }
+ /*
+ * Error cases
+ */
+ badTypesArg:
+ Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
+ Tcl_AppendObjToObj(resultPtr, look);
+ result = TCL_ERROR;
+ goto endOfGlob;
+ badMacTypesArg:
+ Tcl_AppendToObj(resultPtr,
+ "only one MacOS type or creator argument to \"-types\" allowed", -1);
+ result = TCL_ERROR;
+ goto endOfGlob;
+ }
+ }
+ }
+
+ /*
+ * Now we perform the actual glob below. This may involve joining
+ * together the pattern arguments, dealing with particular file types
+ * etc. We use a 'goto' to ensure we free any memory allocated along
+ * the way.
+ */
+ objc -= i;
+ objv += i;
+ /*
+ * We re-retrieve this, in case it was changed in
+ * the Tcl_ResetResult above
+ */
+ resultPtr = Tcl_GetObjResult(interp);
+ result = TCL_OK;
+ if (join) {
+ if (dir != PATH_GENERAL) {
+ Tcl_DStringInit(&prefix);
+ }
+ for (i = 0; i < objc; i++) {
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ Tcl_DStringAppend(&prefix, string, length);
+ if (i != objc -1) {
+ Tcl_DStringAppend(&prefix, separators, 1);
+ }
+ }
+ if (TclGlob(interp, Tcl_DStringValue(&prefix), pathOrDir,
+ globFlags, globTypes) != TCL_OK) {
+ result = TCL_ERROR;
+ goto endOfGlob;
+ }
+ } else {
+ if (dir == PATH_GENERAL) {
+ Tcl_DString str;
+ for (i = 0; i < objc; i++) {
+ Tcl_DStringInit(&str);
+ if (dir == PATH_GENERAL) {
+ Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix),
+ Tcl_DStringLength(&prefix));
+ }
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ Tcl_DStringAppend(&str, string, length);
+ if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir,
+ globFlags, globTypes) != TCL_OK) {
+ result = TCL_ERROR;
+ Tcl_DStringFree(&str);
+ goto endOfGlob;
+ }
+ }
+ Tcl_DStringFree(&str);
+ } else {
+ for (i = 0; i < objc; i++) {
string = Tcl_GetString(objv[i]);
- Tcl_AppendResult(interp, sep, string, (char *) NULL);
- sep = " ";
+ if (TclGlob(interp, string, pathOrDir,
+ globFlags, globTypes) != TCL_OK) {
+ result = TCL_ERROR;
+ goto endOfGlob;
+ }
+ }
+ }
+ }
+ if ((globFlags & GLOBMODE_NO_COMPLAIN) == 0) {
+ if (Tcl_ListObjLength(interp, Tcl_GetObjResult(interp),
+ &length) != TCL_OK) {
+ /* This should never happen. Maybe we should be more dramatic */
+ result = TCL_ERROR;
+ goto endOfGlob;
+ }
+ if (length == 0) {
+ Tcl_AppendResult(interp, "no files matched glob pattern",
+ (join || (objc == 1)) ? " \"" : "s \"", (char *) NULL);
+ if (join) {
+ Tcl_AppendResult(interp, Tcl_DStringValue(&prefix),
+ (char *) NULL);
+ } else {
+ char *sep = "";
+ for (i = 0; i < objc; i++) {
+ string = Tcl_GetString(objv[i]);
+ Tcl_AppendResult(interp, sep, string, (char *) NULL);
+ sep = " ";
+ }
}
Tcl_AppendResult(interp, "\"", (char *) NULL);
- return TCL_ERROR;
+ result = TCL_ERROR;
}
}
- return TCL_OK;
+ endOfGlob:
+ if (join || (dir == PATH_GENERAL)) {
+ Tcl_DStringFree(&prefix);
+ if (dir == PATH_GENERAL) {
+ Tcl_DStringFree(&directory);
+ }
+ }
+ if (globTypes != NULL) {
+ if (globTypes->macType != NULL) {
+ Tcl_DecrRefCount(globTypes->macType);
+ }
+ if (globTypes->macCreator != NULL) {
+ Tcl_DecrRefCount(globTypes->macCreator);
+ }
+ ckfree((char *) globTypes);
+ }
+ return result;
}
/*
@@ -1249,16 +1583,19 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-TclGlob(interp, pattern, noComplain)
+TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
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 *unquotedPrefix; /* Prefix to glob pattern, if non-null, which
+ * is considered literally. May be static. */
+ int globFlags; /* Stores or'ed combination of flags */
+ GlobTypeData *types; /* Struct containing acceptable types.
+ * May be NULL. */
{
char *separators;
- char *head, *tail;
+ char *head, *tail, *start;
char c;
int result;
Tcl_DString buffer;
@@ -1278,19 +1615,22 @@ TclGlob(interp, pattern, noComplain)
}
Tcl_DStringInit(&buffer);
+ if (unquotedPrefix != NULL) {
+ start = unquotedPrefix;
+ } else {
+ start = pattern;
+ }
/*
* Perform tilde substitution, if needed.
*/
- if (pattern[0] == '~') {
- char *p;
-
+ if (start[0] == '~') {
+
/*
* Find the first path separator after the tilde.
*/
-
- for (tail = pattern; *tail != '\0'; tail++) {
+ for (tail = start; *tail != '\0'; tail++) {
if (*tail == '\\') {
if (strchr(separators, tail[1]) != NULL) {
break;
@@ -1307,20 +1647,29 @@ TclGlob(interp, pattern, noComplain)
c = *tail;
*tail = '\0';
- p = strpbrk(pattern+1, "\\[]*?{}");
- if (p == NULL) {
- head = DoTildeSubst(interp, pattern+1, &buffer);
+ /*
+ * I don't think we need to worry about special characters in
+ * the user name anymore (Vince Darley, June 1999), since the
+ * new code is designed to handle special chars.
+ */
+ #ifndef NOT_NEEDED_ANYMORE
+ head = DoTildeSubst(interp, start+1, &buffer);
+ #else
+
+ if (strpbrk(start+1, "\\[]*?{}") == NULL) {
+ head = DoTildeSubst(interp, start+1, &buffer);
} else {
- if (!noComplain) {
+ if (!(globFlags & GLOBMODE_NO_COMPLAIN)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "globbing characters not ",
"supported in user names", (char *) NULL);
}
head = NULL;
}
+ #endif
*tail = c;
if (head == NULL) {
- if (noComplain) {
+ if (globFlags & GLOBMODE_NO_COMPLAIN) {
/*
* We should in fact pass down the nocomplain flag
* or save the interp result or use another mechanism
@@ -1338,14 +1687,33 @@ TclGlob(interp, pattern, noComplain)
if (head != Tcl_DStringValue(&buffer)) {
Tcl_DStringAppend(&buffer, head, -1);
}
+ if (unquotedPrefix != NULL) {
+ Tcl_DStringAppend(&buffer, tail, -1);
+ tail = pattern;
+ }
} else {
tail = pattern;
+ if (unquotedPrefix != NULL) {
+ Tcl_DStringAppend(&buffer,unquotedPrefix,-1);
+ }
+ }
+ /*
+ * If the prefix is a directory, make sure it ends in a directory
+ * separator.
+ */
+ if (unquotedPrefix != NULL) {
+ if (globFlags & GLOBMODE_DIR) {
+ c = Tcl_DStringValue(&buffer)[Tcl_DStringLength(&buffer)-1];
+ if (strchr(separators, c) == NULL) {
+ Tcl_DStringAppend(&buffer,separators,1);
+ }
+ }
}
- result = TclDoGlob(interp, separators, &buffer, tail);
+ result = TclDoGlob(interp, separators, &buffer, tail, types);
Tcl_DStringFree(&buffer);
if (result != TCL_OK) {
- if (noComplain) {
+ if (globFlags & GLOBMODE_NO_COMPLAIN) {
Tcl_ResetResult(interp);
return TCL_OK;
}
@@ -1413,7 +1781,11 @@ SkipToChar(stringPtr, match)
* This recursive procedure forms the heart of the globbing
* code. It performs a depth-first traversal of the tree
* 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. The prefix
+ * contained in 'headPtr' is not used as a glob pattern, simply
+ * as a path specifier, so it can contain unquoted glob-sensitive
+ * characters (if the directories to which it points contain
+ * such strange characters).
*
* Results:
* The return value is a standard Tcl result indicating whether
@@ -1429,7 +1801,7 @@ SkipToChar(stringPtr, match)
*/
int
-TclDoGlob(interp, separators, headPtr, tail)
+TclDoGlob(interp, separators, headPtr, tail, types)
Tcl_Interp *interp; /* Interpreter to use for error reporting
* (e.g. unmatched brace). */
char *separators; /* String containing separator characters
@@ -1438,11 +1810,14 @@ TclDoGlob(interp, separators, headPtr, tail)
Tcl_DString *headPtr; /* Completely expanded prefix. */
char *tail; /* The unexpanded remainder of the path.
* Must not be a pointer to a static string. */
+ GlobTypeData *types; /* List object containing list of acceptable types.
+ * May be NULL. */
{
int baseLength, quoted, count;
int result = TCL_OK;
char *name, *p, *openBrace, *closeBrace, *firstSpecialChar, savedChar;
char lastChar = 0;
+
int length = Tcl_DStringLength(headPtr);
if (length > 0) {
@@ -1594,7 +1969,7 @@ TclDoGlob(interp, separators, headPtr, tail)
Tcl_DStringAppend(&newName, element, p-element);
Tcl_DStringAppend(&newName, closeBrace+1, -1);
result = TclDoGlob(interp, separators,
- headPtr, Tcl_DStringValue(&newName));
+ headPtr, Tcl_DStringValue(&newName), types);
if (result != TCL_OK) {
break;
}
@@ -1636,11 +2011,11 @@ TclDoGlob(interp, separators, headPtr, tail)
* are more characters to be processed.
*/
- return TclpMatchFiles(interp, separators, headPtr, tail, p);
+ return TclpMatchFilesTypes(interp, separators, headPtr, tail, p, types);
}
Tcl_DStringAppend(headPtr, tail, p-tail);
if (*p != '\0') {
- return TclDoGlob(interp, separators, headPtr, p);
+ return TclDoGlob(interp, separators, headPtr, p, types);
}
/*
@@ -1657,9 +2032,11 @@ TclDoGlob(interp, separators, headPtr, tail)
name = Tcl_DStringValue(headPtr);
if (TclpAccess(name, F_OK) == 0) {
if ((name[1] != '\0') && (strchr(name+1, ':') == NULL)) {
- Tcl_AppendElement(interp, name + 1);
+ Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
+ Tcl_NewStringObj(name + 1,-1));
} else {
- Tcl_AppendElement(interp, name);
+ Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
+ Tcl_NewStringObj(name,-1));
}
}
break;
@@ -1696,7 +2073,8 @@ TclDoGlob(interp, separators, headPtr, tail)
}
}
if (exists) {
- Tcl_AppendElement(interp, name);
+ Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
+ Tcl_NewStringObj(name,-1));
}
break;
}
@@ -1710,7 +2088,8 @@ TclDoGlob(interp, separators, headPtr, tail)
}
name = Tcl_DStringValue(headPtr);
if (TclpAccess(name, F_OK) == 0) {
- Tcl_AppendElement(interp, name);
+ Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
+ Tcl_NewStringObj(name,-1));
}
break;
}
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index f535e71..e649022 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: tclInt.decls,v 1.18 1999/12/02 02:03:25 redman Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.19 1999/12/12 22:46:42 hobbs Exp $
library tcl
@@ -73,7 +73,7 @@ declare 12 generic {
}
declare 13 generic {
int TclDoGlob(Tcl_Interp *interp, char *separators, \
- Tcl_DString *headPtr, char *tail)
+ Tcl_DString *headPtr, char *tail, GlobTypeData *types)
}
declare 14 generic {
void TclDumpMemoryInfo(FILE *outFile)
@@ -598,6 +598,10 @@ declare 158 generic {
declare 159 generic {
char *TclGetStartupScriptFileName(void)
}
+declare 160 generic {
+ int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, \
+ Tcl_DString *dirPtr, char *pattern, char *tail, GlobTypeData *types)
+}
##############################################################################
diff --git a/generic/tclInt.h b/generic/tclInt.h
index f96ae87..92f8985 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.38 1999/12/04 06:15:41 hobbs Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.39 1999/12/12 22:46:42 hobbs Exp $
*/
#ifndef _TCLINT
@@ -1480,6 +1480,41 @@ typedef int (*TclObjCmdProcType) _ANSI_ARGS_((ClientData clientData,
typedef struct TclpTime_t_ *TclpTime_t;
+/*
+ * The following structure is used to pass glob type data amongst
+ * the various glob routines and TclpMatchFilesTypes. Currently
+ * most of the fields are ignored. However they will be used in
+ * a future release to implement glob's ability to find files
+ * of particular types/permissions/etc only.
+ */
+typedef struct GlobTypeData {
+ /* Corresponds to bcdpfls as in 'find -t' */
+ int type;
+ /* Corresponds to file permissions */
+ int perm;
+ /* Acceptable mac type */
+ Tcl_Obj* macType;
+ /* Acceptable mac creator */
+ Tcl_Obj* macCreator;
+} GlobTypeData;
+
+/*
+ * type and permission definitions for glob command
+ */
+#define TCL_GLOB_TYPE_BLOCK (1<<0)
+#define TCL_GLOB_TYPE_CHAR (1<<1)
+#define TCL_GLOB_TYPE_DIR (1<<2)
+#define TCL_GLOB_TYPE_PIPE (1<<3)
+#define TCL_GLOB_TYPE_FILE (1<<4)
+#define TCL_GLOB_TYPE_LINK (1<<5)
+#define TCL_GLOB_TYPE_SOCK (1<<6)
+
+#define TCL_GLOB_PERM_RONLY (1<<0)
+#define TCL_GLOB_PERM_HIDDEN (1<<1)
+#define TCL_GLOB_PERM_R (1<<2)
+#define TCL_GLOB_PERM_W (1<<3)
+#define TCL_GLOB_PERM_X (1<<4)
+
/*
*----------------------------------------------------------------
* Variables shared among Tcl modules but not used by the outside world.
@@ -1570,7 +1605,7 @@ EXTERN void TclDeleteVars _ANSI_ARGS_((Interp *iPtr,
Tcl_HashTable *tablePtr));
EXTERN int TclDoGlob _ANSI_ARGS_((Tcl_Interp *interp,
char *separators, Tcl_DString *headPtr,
- char *tail));
+ char *tail, GlobTypeData *types));
EXTERN void TclDumpMemoryInfo _ANSI_ARGS_((FILE *outFile));
EXTERN void TclExpandTokenArray _ANSI_ARGS_((
Tcl_Parse *parsePtr));
@@ -1636,7 +1671,8 @@ EXTERN int TclGetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
EXTERN Tcl_Command TclGetOriginalCommand _ANSI_ARGS_((
Tcl_Command command));
EXTERN int TclGlob _ANSI_ARGS_((Tcl_Interp *interp,
- char *pattern, int noComplain));
+ char *pattern, char *unquotedPrefix,
+ int globFlags, GlobTypeData* types));
EXTERN int TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp *interp,
int argc, char **argv, int flags));
EXTERN int TclGuessPackageName _ANSI_ARGS_((char *fileName,
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 7e96fee..082066b 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIntDecls.h,v 1.18 1999/12/02 02:03:26 redman Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.19 1999/12/12 22:46:42 hobbs Exp $
*/
#ifndef _TCLINTDECLS
@@ -89,7 +89,7 @@ EXTERN void TclDeleteVars _ANSI_ARGS_((Interp * iPtr,
/* 13 */
EXTERN int TclDoGlob _ANSI_ARGS_((Tcl_Interp * interp,
char * separators, Tcl_DString * headPtr,
- char * tail));
+ char * tail, GlobTypeData * types));
/* 14 */
EXTERN void TclDumpMemoryInfo _ANSI_ARGS_((FILE * outFile));
/* Slot 15 is reserved */
@@ -524,6 +524,11 @@ EXTERN void TclSetStartupScriptFileName _ANSI_ARGS_((
char * filename));
/* 159 */
EXTERN char * TclGetStartupScriptFileName _ANSI_ARGS_((void));
+/* 160 */
+EXTERN int TclpMatchFilesTypes _ANSI_ARGS_((Tcl_Interp * interp,
+ char * separators, Tcl_DString * dirPtr,
+ char * pattern, char * tail,
+ GlobTypeData * types));
typedef struct TclIntStubs {
int magic;
@@ -558,7 +563,7 @@ typedef struct TclIntStubs {
int (*tclCreateProc) _ANSI_ARGS_((Tcl_Interp * interp, Namespace * nsPtr, char * procName, Tcl_Obj * argsPtr, Tcl_Obj * bodyPtr, Proc ** procPtrPtr)); /* 10 */
void (*tclDeleteCompiledLocalVars) _ANSI_ARGS_((Interp * iPtr, CallFrame * framePtr)); /* 11 */
void (*tclDeleteVars) _ANSI_ARGS_((Interp * iPtr, Tcl_HashTable * tablePtr)); /* 12 */
- int (*tclDoGlob) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * headPtr, char * tail)); /* 13 */
+ int (*tclDoGlob) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * headPtr, char * tail, GlobTypeData * types)); /* 13 */
void (*tclDumpMemoryInfo) _ANSI_ARGS_((FILE * outFile)); /* 14 */
void *reserved15;
void (*tclExprFloatError) _ANSI_ARGS_((Tcl_Interp * interp, double value)); /* 16 */
@@ -721,6 +726,7 @@ typedef struct TclIntStubs {
Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 157 */
void (*tclSetStartupScriptFileName) _ANSI_ARGS_((char * filename)); /* 158 */
char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */
+ int (*tclpMatchFilesTypes) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * dirPtr, char * pattern, char * tail, GlobTypeData * types)); /* 160 */
} TclIntStubs;
#ifdef __cplusplus
@@ -1370,6 +1376,10 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclGetStartupScriptFileName \
(tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */
#endif
+#ifndef TclpMatchFilesTypes
+#define TclpMatchFilesTypes \
+ (tclIntStubsPtr->tclpMatchFilesTypes) /* 160 */
+#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 23f916b..8a2f372 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStubInit.c,v 1.29 1999/12/02 02:03:27 redman Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.30 1999/12/12 22:46:43 hobbs Exp $
*/
#include "tclInt.h"
@@ -235,6 +235,7 @@ TclIntStubs tclIntStubs = {
TclVarTraceExists, /* 157 */
TclSetStartupScriptFileName, /* 158 */
TclGetStartupScriptFileName, /* 159 */
+ TclpMatchFilesTypes, /* 160 */
};
TclIntPlatStubs tclIntPlatStubs = {
generated by cgit v0.12 at 2024-11-10 00:59:19 (GMT)