![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tclUtil.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / worm / scsi / tcl|
Return to tclUtil.c CVS log | Up to [Research Unix] / researchv10no / cmd / worm / scsi / tcl |
1.1 root 1: /*
2: * tclUtil.c --
3: *
4: * This file contains utility procedures that are used by many Tcl
5: * commands.
6: *
7: * Copyright 1987, 1989 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
18: static char rcsid[] = "$Header: /sprite/src/lib/tcl/RCS/tclUtil.c,v 1.30 90/03/25 11:04:25 ouster Exp $ SPRITE (Berkeley)";
19: #pragma ref rcsid
20: #endif not lint
21:
22: #define _POSIX_SOURCE
23:
24: #include <ctype.h>
25: #include <stdio.h>
26: #include <stdlib.h>
27: #include <string.h>
28: #include "tcl.h"
29: #include "tclInt.h"
30:
31: /*
32: *----------------------------------------------------------------------
33: *
34: * TclFindElement --
35: *
36: * Given a pointer into a Tcl list, locate the first (or next)
37: * element in the list.
38: *
39: * Results:
40: * The return value is normally TCL_OK, which means that the
41: * element was successfully located. If TCL_ERROR is returned
42: * it means that list didn't have proper list structure;
43: * interp->result contains a more detailed error message.
44: *
45: * If TCL_OK is returned, then *elementPtr will be set to point
46: * to the first element of list, and *nextPtr will be set to point
47: * to the character just after any white space following the last
48: * character that's part of the element. If this is the last argument
49: * in the list, then *nextPtr will point to the NULL character at the
50: * end of list. If sizePtr is non-NULL, *sizePtr is filled in with
51: * the number of characters in the element. If the element is in
52: * braces, then *elementPtr will point to the character after the
53: * opening brace and *sizePtr will not include either of the braces.
54: * If there isn't an element in the list, *sizePtr will be zero, and
55: * both *elementPtr and *termPtr will refer to the null character at
56: * the end of list. Note: this procedure does NOT collapse backslash
57: * sequences.
58: *
59: * Side effects:
60: * None.
61: *
62: *----------------------------------------------------------------------
63: */
64:
65: int
66: TclFindElement(interp, list, elementPtr, nextPtr, sizePtr, bracePtr)
67: Tcl_Interp *interp; /* Interpreter to use for error reporting. */
68: register char *list; /* String containing Tcl list with zero
69: * or more elements (possibly in braces). */
70: char **elementPtr; /* Fill in with location of first significant
71: * character in first element of list. */
72: char **nextPtr; /* Fill in with location of character just
73: * after all white space following end of
74: * argument (i.e. next argument or end of
75: * list). */
76: int *sizePtr; /* If non-zero, fill in with size of
77: * element. */
78: int *bracePtr; /* If non-zero fill in with non-zero/zero
79: * to indicate that arg was/wasn't
80: * in braces. */
81: {
82: register char *p;
83: int openBraces = 0;
84: int size;
85:
86: /*
87: * Skim off leading white space and check for an opening brace.
88: */
89:
90: while (isspace(*list)) {
91: list++;
92: }
93: if (*list == '{') {
94: openBraces = 1;
95: list++;
96: }
97: if (bracePtr != 0) {
98: *bracePtr = openBraces;
99: }
100: p = list;
101:
102: /*
103: * Find the end of the element (either a space or a close brace or
104: * the end of the string).
105: */
106:
107: while (1) {
108: switch (*p) {
109:
110: /*
111: * Open brace: don't treat specially unless the element is
112: * in braces. In this case, keep a nesting count.
113: */
114:
115: case '{':
116: if (openBraces != 0) {
117: openBraces++;
118: }
119: break;
120:
121: /*
122: * Close brace: if element is in braces, keep nesting
123: * count and quit when the last close brace is seen.
124: */
125:
126: case '}':
127: if (openBraces == 1) {
128: char *p2;
129:
130: size = p - list;
131: p++;
132: if (isspace(*p) || (*p == 0)) {
133: goto done;
134: }
135: for (p2 = p; (*p2 != 0) && (!isspace(*p2)) && (p2 < p+20);
136: p2++) {
137: /* null body */
138: }
139: Tcl_Return(interp, (char *) NULL, TCL_STATIC);
140: sprintf(interp->result,
141: "list element in braces followed by \"%.*s\" instead of space",
142: p2-p, p);
143: return TCL_ERROR;
144: } else if (openBraces != 0) {
145: openBraces--;
146: }
147: break;
148:
149: /*
150: * Backslash: skip over everything up to the end of the
151: * backslash sequence.
152: */
153:
154: case '\\': {
155: int size;
156:
157: (void) Tcl_Backslash(p, &size);
158: p += size - 1;
159: break;
160: }
161:
162: /*
163: * Space: ignore if element is in braces; otherwise
164: * terminate element.
165: */
166:
167: case ' ':
168: case '\t':
169: case '\n':
170: if (openBraces == 0) {
171: size = p - list;
172: goto done;
173: }
174: break;
175:
176: /*
177: * End of list: terminate element.
178: */
179:
180: case 0:
181: if (openBraces != 0) {
182: Tcl_Return(interp, "unmatched open brace in list",
183: TCL_STATIC);
184: return TCL_ERROR;
185: }
186: size = p - list;
187: goto done;
188:
189: }
190: p++;
191: }
192:
193: done:
194: while (isspace(*p)) {
195: p++;
196: }
197: *elementPtr = list;
198: *nextPtr = p;
199: if (sizePtr != 0) {
200: *sizePtr = size;
201: }
202: return TCL_OK;
203: }
204:
205: /*
206: *----------------------------------------------------------------------
207: *
208: * TclCopyAndCollapse --
209: *
210: * Copy a string and eliminate any backslashes that aren't in braces.
211: *
212: * Results:
213: * There is no return value. Count chars. get copied from src
214: * to dst. Along the way, if backslash sequences are found outside
215: * braces, the backslashes are eliminated in the copy.
216: * After scanning count chars. from source, a null character is
217: * placed at the end of dst.
218: *
219: * Side effects:
220: * None.
221: *
222: *----------------------------------------------------------------------
223: */
224:
225: void
226: TclCopyAndCollapse(count, src, dst)
227: register char *src; /* Copy from here... */
228: register char *dst; /* ... to here. */
229: {
230: register char c;
231: int numRead;
232:
233: for (c = *src; count > 0; dst++, src++, c = *src, count--) {
234: if (c == '\\') {
235: *dst = Tcl_Backslash(src, &numRead);
236: src += numRead-1;
237: count -= numRead-1;
238: } else {
239: *dst = c;
240: }
241: }
242: *dst = 0;
243: }
244:
245: /*
246: *----------------------------------------------------------------------
247: *
248: * Tcl_Merge --
249: *
250: * Given a collection of strings, merge them together into a
251: * single string that has proper Tcl list structured (i.e.
252: * TclFindElement and TclCopyAndCollapse may be used to retrieve
253: * strings equal to the original elements, and Tcl_Eval will
254: * parse the string back into its original elements).
255: *
256: * Results:
257: * The return value is the address of a dynamically-allocated
258: * string containing the merged list.
259: *
260: * Side effects:
261: * None.
262: *
263: *----------------------------------------------------------------------
264: */
265:
266: char *
267: Tcl_Merge(argc, argv)
268: int argc; /* How many strings to merge. */
269: char **argv; /* Array of string values. */
270: {
271: /*
272: * This procedure operates in two passes. In the first pass it figures
273: * out how many bytes will be needed to store the result (actually,
274: * it overestimates slightly). The first pass also collects information
275: * about each element in the form of a flags word. If there are only
276: * a few elements, local storage gets used for the flags; if there are
277: * a lot of elements, a new array is dynamically allocated.
278: *
279: * In the second pass this procedure copies the arguments into the
280: * result string. The special cases to worry about are:
281: *
282: * 1. Argument contains embedded spaces, or starts with a brace: must
283: * add another level of braces when copying to the result.
284: *
285: * 2. Argument contains unbalanced braces: backslash all of the
286: * braces when copying to the result. In this case, don't add another
287: * level of braces (they would prevent the backslash from
288: * being removed when the argument is extracted from the list later).
289: *
290: * 3. Argument contains backslashed brace/bracket: if possible,
291: * group the argument in braces: then no special action needs to be taken
292: * with the backslashes. If the argument can't be put in braces, then
293: * add another backslash in front of the sequence, so that upon
294: * extraction the original sequence will be restored.
295: *
296: * These potential problems are the reasons why particular information
297: * is gathered during pass 1.
298: */
299: # define WANT_PARENS 1
300: # define PARENS_UNBALANCED 2
301: # define PARENTHESIZED 4
302: # define CANT_PARENTHESIZE 8
303:
304: # define LOCAL_SIZE 20
305: int localFlags[LOCAL_SIZE];
306: int *flagPtr;
307: int numChars;
308: char *result;
309: register char *src, *dst;
310: register int curFlags;
311: int i;
312:
313: /*
314: * Pass 1: estimate space, gather information.
315: */
316:
317: if (argc <= LOCAL_SIZE) {
318: flagPtr = localFlags;
319: } else {
320: flagPtr = (int *) malloc((unsigned) argc*sizeof(int));
321: }
322: numChars = 0;
323: for (i = 0; i < argc; i++) {
324: int braceCount, nestingLevel, nestedBS, whiteSpace, brackets, dollars;
325:
326: curFlags = braceCount = nestingLevel = nestedBS = whiteSpace = 0;
327: brackets = dollars = 0;
328: src = argv[i];
329: if (*src == '{') {
330: curFlags |= PARENTHESIZED|WANT_PARENS;
331: }
332: if (*src == 0) {
333: curFlags |= WANT_PARENS;
334: } else {
335: for (; ; src++) {
336: switch (*src) {
337: case '{':
338: braceCount++;
339: nestingLevel++;
340: break;
341: case '}':
342: braceCount++;
343: nestingLevel--;
344: break;
345: case ']':
346: case '[':
347: curFlags |= WANT_PARENS;
348: brackets++;
349: break;
350: case '$':
351: curFlags |= WANT_PARENS;
352: dollars++;
353: break;
354: case ' ':
355: case '\n':
356: case '\t':
357: curFlags |= WANT_PARENS;
358: whiteSpace++;
359: break;
360: case '\\':
361: src++;
362: if (*src == 0) {
363: goto elementDone;
364: } else if ((*src == '{') || (*src == '}')
365: || (*src == '[') || (*src == ']')) {
366: curFlags |= WANT_PARENS;
367: nestedBS++;
368: }
369: break;
370: case 0:
371: goto elementDone;
372: }
373: }
374: }
375: elementDone:
376: numChars += src - argv[i];
377: if (nestingLevel != 0) {
378: numChars += braceCount + nestedBS + whiteSpace
379: + brackets + dollars;
380: curFlags = CANT_PARENTHESIZE;
381: }
382: if (curFlags & WANT_PARENS) {
383: numChars += 2;
384: }
385: numChars++; /* Space to separate arguments. */
386: flagPtr[i] = curFlags;
387: }
388:
389: /*
390: * Pass two: copy into the result area.
391: */
392:
393: result = (char *) malloc((unsigned) numChars + 1);
394: dst = result;
395: for (i = 0; i < argc; i++) {
396: curFlags = flagPtr[i];
397: if (curFlags & WANT_PARENS) {
398: *dst = '{';
399: dst++;
400: }
401: for (src = argv[i]; *src != 0 ; src++) {
402: if (curFlags & CANT_PARENTHESIZE) {
403: switch (*src) {
404: case '{':
405: case '}':
406: case ']':
407: case '[':
408: case '$':
409: case ' ':
410: *dst = '\\';
411: dst++;
412: break;
413: case '\n':
414: *dst = '\\';
415: dst++;
416: *dst = 'n';
417: goto loopBottom;
418: case '\t':
419: *dst = '\\';
420: dst++;
421: *dst = 't';
422: goto loopBottom;
423: case '\\':
424: *dst = '\\';
425: dst++;
426: src++;
427: if ((*src == '{') || (*src == '}') || (*src == '[')
428: || (*src == ']')) {
429: *dst = '\\';
430: dst++;
431: } else if (*src == 0) {
432: goto pass2ElementDone;
433: }
434: break;
435: }
436: }
437: *dst = *src;
438: loopBottom:
439: dst++;
440: }
441: pass2ElementDone:
442: if (curFlags & WANT_PARENS) {
443: *dst = '}';
444: dst++;
445: }
446: *dst = ' ';
447: dst++;
448: }
449: if (dst == result) {
450: *dst = 0;
451: } else {
452: dst[-1] = 0;
453: }
454:
455: if (flagPtr != localFlags) {
456: free((char *) flagPtr);
457: }
458: return result;
459: }
460:
461: /*
462: *----------------------------------------------------------------------
463: *
464: * Tcl_Concat --
465: *
466: * Concatenate a set of strings into a single large string.
467: *
468: * Results:
469: * The return value is dynamically-allocated string containing
470: * a concatenation of all the strings in argv, with spaces between
471: * the original argv elements.
472: *
473: * Side effects:
474: * Memory is allocated for the result; the caller is responsible
475: * for freeing the memory.
476: *
477: *----------------------------------------------------------------------
478: */
479:
480: char *
481: Tcl_Concat(argc, argv)
482: int argc; /* Number of strings to concatenate. */
483: char **argv; /* Array of strings to concatenate. */
484: {
485: int totalSize, i;
486: register char *p;
487: char *result;
488:
489: for (totalSize = 1, i = 0; i < argc; i++) {
490: totalSize += strlen(argv[i]) + 1;
491: }
492: result = malloc((unsigned) totalSize);
493: for (p = result, i = 0; i < argc; i++) {
494: (void) strcpy(p, argv[i]);
495: p += strlen(argv[i]);
496: *p = ' ';
497: p++;
498: }
499: p[-1] = 0;
500: return result;
501: }
502:
503: /*
504: *----------------------------------------------------------------------
505: *
506: * Tcl_Return --
507: *
508: * Arrange for "string" to be the Tcl return value.
509: *
510: * Results:
511: * None.
512: *
513: * Side effects:
514: * interp->result is left pointing either to "string" (if "copy" is 0)
515: * or to a copy of string.
516: *
517: *----------------------------------------------------------------------
518: */
519:
520: void
521: Tcl_Return(interp, string, status)
522: Tcl_Interp *interp; /* Interpreter with which to associate the
523: * return value. */
524: char *string; /* Value to be returned. If NULL,
525: * the result is set to an empty string. */
526: int status; /* Gives information about the string:
527: * TCL_STATIC, TCL_DYNAMIC, TCL_VOLATILE.
528: * Ignored if string is NULL. */
529: {
530: register Interp *iPtr = (Interp *) interp;
531: int length;
532: int wasDynamic = iPtr->dynamic;
533: char *oldResult = iPtr->result;
534:
535: if (string == NULL) {
536: iPtr->resultSpace[0] = 0;
537: iPtr->result = iPtr->resultSpace;
538: iPtr->dynamic = 0;
539: } else if (status == TCL_STATIC) {
540: iPtr->result = string;
541: iPtr->dynamic = 0;
542: } else if (status == TCL_DYNAMIC) {
543: iPtr->result = string;
544: iPtr->dynamic = 1;
545: } else {
546: length = strlen(string);
547: if (length > TCL_RESULT_SIZE) {
548: iPtr->result = (char *) malloc((unsigned) length+1);
549: iPtr->dynamic = 1;
550: } else {
551: iPtr->result = iPtr->resultSpace;
552: iPtr->dynamic = 0;
553: }
554: strcpy(iPtr->result, string);
555: }
556:
557: /*
558: * If the old result was dynamically-allocated, free it up. Do it
559: * here, rather than at the beginning, in case the new result value
560: * was part of the old result value.
561: */
562:
563: if (wasDynamic) {
564: free(oldResult);
565: }
566: }
567:
568: /*
569: *----------------------------------------------------------------------
570: *
571: * Tcl_Backslash --
572: *
573: * Figure out how to handle a backslash sequence.
574: *
575: * Results:
576: * The return value is the character that should be substituted
577: * in place of the backslash sequence that starts at src. If
578: * readPtr isn't NULL then it is filled in with a count of the
579: * number of characters in the backslash sequence. Note: if
580: * the backslash isn't followed by characters that are understood
581: * here, then the backslash sequence is only considered to be
582: * one character long, and it is replaced by a backslash char.
583: *
584: * Side effects:
585: * None.
586: *
587: *----------------------------------------------------------------------
588: */
589:
590: char
591: Tcl_Backslash(src, readPtr)
592: char *src; /* Points to the backslash character of
593: * a backslash sequence. */
594: int *readPtr; /* Fill in with number of characters read
595: * from src, unless NULL. */
596: {
597: register char *p = src+1;
598: char result;
599: int count;
600:
601: count = 2;
602:
603: switch (*p) {
604: case 'b':
605: result = '\b';
606: break;
607: case 'e':
608: result = 033;
609: break;
610: case 'n':
611: result = '\n';
612: break;
613: case 'r':
614: result = '\r';
615: break;
616: case 't':
617: result = '\t';
618: break;
619: case 'C':
620: p++;
621: if (isspace(*p) || (*p == 0)) {
622: result = 'C';
623: count = 1;
624: break;
625: }
626: count = 3;
627: if (*p == 'M') {
628: p++;
629: if (isspace(*p) || (*p == 0)) {
630: result = 'M' & 037;
631: break;
632: }
633: count = 4;
634: result = (*p & 037) | 0200;
635: break;
636: }
637: count = 3;
638: result = *p & 037;
639: break;
640: case 'M':
641: p++;
642: if (isspace(*p) || (*p == 0)) {
643: result = 'M';
644: count = 1;
645: break;
646: }
647: count = 3;
648: result = *p + 0200;
649: break;
650: case '}':
651: case '{':
652: case ']':
653: case '[':
654: case '$':
655: case ' ':
656: case ';':
657: case '"':
658: case '\\':
659: result = *p;
660: break;
661: default:
662: if (isdigit(*p)) {
663: result = *p - '0';
664: p++;
665: if (!isdigit(*p)) {
666: break;
667: }
668: count = 3;
669: result = (result << 3) + (*p - '0');
670: p++;
671: if (!isdigit(*p)) {
672: break;
673: }
674: count = 4;
675: result = (result << 3) + (*p - '0');
676: break;
677: }
678: result = '\\';
679: count = 1;
680: break;
681: }
682:
683: if (readPtr != NULL) {
684: *readPtr = count;
685: }
686: return result;
687: }
688:
689: /*
690: *----------------------------------------------------------------------
691: *
692: * Tcl_SplitList --
693: *
694: * Splits a list up into its constituent fields.
695: *
696: * Results
697: * The return value is normally TCL_OK, which means that
698: * the list was successfully split up. If TCL_ERROR is
699: * returned, it means that "list" didn't have proper list
700: * structure; interp->result will contain a more detailed
701: * error message.
702: *
703: * *argvPtr will be filled in with the address of an array
704: * whose elements point to the elements of list, in order.
705: * *argcPtr will get filled in with the number of valid elements
706: * in the array. A single block of memory is dynamically allocated
707: * to hold both the argv array and a copy of the list (with
708: * backslashes and braces removed in the standard way).
709: * The caller must eventually free this memory by calling free()
710: * on *argvPtr. Note: *argvPtr and *argcPtr are only modified
711: * if the procedure returns normally.
712: *
713: * Side effects:
714: * Memory is allocated.
715: *
716: *----------------------------------------------------------------------
717: */
718:
719: int
720: Tcl_SplitList(interp, list, argcPtr, argvPtr)
721: Tcl_Interp *interp; /* Interpreter to use for error reporting. */
722: char *list; /* Pointer to string with list structure. */
723: int *argcPtr; /* Pointer to location to fill in with
724: * the number of elements in the list. */
725: char ***argvPtr; /* Pointer to place to store pointer to array
726: * of pointers to list elements. */
727: {
728: char **argv;
729: register char *p;
730: int size, i, result, elSize, brace;
731: char *element;
732:
733: /*
734: * Figure out how much space to allocate. There must be enough
735: * space for both the array of pointers and also for a copy of
736: * the list. To estimate the number of pointers needed, count
737: * the number of space characters in the list.
738: */
739:
740: for (size = 1, p = list; *p != 0; p++) {
741: if (isspace(*p)) {
742: size++;
743: }
744: }
745: argv = (char **) malloc((unsigned)
746: ((size * sizeof(char *)) + (p - list) + 1));
747: for (i = 0, p = ((char *) argv) + size*sizeof(char *);
748: *list != 0; i++) {
749: result = TclFindElement(interp, list, &element, &list, &elSize, &brace);
750: if (result != TCL_OK) {
751: free((char *) argv);
752: return result;
753: }
754: if (*element == 0) {
755: break;
756: }
757: if (i >= size) {
758: Tcl_Return(interp, "internal error in Tcl_SplitList", TCL_STATIC);
759: return TCL_ERROR;
760: }
761: argv[i] = p;
762: if (brace) {
763: strncpy(p, element, elSize);
764: p += elSize;
765: *p = 0;
766: p++;
767: } else {
768: TclCopyAndCollapse(elSize, element, p);
769: p += elSize+1;
770: }
771: }
772:
773: *argvPtr = argv;
774: *argcPtr = i;
775: return TCL_OK;
776: }
777:
778: /*
779: *----------------------------------------------------------------------
780: *
781: * Tcl_StringMatch --
782: *
783: * See if a particular string matches a particular pattern.
784: *
785: * Results:
786: * The return value is 1 if string matches pattern, and
787: * 0 otherwise. The matching operation permits the following
788: * special characters in the pattern: *?\[] (see the manual
789: * entry for details on what these mean).
790: *
791: * Side effects:
792: * None.
793: *
794: *----------------------------------------------------------------------
795: */
796:
797: int
798: Tcl_StringMatch(string, pattern)
799: register char *string; /* String. */
800: register char *pattern; /* Pattern, which may contain
801: * special characters. */
802: {
803: char c2;
804:
805: while (1) {
806: /* See if we're at the end of both the pattern and the string.
807: * If so, we succeeded. If we're at the end of the pattern
808: * but not at the end of the string, we failed.
809: */
810:
811: if (*pattern == 0) {
812: if (*string == 0) {
813: return 1;
814: } else {
815: return 0;
816: }
817: }
818: if ((*string == 0) && (*pattern != '*')) {
819: return 0;
820: }
821:
822: /* Check for a "*" as the next pattern character. It matches
823: * any substring. We handle this by calling ourselves
824: * recursively for each postfix of string, until either we
825: * match or we reach the end of the string.
826: */
827:
828: if (*pattern == '*') {
829: pattern += 1;
830: if (*pattern == 0) {
831: return 1;
832: }
833: while (*string != 0) {
834: if (Tcl_StringMatch(string, pattern)) {
835: return 1;
836: }
837: string += 1;
838: }
839: return 0;
840: }
841:
842: /* Check for a "?" as the next pattern character. It matches
843: * any single character.
844: */
845:
846: if (*pattern == '?') {
847: goto thisCharOK;
848: }
849:
850: /* Check for a "[" as the next pattern character. It is followed
851: * by a list of characters that are acceptable, or by a range
852: * (two characters separated by "-").
853: */
854:
855: if (*pattern == '[') {
856: pattern += 1;
857: while (1) {
858: if ((*pattern == ']') || (*pattern == 0)) {
859: return 0;
860: }
861: if (*pattern == *string) {
862: break;
863: }
864: if (pattern[1] == '-') {
865: c2 = pattern[2];
866: if (c2 == 0) {
867: return 0;
868: }
869: if ((*pattern <= *string) && (c2 >= *string)) {
870: break;
871: }
872: if ((*pattern >= *string) && (c2 <= *string)) {
873: break;
874: }
875: pattern += 2;
876: }
877: pattern += 1;
878: }
879: while ((*pattern != ']') && (*pattern != 0)) {
880: pattern += 1;
881: }
882: goto thisCharOK;
883: }
884:
885: /* If the next pattern character is '/', just strip off the '/'
886: * so we do exact matching on the character that follows.
887: */
888:
889: if (*pattern == '\\') {
890: pattern += 1;
891: if (*pattern == 0) {
892: return 0;
893: }
894: }
895:
896: /* There's no special character. Just make sure that the next
897: * characters of each string match.
898: */
899:
900: if (*pattern != *string) {
901: return 0;
902: }
903:
904: thisCharOK: pattern += 1;
905: string += 1;
906: }
907: }
908:
909: /*
910: *----------------------------------------------------------------------
911: *
912: * TclWordEnd --
913: *
914: * Given a pointer into a Tcl command, find the end of the next
915: * word of the command.
916: *
917: * Results:
918: * The return value is a pointer to the character just after the
919: * last one that's part of the word pointed to by "start". This
920: * may be the address of the NULL character at the end of the
921: * string.
922: *
923: * Side effects:
924: * None.
925: *
926: *----------------------------------------------------------------------
927: */
928:
929: char *
930: TclWordEnd(start, nested)
931: char *start; /* Beginning of a word of a Tcl command. */
932: int nested; /* Zero means this is a top-level command.
933: * One means this is a nested command (close
934: * brace is a word terminator). */
935: {
936: register char *p;
937: int count;
938:
939: p = start;
940: while (isspace(*p)) {
941: p++;
942: }
943:
944: /*
945: * Handle words beginning with a double-quote or a brace.
946: */
947:
948: if (*p == '"') {
949: while (1) {
950: p++;
951: while (*p == '\\') {
952: (void) Tcl_Backslash(p, &count);
953: p += count;
954: }
955: if (*p == '"') {
956: break;
957: }
958: }
959: } else if (*p == '{') {
960: int braces = 1;
961: while (braces != 0) {
962: p++;
963: while (*p == '\\') {
964: (void) Tcl_Backslash(p, &count);
965: p += count;
966: }
967: if (*p == '}') {
968: braces--;
969: } else if (*p == '{') {
970: braces++;
971: } else if (*p == 0) {
972: return p;
973: }
974: }
975: }
976:
977: /*
978: * Handle words that don't start with a brace or double-quote.
979: * This code is also invoked if the word starts with a brace or
980: * double-quote and there is garbage after the closing brace or
981: * quote. This is an error as far as Tcl_Eval is concerned, but
982: * for here the garbage is treated as part of the word.
983: */
984:
985: while (1) {
986:
987: /*
988: * Handle nested commands.
989: */
990:
991: while (*p == '[') {
992: p++;
993: while ((*p != ']') && (*p != 0)) {
994: p = TclWordEnd(p, 1);
995: if (*p == ';') {
996: p++;
997: }
998: }
999: if (*p == ']') {
1000: p++;
1001: }
1002: }
1003:
1004: /*
1005: * Handle backslash sequences. Backslash-newline isn't handled
1006: * by Tcl_Backslash, so it must be checked for explicitly.
1007: */
1008:
1009: while (*p == '\\') {
1010: if (p[1] == '\n') {
1011: p += 2;
1012: } else {
1013: (void) Tcl_Backslash(p, &count);
1014: p += count;
1015: }
1016: }
1017:
1018: /*
1019: * Check for end of word. Note: semi-colon terminates a word
1020: * and also counts as a word by itself.
1021: */
1022:
1023: if (*p == ';') {
1024: if (p == start) {
1025: p++;
1026: }
1027: break;
1028: }
1029: if (isspace(*p) || (*p == 0)) {
1030: break;
1031: }
1032: if ((*p == ']') && nested) {
1033: break;
1034: }
1035:
1036: p++;
1037: }
1038: return p;
1039: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.