]> git.zerfleddert.de Git - micropolis/blame - src/tcl/tclglob.c
fix colors on BGR displays
[micropolis] / src / tcl / tclglob.c
CommitLineData
6a5fa4e0
MG
1/*
2 * tclGlob.c --
3 *
4 * This file provides procedures and commands for file name
5 * manipulation, such as tilde expansion and globbing.
6 *
7 * Copyright 1990-1991 Regents of the University of California
8 * Permission to use, copy, modify, and distribute this
9 * software and its documentation for any purpose and without
10 * fee is hereby granted, provided that the above copyright
11 * notice appear in all copies. The University of California
12 * makes no representations about the suitability of this
13 * software for any purpose. It is provided "as is" without
14 * express or implied warranty.
15 */
16
17#ifndef lint
18static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclGlob.c,v 1.24 92/07/01 08:51:50 ouster Exp $ SPRITE (Berkeley)";
19#endif /* not lint */
20
21#include <sys/types.h>
22
23#include "tclint.h"
24#include "tclunix.h"
25
26void dvpath(char *);
27
28/*
29 * The structure below is used to keep track of a globbing result
30 * being built up (i.e. a partial list of file names). The list
31 * grows dynamically to be as big as needed.
32 */
33
34typedef struct {
35 char *result; /* Pointer to result area. */
36 int totalSpace; /* Total number of characters allocated
37 * for result. */
38 int spaceUsed; /* Number of characters currently in use
39 * to hold the partial result (not including
40 * the terminating NULL). */
41 int dynamic; /* 0 means result is static space, 1 means
42 * it's dynamic. */
43} GlobResult;
44
45/*
46 * Declarations for procedures local to this file:
47 */
48
49static void AppendResult _ANSI_ARGS_((Tcl_Interp *interp,
50 char *dir, char *separator, char *name,
51 int nameLength));
52static int DoGlob _ANSI_ARGS_((Tcl_Interp *interp, char *dir,
53 char *rem));
54\f
55/*
56 *----------------------------------------------------------------------
57 *
58 * AppendResult --
59 *
60 * Given two parts of a file name (directory and element within
61 * directory), concatenate the two together and append them to
62 * the result building up in interp.
63 *
64 * Results:
65 * There is no return value.
66 *
67 * Side effects:
68 * Interp->result gets extended.
69 *
70 *----------------------------------------------------------------------
71 */
72
73static void
74AppendResult(interp, dir, separator, name, nameLength)
75 Tcl_Interp *interp; /* Interpreter whose result should be
76 * appended to. */
77 char *dir; /* Name of directory, without trailing
78 * slash except for root directory. */
79 char *separator; /* Separator string so use between dir and
80 * name: either "/" or "" depending on dir. */
81 char *name; /* Name of file withing directory (NOT
82 * necessarily null-terminated!). */
83 int nameLength; /* Number of characters in name. */
84{
85 int dirFlags, nameFlags;
86 char *p, saved;
87
88 /*
89 * Next, see if we can put together a valid list element from dir
90 * and name by calling Tcl_AppendResult.
91 */
92
93 if (*dir == 0) {
94 dirFlags = 0;
95 } else {
96 Tcl_ScanElement(dir, &dirFlags);
97 }
98 saved = name[nameLength];
99 name[nameLength] = 0;
100 Tcl_ScanElement(name, &nameFlags);
101 if ((dirFlags == 0) && (nameFlags == 0)) {
102 if (*interp->result != 0) {
103 Tcl_AppendResult(interp, " ", dir, separator, name, (char *) NULL);
104 } else {
105 Tcl_AppendResult(interp, dir, separator, name, (char *) NULL);
106 }
107 name[nameLength] = saved;
108 return;
109 }
110
111 /*
112 * This name has weird characters in it, so we have to convert it to
113 * a list element. To do that, we have to merge the characters
114 * into a single name. To do that, malloc a buffer to hold everything.
115 */
116
117 p = (char *) ckalloc((unsigned) (strlen(dir) + strlen(separator)
118 + nameLength + 1));
119 sprintf(p, "%s%s%s", dir, separator, name);
120 name[nameLength] = saved;
121 Tcl_AppendElement(interp, p, 0);
122 ckfree(p);
123}
124\f
125/*
126 *----------------------------------------------------------------------
127 *
128 * DoGlob --
129 *
130 * This recursive procedure forms the heart of the globbing
131 * code. It performs a depth-first traversal of the tree
132 * given by the path name to be globbed.
133 *
134 * Results:
135 * The return value is a standard Tcl result indicating whether
136 * an error occurred in globbing. After a normal return the
137 * result in interp will be set to hold all of the file names
138 * given by the dir and rem arguments. After an error the
139 * result in interp will hold an error message.
140 *
141 * Side effects:
142 * None.
143 *
144 *----------------------------------------------------------------------
145 */
146
147static int
148DoGlob(interp, dir, rem)
149 Tcl_Interp *interp; /* Interpreter to use for error
150 * reporting (e.g. unmatched brace). */
151 char *dir; /* Name of a directory at which to
152 * start glob expansion. This name
153 * is fixed: it doesn't contain any
154 * globbing chars. */
155 char *rem; /* Path to glob-expand. */
156{
157 /*
158 * When this procedure is entered, the name to be globbed may
159 * already have been partly expanded by ancestor invocations of
160 * DoGlob. The part that's already been expanded is in "dir"
161 * (this may initially be empty), and the part still to expand
162 * is in "rem". This procedure expands "rem" one level, making
163 * recursive calls to itself if there's still more stuff left
164 * in the remainder.
165 */
166
167 register char *p;
168 register char c;
169 char *openBrace, *closeBrace;
170 int gotSpecial, result;
171 char *separator;
172
173 /*
174 * Figure out whether we'll need to add a slash between the directory
175 * name and file names within the directory when concatenating them
176 * together.
177 */
178
179 if ((dir[0] == 0) || ((dir[0] == '/') && (dir[1] == 0))) {
180 separator = "";
181 } else {
182 separator = "/";
183 }
184
185 /*
186 * When generating information for the next lower call,
187 * use static areas if the name is short, and malloc if the name
188 * is longer.
189 */
190
191#define STATIC_SIZE 200
192
193 /*
194 * First, find the end of the next element in rem, checking
195 * along the way for special globbing characters.
196 */
197
198 gotSpecial = 0;
199 openBrace = closeBrace = NULL;
200 for (p = rem; ; p++) {
201 c = *p;
202 if ((c == '\0') || (c == '/')) {
203 break;
204 }
205 if ((c == '{') && (openBrace == NULL)) {
206 openBrace = p;
207 }
208 if ((c == '}') && (closeBrace == NULL)) {
209 closeBrace = p;
210 }
211 if ((c == '*') || (c == '[') || (c == '\\') || (c == '?')) {
212 gotSpecial = 1;
213 }
214 }
215
216 /*
217 * If there is an open brace in the argument, then make a recursive
218 * call for each element between the braces. In this case, the
219 * recursive call to DoGlob uses the same "dir" that we got.
220 * If there are several brace-pairs in a single name, we just handle
221 * one here, and the others will be handled in recursive calls.
222 */
223
224 if (openBrace != NULL) {
225 int remLength, l1, l2;
226 char static1[STATIC_SIZE];
227 char *element, *newRem;
228
229 if (closeBrace == NULL) {
230 Tcl_ResetResult(interp);
231 interp->result = "unmatched open-brace in file name";
232 return TCL_ERROR;
233 }
234 remLength = strlen(rem) + 1;
235 if (remLength <= STATIC_SIZE) {
236 newRem = static1;
237 } else {
238 newRem = (char *) ckalloc((unsigned) remLength);
239 }
240 l1 = openBrace-rem;
241 strncpy(newRem, rem, l1);
242 p = openBrace;
243 for (p = openBrace; *p != '}'; ) {
244 element = p+1;
245 for (p = element; ((*p != '}') && (*p != ',')); p++) {
246 /* Empty loop body: just find end of this element. */
247 }
248 l2 = p - element;
249 strncpy(newRem+l1, element, l2);
250 strcpy(newRem+l1+l2, closeBrace+1);
251 if (DoGlob(interp, dir, newRem) != TCL_OK) {
252 return TCL_ERROR;
253 }
254 }
255 if (remLength > STATIC_SIZE) {
256 ckfree(newRem);
257 }
258 return TCL_OK;
259 }
260
261 /*
262 * If there were any pattern-matching characters, then scan through
263 * the directory to find all the matching names.
264 */
265
266 if (gotSpecial) {
267 DIR *d;
268 struct dirent *entryPtr;
269 int l1, l2;
270 char *pattern, *newDir, *dirName;
271 char static1[STATIC_SIZE], static2[STATIC_SIZE];
272 struct stat statBuf;
273
274 /*
275 * Be careful not to do any actual file system operations on a
276 * directory named ""; instead, use ".". This is needed because
277 * some versions of UNIX don't treat "" like "." automatically.
278 */
279
280 if (*dir == '\0') {
281 dirName = ".";
282 } else {
283 dirName = dir;
284 }
285 if ((stat(dirName, &statBuf) != 0)
286 || ((statBuf.st_mode & S_IFMT) != S_IFDIR)) {
287 return TCL_OK;
288 }
289 d = opendir(dirName);
290 if (d == NULL) {
291 Tcl_ResetResult(interp);
292 Tcl_AppendResult(interp, "couldn't read directory \"",
293 dirName, "\": ", Tcl_UnixError(interp), (char *) NULL);
294 return TCL_ERROR;
295 }
296 l1 = strlen(dir);
297 l2 = (p - rem);
298 if (l2 < STATIC_SIZE) {
299 pattern = static2;
300 } else {
301 pattern = (char *) ckalloc((unsigned) (l2+1));
302 }
303 strncpy(pattern, rem, l2);
304 pattern[l2] = '\0';
305 result = TCL_OK;
306 while (1) {
307 entryPtr = readdir(d);
308 if (entryPtr == NULL) {
309 break;
310 }
311
312 /*
313 * Don't match names starting with "." unless the "." is
314 * present in the pattern.
315 */
316
317 if ((*entryPtr->d_name == '.') && (*pattern != '.')) {
318 continue;
319 }
320 if (Tcl_StringMatch(entryPtr->d_name, pattern)) {
321 int nameLength = strlen(entryPtr->d_name);
322 if (*p == 0) {
323 AppendResult(interp, dir, separator, entryPtr->d_name,
324 nameLength);
325 } else {
326 if ((l1+nameLength+2) <= STATIC_SIZE) {
327 newDir = static1;
328 } else {
329 newDir = (char *) ckalloc((unsigned) (l1+nameLength+2));
330 }
331 sprintf(newDir, "%s%s%s", dir, separator, entryPtr->d_name);
332 result = DoGlob(interp, newDir, p+1);
333 if (newDir != static1) {
334 ckfree(newDir);
335 }
336 if (result != TCL_OK) {
337 break;
338 }
339 }
340 }
341 }
342 closedir(d);
343 if (pattern != static2) {
344 ckfree(pattern);
345 }
346 return result;
347 }
348
349 /*
350 * This is the simplest case: just another path element. Move
351 * it to the dir side and recurse (or just add the name to the
352 * list, if we're at the end of the path).
353 */
354
355 if (*p == 0) {
356 AppendResult(interp, dir, separator, rem, p-rem);
357 } else {
358 int l1, l2;
359 char *newDir;
360 char static1[STATIC_SIZE];
361
362 l1 = strlen(dir);
363 l2 = l1 + (p - rem) + 2;
364 if (l2 <= STATIC_SIZE) {
365 newDir = static1;
366 } else {
367 newDir = (char *) ckalloc((unsigned) l2);
368 }
369 sprintf(newDir, "%s%s%.*s", dir, separator, p-rem, rem);
370 result = DoGlob(interp, newDir, p+1);
371 if (newDir != static1) {
372 ckfree(newDir);
373 }
374 if (result != TCL_OK) {
375 return TCL_ERROR;
376 }
377 }
378 return TCL_OK;
379}
380\f
381/*
382 *----------------------------------------------------------------------
383 *
384 * Tcl_TildeSubst --
385 *
386 * Given a name starting with a tilde, produce a name where
387 * the tilde and following characters have been replaced by
388 * the home directory location for the named user.
389 *
390 * Results:
391 * The result is a pointer to a static string containing
392 * the new name. This name will only persist until the next
393 * call to Tcl_TildeSubst; save it if you care about it for
394 * the long term. If there was an error in processing the
395 * tilde, then an error message is left in interp->result
396 * and the return value is NULL.
397 *
398 * Side effects:
399 * None that the caller needs to worry about.
400 *
401 *----------------------------------------------------------------------
402 */
403
404char *
405Tcl_TildeSubst(interp, name)
406 Tcl_Interp *interp; /* Interpreter in which to store error
407 * message (if necessary). */
408 char *name; /* File name, which may begin with "~/"
409 * (to indicate current user's home directory)
410 * or "~<user>/" (to indicate any user's
411 * home directory). */
412{
413#define STATIC_BUF_SIZE 50
414 static char staticBuf[STATIC_BUF_SIZE];
415 static int curSize = STATIC_BUF_SIZE;
416 static char *curBuf = staticBuf;
417 char *dir;
418 int length;
419 int fromPw = 0;
420 register char *p;
421
422 if (name[0] != '~') {
423 return name;
424 }
425
426#ifdef MSDOS
427 dvpath(dir);
428 if (name[1] != '/') {
429 strcat(dir,"/");
430 p = name;
431 }
432 else
433 p = name +1;
434#else
435
436 /*
437 * First, find the directory name corresponding to the tilde entry.
438 */
439
440 if ((name[1] == '/') || (name[1] == '\0')) {
441 dir = getenv("HOME");
442 if (dir == NULL) {
443 Tcl_ResetResult(interp);
444 Tcl_AppendResult(interp, "couldn't find HOME environment ",
445 "variable to expand \"", name, "\"", (char *) NULL);
446 return NULL;
447 }
448 p = name+1;
449 } else {
450 struct passwd *pwPtr;
451
452 for (p = &name[1]; (*p != 0) && (*p != '/'); p++) {
453 /* Null body; just find end of name. */
454 }
455 length = p-&name[1];
456 if (length >= curSize) {
457 length = curSize-1;
458 }
459 memcpy((VOID *) curBuf, (VOID *) (name+1), length);
460 curBuf[length] = '\0';
461 pwPtr = getpwnam(curBuf);
462 if (pwPtr == NULL) {
463 Tcl_ResetResult(interp);
464 Tcl_AppendResult(interp, "user \"", curBuf,
465 "\" doesn't exist", (char *) NULL);
466 return NULL;
467 }
468 dir = pwPtr->pw_dir;
469 fromPw = 1;
470 }
471#endif
472
473 /*
474 * Grow the buffer if necessary to make enough space for the
475 * full file name.
476 */
477
478 length = strlen(dir) + strlen(p);
479 if (length >= curSize) {
480 if (curBuf != staticBuf) {
481 ckfree(curBuf);
482 }
483 curSize = length + 1;
484 curBuf = (char *) ckalloc((unsigned) curSize);
485 }
486
487 /*
488 * Finally, concatenate the directory name with the remainder
489 * of the path in the buffer.
490 */
491
492 strcpy(curBuf, dir);
493 strcat(curBuf, p);
494#ifndef MSDOS
495 if (fromPw) {
496 endpwent();
497 }
498#endif
499 return curBuf;
500}
501\f
502/*
503 *----------------------------------------------------------------------
504 *
505 * Tcl_GlobCmd --
506 *
507 * This procedure is invoked to process the "glob" Tcl command.
508 * See the user documentation for details on what it does.
509 *
510 * Results:
511 * A standard Tcl result.
512 *
513 * Side effects:
514 * See the user documentation.
515 *
516 *----------------------------------------------------------------------
517 */
518
519 /* ARGSUSED */
520int
521Tcl_GlobCmd(dummy, interp, argc, argv)
522 ClientData dummy; /* Not used. */
523 Tcl_Interp *interp; /* Current interpreter. */
524 int argc; /* Number of arguments. */
525 char **argv; /* Argument strings. */
526{
527 int i, result, noComplain;
528
529 if (argc < 2) {
530 notEnoughArgs:
531 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
532 " ?-nocomplain? name ?name ...?\"", (char *) NULL);
533 return TCL_ERROR;
534 }
535 noComplain = 0;
536 if ((argv[1][0] == '-') && (strcmp(argv[1], "-nocomplain") == 0)) {
537 if (argc < 3) {
538 goto notEnoughArgs;
539 }
540 noComplain = 1;
541 }
542
543 for (i = 1 + noComplain; i < argc; i++) {
544 char *thisName;
545
546 /*
547 * Do special checks for names starting at the root and for
548 * names beginning with ~. Then let DoGlob do the rest.
549 */
550
551 thisName = argv[i];
552 if (*thisName == '~') {
553 thisName = Tcl_TildeSubst(interp, thisName);
554 if (thisName == NULL) {
555 return TCL_ERROR;
556 }
557 }
558 if (*thisName == '/') {
559 result = DoGlob(interp, "/", thisName+1);
560 } else {
561 result = DoGlob(interp, "", thisName);
562 }
563 if (result != TCL_OK) {
564 return result;
565 }
566 }
567 if ((*interp->result == 0) && !noComplain) {
568 char *sep = "";
569
570 Tcl_AppendResult(interp, "no files matched glob pattern",
571 (argc == 2) ? " \"" : "s \"", (char *) NULL);
572 for (i = 1; i < argc; i++) {
573 Tcl_AppendResult(interp, sep, argv[i], (char *) NULL);
574 sep = " ";
575 }
576 Tcl_AppendResult(interp, "\"", (char *) NULL);
577 return TCL_ERROR;
578 }
579 return TCL_OK;
580}
Impressum, Datenschutz