]> git.zerfleddert.de Git - micropolis/blame - src/tcl/tclparse.c
projects / micropolis / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
fix colors on BGR displays
[micropolis] / src / tcl / tclparse.c
CommitLineData
6a5fa4e0
MG		 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
19static 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
31char 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
102static char * QuoteEnd _ANSI_ARGS_((char *string, int term));
103static char * VarNameEnd _ANSI_ARGS_((char *string));
104\f
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
129char
130Tcl_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\f
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
267int
268TclParseQuotes(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\f
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
388int
389TclParseNestedCmd(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\f
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
454int
455TclParseBraces(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\f
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
580int
581TclParseWords(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\f
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
814void
815TclExpandParseValue(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\f
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
875char *
876TclWordEnd(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\f
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
977static char *
978QuoteEnd(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\f
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
1026static char *
1027VarNameEnd(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\f
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
1069char *
1070Tcl_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}
Micropolis
Impressum, Datenschutz