![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tclparse.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Micropolis - Activity] / micropolis / src / tcl|
Return to tclparse.c CVS log | Up to [Micropolis - Activity] / micropolis / src / tcl |
1.1 root 1: /*
2: * tclParse.c --
3: *
4: * This file contains a collection of procedures that are used
5: * to parse Tcl commands or parts of commands (like quoted
6: * strings or nested sub-commands).
7: *
8: * Copyright 1991 Regents of the University of California.
9: * Permission to use, copy, modify, and distribute this
10: * software and its documentation for any purpose and without
11: * fee is hereby granted, provided that the above copyright
12: * notice appear in all copies. The University of California
13: * makes no representations about the suitability of this
14: * software for any purpose. It is provided "as is" without
15: * express or implied warranty.
16: */
17:
18: #ifndef lint
19: static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclParse.c,v 1.21 92/06/08 09:32:37 ouster Exp $ SPRITE (Berkeley)";
20: #endif
21:
22: #include "tclint.h"
23:
24: /*
25: * The following table assigns a type to each character. Only types
26: * meaningful to Tcl parsing are represented here. The table indexes
27: * all 256 characters, with the negative ones first, then the positive
28: * ones.
29: */
30:
31: char tclTypeTable[] = {
32: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
33: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
34: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
35: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
36: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
37: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
38: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
39: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
40: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
41: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
42: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
43: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
44: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
45: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
46: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
47: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
48: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
49: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
50: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
51: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
52: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
53: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
54: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
55: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
56: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
57: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
58: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
59: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
60: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
61: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
62: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
63: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
64: TCL_COMMAND_END, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
65: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
66: TCL_NORMAL, TCL_SPACE, TCL_COMMAND_END, TCL_SPACE,
67: TCL_SPACE, TCL_SPACE, TCL_NORMAL, TCL_NORMAL,
68: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
69: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
70: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
71: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
72: TCL_SPACE, TCL_NORMAL, TCL_QUOTE, TCL_NORMAL,
73: TCL_DOLLAR, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
74: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
75: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
76: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
77: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
78: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_COMMAND_END,
79: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
80: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
81: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
82: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
83: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
84: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
85: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
86: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_OPEN_BRACKET,
87: TCL_BACKSLASH, TCL_COMMAND_END, TCL_NORMAL, TCL_NORMAL,
88: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
89: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
90: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
91: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
92: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
93: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
94: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_OPEN_BRACE,
95: TCL_NORMAL, TCL_CLOSE_BRACE, TCL_NORMAL, TCL_NORMAL,
96: };
97:
98: /*
99: * Function prototypes for procedures local to this file:
100: */
101:
102: static char * QuoteEnd _ANSI_ARGS_((char *string, int term));
103: static char * VarNameEnd _ANSI_ARGS_((char *string));
104:
105: /*
106: *----------------------------------------------------------------------
107: *
108: * Tcl_Backslash --
109: *
110: * Figure out how to handle a backslash sequence.
111: *
112: * Results:
113: * The return value is the character that should be substituted
114: * in place of the backslash sequence that starts at src, or 0
115: * if the backslash sequence should be replace by nothing (e.g.
116: * backslash followed by newline). If readPtr isn't NULL then
117: * it is filled in with a count of the number of characters in
118: * the backslash sequence. Note: if the backslash isn't followed
119: * by characters that are understood here, then the backslash
120: * sequence is only considered to be one character long, and it
121: * is replaced by a backslash char.
122: *
123: * Side effects:
124: * None.
125: *
126: *----------------------------------------------------------------------
127: */
128:
129: char
130: Tcl_Backslash(src, readPtr)
131: char *src; /* Points to the backslash character of
132: * a backslash sequence. */
133: int *readPtr; /* Fill in with number of characters read
134: * from src, unless NULL. */
135: {
136: register char *p = src+1;
137: char result;
138: int count;
139:
140: count = 2;
141:
142: switch (*p) {
143: case 'b':
144: result = '\b';
145: break;
146: case 'e':
147: result = 033;
148: break;
149: case 'f':
150: result = '\f';
151: break;
152: case 'n':
153: result = '\n';
154: break;
155: case 'r':
156: result = '\r';
157: break;
158: case 't':
159: result = '\t';
160: break;
161: case 'v':
162: result = '\v';
163: break;
164: case 'C':
165: p++;
166: if (isspace(*p) || (*p == 0)) {
167: result = 'C';
168: count = 1;
169: break;
170: }
171: count = 3;
172: if (*p == 'M') {
173: p++;
174: if (isspace(*p) || (*p == 0)) {
175: result = 'M' & 037;
176: break;
177: }
178: count = 4;
179: result = (*p & 037) | 0200;
180: break;
181: }
182: count = 3;
183: result = *p & 037;
184: break;
185: case 'M':
186: p++;
187: if (isspace(*p) || (*p == 0)) {
188: result = 'M';
189: count = 1;
190: break;
191: }
192: count = 3;
193: result = *p + 0200;
194: break;
195: case '}':
196: case '{':
197: case ']':
198: case '[':
199: case '$':
200: case ' ':
201: case ';':
202: case '"':
203: case '\\':
204: result = *p;
205: break;
206: case '\n':
207: result = 0;
208: break;
209: default:
210: if (isdigit(*p)) {
211: result = *p - '0';
212: p++;
213: if (!isdigit(*p)) {
214: break;
215: }
216: count = 3;
217: result = (result << 3) + (*p - '0');
218: p++;
219: if (!isdigit(*p)) {
220: break;
221: }
222: count = 4;
223: result = (result << 3) + (*p - '0');
224: break;
225: }
226: result = '\\';
227: count = 1;
228: break;
229: }
230:
231: if (readPtr != NULL) {
232: *readPtr = count;
233: }
234: return result;
235: }
236:
237: /*
238: *--------------------------------------------------------------
239: *
240: * TclParseQuotes --
241: *
242: * This procedure parses a double-quoted string such as a
243: * quoted Tcl command argument or a quoted value in a Tcl
244: * expression. This procedure is also used to parse array
245: * element names within parentheses, or anything else that
246: * needs all the substitutions that happen in quotes.
247: *
248: * Results:
249: * The return value is a standard Tcl result, which is
250: * TCL_OK unless there was an error while parsing the
251: * quoted string. If an error occurs then interp->result
252: * contains a standard error message. *TermPtr is filled
253: * in with the address of the character just after the
254: * last one successfully processed; this is usually the
255: * character just after the matching close-quote. The
256: * fully-substituted contents of the quotes are stored in
257: * standard fashion in *pvPtr, null-terminated with
258: * pvPtr->next pointing to the terminating null character.
259: *
260: * Side effects:
261: * The buffer space in pvPtr may be enlarged by calling its
262: * expandProc.
263: *
264: *--------------------------------------------------------------
265: */
266:
267: int
268: TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
269: Tcl_Interp *interp; /* Interpreter to use for nested command
270: * evaluations and error messages. */
271: char *string; /* Character just after opening double-
272: * quote. */
273: int termChar; /* Character that terminates "quoted" string
274: * (usually double-quote, but sometimes
275: * right-paren or something else). */
276: int flags; /* Flags to pass to nested Tcl_Eval calls. */
277: char **termPtr; /* Store address of terminating character
278: * here. */
279: ParseValue *pvPtr; /* Information about where to place
280: * fully-substituted result of parse. */
281: {
282: register char *src, *dst, c;
283:
284: src = string;
285: dst = pvPtr->next;
286:
287: while (1) {
288: if (dst == pvPtr->end) {
289: /*
290: * Target buffer space is about to run out. Make more space.
291: */
292:
293: pvPtr->next = dst;
294: (*pvPtr->expandProc)(pvPtr, 1);
295: dst = pvPtr->next;
296: }
297:
298: c = *src;
299: src++;
300: if (c == termChar) {
301: *dst = '\0';
302: pvPtr->next = dst;
303: *termPtr = src;
304: return TCL_OK;
305: } else if (CHAR_TYPE(c) == TCL_NORMAL) {
306: copy:
307: *dst = c;
308: dst++;
309: continue;
310: } else if (c == '$') {
311: int length;
312: char *value;
313:
314: value = Tcl_ParseVar(interp, src-1, termPtr);
315: if (value == NULL) {
316: return TCL_ERROR;
317: }
318: src = *termPtr;
319: length = strlen(value);
320: if ((pvPtr->end - dst) <= length) {
321: pvPtr->next = dst;
322: (*pvPtr->expandProc)(pvPtr, length);
323: dst = pvPtr->next;
324: }
325: strcpy(dst, value);
326: dst += length;
327: continue;
328: } else if (c == '[') {
329: int result;
330:
331: pvPtr->next = dst;
332: result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
333: if (result != TCL_OK) {
334: return result;
335: }
336: src = *termPtr;
337: dst = pvPtr->next;
338: continue;
339: } else if (c == '\\') {
340: int numRead;
341:
342: src--;
343: *dst = Tcl_Backslash(src, &numRead);
344: if (*dst != 0) {
345: dst++;
346: }
347: src += numRead;
348: continue;
349: } else if (c == '\0') {
350: Tcl_ResetResult(interp);
351: sprintf(interp->result, "missing %c", termChar);
352: *termPtr = string-1;
353: return TCL_ERROR;
354: } else {
355: goto copy;
356: }
357: }
358: }
359:
360: /*
361: *--------------------------------------------------------------
362: *
363: * TclParseNestedCmd --
364: *
365: * This procedure parses a nested Tcl command between
366: * brackets, returning the result of the command.
367: *
368: * Results:
369: * The return value is a standard Tcl result, which is
370: * TCL_OK unless there was an error while executing the
371: * nested command. If an error occurs then interp->result
372: * contains a standard error message. *TermPtr is filled
373: * in with the address of the character just after the
374: * last one processed; this is usually the character just
375: * after the matching close-bracket, or the null character
376: * at the end of the string if the close-bracket was missing
377: * (a missing close bracket is an error). The result returned
378: * by the command is stored in standard fashion in *pvPtr,
379: * null-terminated, with pvPtr->next pointing to the null
380: * character.
381: *
382: * Side effects:
383: * The storage space at *pvPtr may be expanded.
384: *
385: *--------------------------------------------------------------
386: */
387:
388: int
389: TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
390: Tcl_Interp *interp; /* Interpreter to use for nested command
391: * evaluations and error messages. */
392: char *string; /* Character just after opening bracket. */
393: int flags; /* Flags to pass to nested Tcl_Eval. */
394: char **termPtr; /* Store address of terminating character
395: * here. */
396: register ParseValue *pvPtr; /* Information about where to place
397: * result of command. */
398: {
399: int result, length, shortfall;
400: Interp *iPtr = (Interp *) interp;
401:
402: result = Tcl_Eval(interp, string, flags | TCL_BRACKET_TERM, termPtr);
403: if (result != TCL_OK) {
404: /*
405: * The increment below results in slightly cleaner message in
406: * the errorInfo variable (the close-bracket will appear).
407: */
408:
409: if (**termPtr == ']') {
410: *termPtr += 1;
411: }
412: return result;
413: }
414: (*termPtr) += 1;
415: length = strlen(iPtr->result);
416: shortfall = length + 1 - (pvPtr->end - pvPtr->next);
417: if (shortfall > 0) {
418: (*pvPtr->expandProc)(pvPtr, shortfall);
419: }
420: strcpy(pvPtr->next, iPtr->result);
421: pvPtr->next += length;
422: Tcl_FreeResult(iPtr);
423: iPtr->result = iPtr->resultSpace;
424: iPtr->resultSpace[0] = '\0';
425: return TCL_OK;
426: }
427:
428: /*
429: *--------------------------------------------------------------
430: *
431: * TclParseBraces --
432: *
433: * This procedure scans the information between matching
434: * curly braces.
435: *
436: * Results:
437: * The return value is a standard Tcl result, which is
438: * TCL_OK unless there was an error while parsing string.
439: * If an error occurs then interp->result contains a
440: * standard error message. *TermPtr is filled
441: * in with the address of the character just after the
442: * last one successfully processed; this is usually the
443: * character just after the matching close-brace. The
444: * information between curly braces is stored in standard
445: * fashion in *pvPtr, null-terminated with pvPtr->next
446: * pointing to the terminating null character.
447: *
448: * Side effects:
449: * The storage space at *pvPtr may be expanded.
450: *
451: *--------------------------------------------------------------
452: */
453:
454: int
455: TclParseBraces(interp, string, termPtr, pvPtr)
456: Tcl_Interp *interp; /* Interpreter to use for nested command
457: * evaluations and error messages. */
458: char *string; /* Character just after opening bracket. */
459: char **termPtr; /* Store address of terminating character
460: * here. */
461: register ParseValue *pvPtr; /* Information about where to place
462: * result of command. */
463: {
464: int level;
465: register char *src, *dst, *end;
466: register char c;
467:
468: src = string;
469: dst = pvPtr->next;
470: end = pvPtr->end;
471: level = 1;
472:
473: /*
474: * Copy the characters one at a time to the result area, stopping
475: * when the matching close-brace is found.
476: */
477:
478: while (1) {
479: c = *src;
480: src++;
481: if (dst == end) {
482: pvPtr->next = dst;
483: (*pvPtr->expandProc)(pvPtr, 20);
484: dst = pvPtr->next;
485: end = pvPtr->end;
486: }
487: *dst = c;
488: dst++;
489: if (CHAR_TYPE(c) == TCL_NORMAL) {
490: continue;
491: } else if (c == '{') {
492: level++;
493: } else if (c == '}') {
494: level--;
495: if (level == 0) {
496: dst--; /* Don't copy the last close brace. */
497: break;
498: }
499: } else if (c == '\\') {
500: int count;
501:
502: /*
503: * Must always squish out backslash-newlines, even when in
504: * braces. This is needed so that this sequence can appear
505: * anywhere in a command, such as the middle of an expression.
506: */
507:
508: if (*src == '\n') {
509: dst--;
510: src++;
511: } else {
512: (void) Tcl_Backslash(src-1, &count);
513: while (count > 1) {
514: if (dst == end) {
515: pvPtr->next = dst;
516: (*pvPtr->expandProc)(pvPtr, 20);
517: dst = pvPtr->next;
518: end = pvPtr->end;
519: }
520: *dst = *src;
521: dst++;
522: src++;
523: count--;
524: }
525: }
526: } else if (c == '\0') {
527: Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
528: *termPtr = string-1;
529: return TCL_ERROR;
530: }
531: }
532:
533: *dst = '\0';
534: pvPtr->next = dst;
535: *termPtr = src;
536: return TCL_OK;
537: }
538:
539: /*
540: *--------------------------------------------------------------
541: *
542: * TclParseWords --
543: *
544: * This procedure parses one or more words from a command
545: * string and creates argv-style pointers to fully-substituted
546: * copies of those words.
547: *
548: * Results:
549: * The return value is a standard Tcl result.
550: *
551: * *argcPtr is modified to hold a count of the number of words
552: * successfully parsed, which may be 0. At most maxWords words
553: * will be parsed. If 0 <= *argcPtr < maxWords then it
554: * means that a command separator was seen. If *argcPtr
555: * is maxWords then it means that a command separator was
556: * not seen yet.
557: *
558: * *TermPtr is filled in with the address of the character
559: * just after the last one successfully processed in the
560: * last word. This is either the command terminator (if
561: * *argcPtr < maxWords), the character just after the last
562: * one in a word (if *argcPtr is maxWords), or the vicinity
563: * of an error (if the result is not TCL_OK).
564: *
565: * The pointers at *argv are filled in with pointers to the
566: * fully-substituted words, and the actual contents of the
567: * words are copied to the buffer at pvPtr.
568: *
569: * If an error occurrs then an error message is left in
570: * interp->result and the information at *argv, *argcPtr,
571: * and *pvPtr may be incomplete.
572: *
573: * Side effects:
574: * The buffer space in pvPtr may be enlarged by calling its
575: * expandProc.
576: *
577: *--------------------------------------------------------------
578: */
579:
580: int
581: TclParseWords(interp, string, flags, maxWords, termPtr, argcPtr, argv, pvPtr)
582: Tcl_Interp *interp; /* Interpreter to use for nested command
583: * evaluations and error messages. */
584: char *string; /* First character of word. */
585: int flags; /* Flags to control parsing (same values as
586: * passed to Tcl_Eval). */
587: int maxWords; /* Maximum number of words to parse. */
588: char **termPtr; /* Store address of terminating character
589: * here. */
590: int *argcPtr; /* Filled in with actual number of words
591: * parsed. */
592: char **argv; /* Store addresses of individual words here. */
593: register ParseValue *pvPtr; /* Information about where to place
594: * fully-substituted word. */
595: {
596: register char *src, *dst;
597: register char c;
598: int type, result, argc;
599: char *oldBuffer; /* Used to detect when pvPtr's buffer gets
600: * reallocated, so we can adjust all of the
601: * argv pointers. */
602:
603: src = string;
604: oldBuffer = pvPtr->buffer;
605: dst = pvPtr->next;
606: for (argc = 0; argc < maxWords; argc++) {
607: argv[argc] = dst;
608:
609: /*
610: * Skip leading space.
611: */
612:
613: skipSpace:
614: c = *src;
615: type = CHAR_TYPE(c);
616: while (type == TCL_SPACE) {
617: src++;
618: c = *src;
619: type = CHAR_TYPE(c);
620: }
621:
622: /*
623: * Handle the normal case (i.e. no leading double-quote or brace).
624: */
625:
626: if (type == TCL_NORMAL) {
627: normalArg:
628: while (1) {
629: if (dst == pvPtr->end) {
630: /*
631: * Target buffer space is about to run out. Make
632: * more space.
633: */
634:
635: pvPtr->next = dst;
636: (*pvPtr->expandProc)(pvPtr, 1);
637: dst = pvPtr->next;
638: }
639:
640: if (type == TCL_NORMAL) {
641: copy:
642: *dst = c;
643: dst++;
644: src++;
645: } else if (type == TCL_SPACE) {
646: goto wordEnd;
647: } else if (type == TCL_DOLLAR) {
648: int length;
649: char *value;
650:
651: value = Tcl_ParseVar(interp, src, termPtr);
652: if (value == NULL) {
653: return TCL_ERROR;
654: }
655: src = *termPtr;
656: length = strlen(value);
657: if ((pvPtr->end - dst) <= length) {
658: pvPtr->next = dst;
659: (*pvPtr->expandProc)(pvPtr, length);
660: dst = pvPtr->next;
661: }
662: strcpy(dst, value);
663: dst += length;
664: } else if (type == TCL_COMMAND_END) {
665: if ((c == ']') && !(flags & TCL_BRACKET_TERM)) {
666: goto copy;
667: }
668:
669: /*
670: * End of command; simulate a word-end first, so
671: * that the end-of-command can be processed as the
672: * first thing in a new word.
673: */
674:
675: goto wordEnd;
676: } else if (type == TCL_OPEN_BRACKET) {
677: pvPtr->next = dst;
678: result = TclParseNestedCmd(interp, src+1, flags, termPtr,
679: pvPtr);
680: if (result != TCL_OK) {
681: return result;
682: }
683: src = *termPtr;
684: dst = pvPtr->next;
685: } else if (type == TCL_BACKSLASH) {
686: int numRead;
687:
688: *dst = Tcl_Backslash(src, &numRead);
689: if (*dst != 0) {
690: dst++;
691: }
692: src += numRead;
693: } else {
694: goto copy;
695: }
696: c = *src;
697: type = CHAR_TYPE(c);
698: }
699: } else {
700:
701: /*
702: * Check for the end of the command.
703: */
704:
705: if (type == TCL_COMMAND_END) {
706: if (flags & TCL_BRACKET_TERM) {
707: if (c == '\0') {
708: Tcl_SetResult(interp, "missing close-bracket",
709: TCL_STATIC);
710: return TCL_ERROR;
711: }
712: } else {
713: if (c == ']') {
714: goto normalArg;
715: }
716: }
717: goto done;
718: }
719:
720: /*
721: * Now handle the special cases: open braces, double-quotes,
722: * and backslash-newline.
723: */
724:
725: pvPtr->next = dst;
726: if (type == TCL_QUOTE) {
727: result = TclParseQuotes(interp, src+1, '"', flags,
728: termPtr, pvPtr);
729: } else if (type == TCL_OPEN_BRACE) {
730: result = TclParseBraces(interp, src+1, termPtr, pvPtr);
731: } else if ((type == TCL_BACKSLASH) && (src[1] == '\n')) {
732: src += 2;
733: goto skipSpace;
734: } else {
735: goto normalArg;
736: }
737: if (result != TCL_OK) {
738: return result;
739: }
740:
741: /*
742: * Back from quotes or braces; make sure that the terminating
743: * character was the end of the word. Have to be careful here
744: * to handle continuation lines (i.e. lines ending in backslash).
745: */
746:
747: c = **termPtr;
748: if ((c == '\\') && ((*termPtr)[1] == '\n')) {
749: c = (*termPtr)[2];
750: }
751: type = CHAR_TYPE(c);
752: if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
753: if (*src == '"') {
754: Tcl_SetResult(interp, "extra characters after close-quote",
755: TCL_STATIC);
756: } else {
757: Tcl_SetResult(interp, "extra characters after close-brace",
758: TCL_STATIC);
759: }
760: return TCL_ERROR;
761: }
762: src = *termPtr;
763: dst = pvPtr->next;
764:
765: }
766:
767: /*
768: * We're at the end of a word, so add a null terminator. Then
769: * see if the buffer was re-allocated during this word. If so,
770: * update all of the argv pointers.
771: */
772:
773: wordEnd:
774: *dst = '\0';
775: dst++;
776: if (oldBuffer != pvPtr->buffer) {
777: int i;
778:
779: for (i = 0; i <= argc; i++) {
780: argv[i] = pvPtr->buffer + (argv[i] - oldBuffer);
781: }
782: oldBuffer = pvPtr->buffer;
783: }
784: }
785:
786: done:
787: pvPtr->next = dst;
788: *termPtr = src;
789: *argcPtr = argc;
790: return TCL_OK;
791: }
792:
793: /*
794: *--------------------------------------------------------------
795: *
796: * TclExpandParseValue --
797: *
798: * This procedure is commonly used as the value of the
799: * expandProc in a ParseValue. It uses malloc to allocate
800: * more space for the result of a parse.
801: *
802: * Results:
803: * The buffer space in *pvPtr is reallocated to something
804: * larger, and if pvPtr->clientData is non-zero the old
805: * buffer is freed. Information is copied from the old
806: * buffer to the new one.
807: *
808: * Side effects:
809: * None.
810: *
811: *--------------------------------------------------------------
812: */
813:
814: void
815: TclExpandParseValue(pvPtr, needed)
816: register ParseValue *pvPtr; /* Information about buffer that
817: * must be expanded. If the clientData
818: * in the structure is non-zero, it
819: * means that the current buffer is
820: * dynamically allocated. */
821: int needed; /* Minimum amount of additional space
822: * to allocate. */
823: {
824: int newSpace;
825: char *new;
826:
827: /*
828: * Either double the size of the buffer or add enough new space
829: * to meet the demand, whichever produces a larger new buffer.
830: */
831:
832: newSpace = (pvPtr->end - pvPtr->buffer) + 1;
833: if (newSpace < needed) {
834: newSpace += needed;
835: } else {
836: newSpace += newSpace;
837: }
838: new = (char *) ckalloc((unsigned) newSpace);
839:
840: /*
841: * Copy from old buffer to new, free old buffer if needed, and
842: * mark new buffer as malloc-ed.
843: */
844:
845: memcpy((VOID *) new, (VOID *) pvPtr->buffer, pvPtr->next - pvPtr->buffer);
846: pvPtr->next = new + (pvPtr->next - pvPtr->buffer);
847: if (pvPtr->clientData != 0) {
848: ckfree(pvPtr->buffer);
849: }
850: pvPtr->buffer = new;
851: pvPtr->end = new + newSpace - 1;
852: pvPtr->clientData = (ClientData) 1;
853: }
854:
855: /*
856: *----------------------------------------------------------------------
857: *
858: * TclWordEnd --
859: *
860: * Given a pointer into a Tcl command, find the end of the next
861: * word of the command.
862: *
863: * Results:
864: * The return value is a pointer to the character just after the
865: * last one that's part of the word pointed to by "start". This
866: * may be the address of the NULL character at the end of the
867: * string.
868: *
869: * Side effects:
870: * None.
871: *
872: *----------------------------------------------------------------------
873: */
874:
875: char *
876: TclWordEnd(start, nested)
877: char *start; /* Beginning of a word of a Tcl command. */
878: int nested; /* Zero means this is a top-level command.
879: * One means this is a nested command (close
880: * brace is a word terminator). */
881: {
882: register char *p;
883: int count;
884:
885: p = start;
886: while (isspace(*p)) {
887: p++;
888: }
889:
890: /*
891: * Handle words beginning with a double-quote or a brace.
892: */
893:
894: if (*p == '"') {
895: p = QuoteEnd(p+1, '"');
896: } else if (*p == '{') {
897: int braces = 1;
898: while (braces != 0) {
899: p++;
900: while (*p == '\\') {
901: (void) Tcl_Backslash(p, &count);
902: p += count;
903: }
904: if (*p == '}') {
905: braces--;
906: } else if (*p == '{') {
907: braces++;
908: } else if (*p == 0) {
909: return p;
910: }
911: }
912: }
913:
914: /*
915: * Handle words that don't start with a brace or double-quote.
916: * This code is also invoked if the word starts with a brace or
917: * double-quote and there is garbage after the closing brace or
918: * quote. This is an error as far as Tcl_Eval is concerned, but
919: * for here the garbage is treated as part of the word.
920: */
921:
922: while (*p != 0) {
923: if (*p == '[') {
924: p++;
925: while ((*p != ']') && (*p != 0)) {
926: p = TclWordEnd(p, 1);
927: }
928: if (*p == ']') {
929: p++;
930: }
931: } else if (*p == '\\') {
932: (void) Tcl_Backslash(p, &count);
933: p += count;
934: } else if (*p == '$') {
935: p = VarNameEnd(p);
936: } else if (*p == ';') {
937: /*
938: * Note: semi-colon terminates a word
939: * and also counts as a word by itself.
940: */
941:
942: if (p == start) {
943: p++;
944: }
945: break;
946: } else if (isspace(*p)) {
947: break;
948: } else if ((*p == ']') && nested) {
949: break;
950: } else {
951: p++;
952: }
953: }
954: return p;
955: }
956:
957: /*
958: *----------------------------------------------------------------------
959: *
960: * QuoteEnd --
961: *
962: * Given a pointer to a string that obeys the parsing conventions
963: * for quoted things in Tcl, find the end of that quoted thing.
964: * The actual thing may be a quoted argument or a parenthesized
965: * index name.
966: *
967: * Results:
968: * The return value is a pointer to the character just after the
969: * last one that is part of the quoted string.
970: *
971: * Side effects:
972: * None.
973: *
974: *----------------------------------------------------------------------
975: */
976:
977: static char *
978: QuoteEnd(string, term)
979: char *string; /* Pointer to character just after opening
980: * "quote". */
981: int term; /* This character will terminate the
982: * quoted string (e.g. '"' or ')'). */
983: {
984: register char *p = string;
985: int count;
986:
987: while ((*p != 0) && (*p != term)) {
988: if (*p == '\\') {
989: (void) Tcl_Backslash(p, &count);
990: p += count;
991: } else if (*p == '[') {
992: p++;
993: while ((*p != ']') && (*p != 0)) {
994: p = TclWordEnd(p, 1);
995: }
996: if (*p == ']') {
997: p++;
998: }
999: } else if (*p == '$') {
1000: p = VarNameEnd(p);
1001: } else {
1002: p++;
1003: }
1004: }
1005: return p;
1006: }
1007:
1008: /*
1009: *----------------------------------------------------------------------
1010: *
1011: * VarNameEnd --
1012: *
1013: * Given a pointer to a variable reference using $-notation, find
1014: * the end of the variable name spec.
1015: *
1016: * Results:
1017: * The return value is a pointer to the character just after the
1018: * last one that is part of the variable name.
1019: *
1020: * Side effects:
1021: * None.
1022: *
1023: *----------------------------------------------------------------------
1024: */
1025:
1026: static char *
1027: VarNameEnd(string)
1028: char *string; /* Pointer to dollar-sign character. */
1029: {
1030: register char *p = string+1;
1031:
1032: if (*p == '{') {
1033: do {
1034: p++;
1035: } while ((*p != '}') && (*p != 0));
1036: } else {
1037: while (isalnum(*p) || (*p == '_')) {
1038: p++;
1039: }
1040: if ((*p == '(') && (p != string+1)) {
1041: p = QuoteEnd(p+1, ')');
1042: }
1043: }
1044: return p;
1045: }
1046:
1047: /*
1048: *----------------------------------------------------------------------
1049: *
1050: * Tcl_ParseVar --
1051: *
1052: * Given a string starting with a $ sign, parse off a variable
1053: * name and return its value.
1054: *
1055: * Results:
1056: * The return value is the contents of the variable given by
1057: * the leading characters of string. If termPtr isn't NULL,
1058: * *termPtr gets filled in with the address of the character
1059: * just after the last one in the variable specifier. If the
1060: * variable doesn't exist, then the return value is NULL and
1061: * an error message will be left in interp->result.
1062: *
1063: * Side effects:
1064: * None.
1065: *
1066: *----------------------------------------------------------------------
1067: */
1068:
1069: char *
1070: Tcl_ParseVar(interp, string, termPtr)
1071: Tcl_Interp *interp; /* Context for looking up variable. */
1072: register char *string; /* String containing variable name.
1073: * First character must be "$". */
1074: char **termPtr; /* If non-NULL, points to word to fill
1075: * in with character just after last
1076: * one in the variable specifier. */
1077:
1078: {
1079: char *name1, *name1End, c, *result;
1080: register char *name2;
1081: #define NUM_CHARS 200
1082: char copyStorage[NUM_CHARS];
1083: ParseValue pv;
1084:
1085: /*
1086: * There are three cases:
1087: * 1. The $ sign is followed by an open curly brace. Then the variable
1088: * name is everything up to the next close curly brace, and the
1089: * variable is a scalar variable.
1090: * 2. The $ sign is not followed by an open curly brace. Then the
1091: * variable name is everything up to the next character that isn't
1092: * a letter, digit, or underscore. If the following character is an
1093: * open parenthesis, then the information between parentheses is
1094: * the array element name, which can include any of the substitutions
1095: * permissible between quotes.
1096: * 3. The $ sign is followed by something that isn't a letter, digit,
1097: * or underscore: in this case, there is no variable name, and "$"
1098: * is returned.
1099: */
1100:
1101: name2 = NULL;
1102: string++;
1103: if (*string == '{') {
1104: string++;
1105: name1 = string;
1106: while (*string != '}') {
1107: if (*string == 0) {
1108: Tcl_SetResult(interp, "missing close-brace for variable name",
1109: TCL_STATIC);
1110: if (termPtr != 0) {
1111: *termPtr = string;
1112: }
1113: return NULL;
1114: }
1115: string++;
1116: }
1117: name1End = string;
1118: string++;
1119: } else {
1120: name1 = string;
1121: while (isalnum(*string) || (*string == '_')) {
1122: string++;
1123: }
1124: if (string == name1) {
1125: if (termPtr != 0) {
1126: *termPtr = string;
1127: }
1128: return "$";
1129: }
1130: name1End = string;
1131: if (*string == '(') {
1132: char *end;
1133:
1134: /*
1135: * Perform substitutions on the array element name, just as
1136: * is done for quotes.
1137: */
1138:
1139: pv.buffer = pv.next = copyStorage;
1140: pv.end = copyStorage + NUM_CHARS - 1;
1141: pv.expandProc = TclExpandParseValue;
1142: pv.clientData = (ClientData) NULL;
1143: if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
1144: != TCL_OK) {
1145: char msg[100];
1146: sprintf(msg, "\n (parsing index for array \"%.*s\")",
1147: string-name1, name1);
1148: Tcl_AddErrorInfo(interp, msg);
1149: result = NULL;
1150: name2 = pv.buffer;
1151: if (termPtr != 0) {
1152: *termPtr = end;
1153: }
1154: goto done;
1155: }
1156: string = end;
1157: name2 = pv.buffer;
1158: }
1159: }
1160: if (termPtr != 0) {
1161: *termPtr = string;
1162: }
1163:
1164: c = *name1End;
1165: *name1End = 0;
1166: result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
1167: *name1End = c;
1168:
1169: done:
1170: if ((name2 != NULL) && (pv.buffer != copyStorage)) {
1171: ckfree(pv.buffer);
1172: }
1173: return result;
1174: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.