Fork me on GitHub

source: git/external/tcl/tclParse.c@ d97a18b

ImprovedOutputFile Timing dual_readout llp
Last change on this file since d97a18b was d7d2da3, checked in by pavel <pavel@…>, 12 years ago

move branches/ModularDelphes to trunk
  • Property mode set to 100644
File size: 23.7 KB
Line 
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 (c) 1987-1993 The Regents of the University of California.
9 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
10 *
11 * See the file "license.terms" for information on usage and redistribution
12 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 *
14 * RCS: @(#) $Id: tclParse.c,v 1.1 2008-06-04 13:58:09 demin Exp $
15 */
16
17#include "tclInt.h"
18#include "tclPort.h"
19
20/*
21 * Function prototypes for procedures local to this file:
22 */
23
24static char * QuoteEnd _ANSI_ARGS_((char *string, char *lastChar,
25 int term));
26static char * ScriptEnd _ANSI_ARGS_((char *p, char *lastChar,
27 int nested));
28static char * VarNameEnd _ANSI_ARGS_((char *string, char *lastChar));
29
30
31/*
32 *--------------------------------------------------------------
33 *
34 * TclParseQuotes --
35 *
36 * This procedure parses a double-quoted string such as a
37 * quoted Tcl command argument or a quoted value in a Tcl
38 * expression. This procedure is also used to parse array
39 * element names within parentheses, or anything else that
40 * needs all the substitutions that happen in quotes.
41 *
42 * Results:
43 * The return value is a standard Tcl result, which is
44 * TCL_OK unless there was an error while parsing the
45 * quoted string. If an error occurs then interp->result
46 * contains a standard error message. *TermPtr is filled
47 * in with the address of the character just after the
48 * last one successfully processed; this is usually the
49 * character just after the matching close-quote. The
50 * fully-substituted contents of the quotes are stored in
51 * standard fashion in *pvPtr, null-terminated with
52 * pvPtr->next pointing to the terminating null character.
53 *
54 * Side effects:
55 * The buffer space in pvPtr may be enlarged by calling its
56 * expandProc.
57 *
58 *--------------------------------------------------------------
59 */
60
61int
62TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
63 Tcl_Interp *interp; /* Interpreter to use for nested command
64 * evaluations and error messages. */
65 char *string; /* Character just after opening double-
66 * quote. */
67 int termChar; /* Character that terminates "quoted" string
68 * (usually double-quote, but sometimes
69 * right-paren or something else). */
70 int flags; /* Flags to pass to nested Tcl_Eval calls. */
71 char **termPtr; /* Store address of terminating character
72 * here. */
73 ParseValue *pvPtr; /* Information about where to place
74 * fully-substituted result of parse. */
75{
76 register char *src, *dst, c;
77 char *lastChar = string + strlen(string);
78
79 src = string;
80 dst = pvPtr->next;
81
82 while (1) {
83 if (dst == pvPtr->end) {
84 /*
85 * Target buffer space is about to run out. Make more space.
86 */
87
88 pvPtr->next = dst;
89 (*pvPtr->expandProc)(pvPtr, 1);
90 dst = pvPtr->next;
91 }
92
93 c = *src;
94 src++;
95 if (c == termChar) {
96 *dst = '\0';
97 pvPtr->next = dst;
98 *termPtr = src;
99 return TCL_OK;
100 } else if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
101 copy:
102 *dst = c;
103 dst++;
104 continue;
105 } else if (c == '$') {
106 int length;
107 char *value;
108
109 value = Tcl_ParseVar(interp, src-1, termPtr);
110 if (value == NULL) {
111 return TCL_ERROR;
112 }
113 src = *termPtr;
114 length = strlen(value);
115 if ((pvPtr->end - dst) <= length) {
116 pvPtr->next = dst;
117 (*pvPtr->expandProc)(pvPtr, length);
118 dst = pvPtr->next;
119 }
120 strcpy(dst, value);
121 dst += length;
122 continue;
123 } else if (c == '[') {
124 int result;
125
126 pvPtr->next = dst;
127 result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
128 if (result != TCL_OK) {
129 return result;
130 }
131 src = *termPtr;
132 dst = pvPtr->next;
133 continue;
134 } else if (c == '\\') {
135 int numRead;
136
137 src--;
138 *dst = Tcl_Backslash(src, &numRead);
139 dst++;
140 src += numRead;
141 continue;
142 } else if (c == '\0') {
143 char buf[30];
144
145 Tcl_ResetResult(interp);
146 sprintf(buf, "missing %c", termChar);
147 Tcl_SetResult(interp, buf, TCL_VOLATILE);
148 *termPtr = string-1;
149 return TCL_ERROR;
150 } else {
151 goto copy;
152 }
153 }
154}
155
156
157/*
158 *--------------------------------------------------------------
159 *
160 * TclParseNestedCmd --
161 *
162 * This procedure parses a nested Tcl command between
163 * brackets, returning the result of the command.
164 *
165 * Results:
166 * The return value is a standard Tcl result, which is
167 * TCL_OK unless there was an error while executing the
168 * nested command. If an error occurs then interp->result
169 * contains a standard error message. *TermPtr is filled
170 * in with the address of the character just after the
171 * last one processed; this is usually the character just
172 * after the matching close-bracket, or the null character
173 * at the end of the string if the close-bracket was missing
174 * (a missing close bracket is an error). The result returned
175 * by the command is stored in standard fashion in *pvPtr,
176 * null-terminated, with pvPtr->next pointing to the null
177 * character.
178 *
179 * Side effects:
180 * The storage space at *pvPtr may be expanded.
181 *
182 *--------------------------------------------------------------
183 */
184
185int
186TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
187 Tcl_Interp *interp; /* Interpreter to use for nested command
188 * evaluations and error messages. */
189 char *string; /* Character just after opening bracket. */
190 int flags; /* Flags to pass to nested Tcl_Eval. */
191 char **termPtr; /* Store address of terminating character
192 * here. */
193 register ParseValue *pvPtr; /* Information about where to place
194 * result of command. */
195{
196 int result, length, shortfall;
197 Interp *iPtr = (Interp *) interp;
198
199 iPtr->evalFlags = flags | TCL_BRACKET_TERM;
200 result = Tcl_Eval(interp, string);
201 *termPtr = (string + iPtr->termOffset);
202 if (result != TCL_OK) {
203 /*
204 * The increment below results in slightly cleaner message in
205 * the errorInfo variable (the close-bracket will appear).
206 */
207
208 if (**termPtr == ']') {
209 *termPtr += 1;
210 }
211 return result;
212 }
213 (*termPtr) += 1;
214 length = strlen(iPtr->result);
215 shortfall = length + 1 - (pvPtr->end - pvPtr->next);
216 if (shortfall > 0) {
217 (*pvPtr->expandProc)(pvPtr, shortfall);
218 }
219 strcpy(pvPtr->next, iPtr->result);
220 pvPtr->next += length;
221
222 Tcl_FreeResult(interp);
223 iPtr->result = iPtr->resultSpace;
224 iPtr->resultSpace[0] = '\0';
225 return TCL_OK;
226}
227
228
229/*
230 *--------------------------------------------------------------
231 *
232 * TclParseBraces --
233 *
234 * This procedure scans the information between matching
235 * curly braces.
236 *
237 * Results:
238 * The return value is a standard Tcl result, which is
239 * TCL_OK unless there was an error while parsing string.
240 * If an error occurs then interp->result contains a
241 * standard error message. *TermPtr is filled
242 * in with the address of the character just after the
243 * last one successfully processed; this is usually the
244 * character just after the matching close-brace. The
245 * information between curly braces is stored in standard
246 * fashion in *pvPtr, null-terminated with pvPtr->next
247 * pointing to the terminating null character.
248 *
249 * Side effects:
250 * The storage space at *pvPtr may be expanded.
251 *
252 *--------------------------------------------------------------
253 */
254
255int
256TclParseBraces(interp, string, termPtr, pvPtr)
257 Tcl_Interp *interp; /* Interpreter to use for nested command
258 * evaluations and error messages. */
259 char *string; /* Character just after opening bracket. */
260 char **termPtr; /* Store address of terminating character
261 * here. */
262 register ParseValue *pvPtr; /* Information about where to place
263 * result of command. */
264{
265 int level;
266 register char *src, *dst, *end;
267 register char c;
268 char *lastChar = string + strlen(string);
269
270 src = string;
271 dst = pvPtr->next;
272 end = pvPtr->end;
273 level = 1;
274
275 /*
276 * Copy the characters one at a time to the result area, stopping
277 * when the matching close-brace is found.
278 */
279
280 while (1) {
281 c = *src;
282 src++;
283 if (dst == end) {
284 pvPtr->next = dst;
285 (*pvPtr->expandProc)(pvPtr, 20);
286 dst = pvPtr->next;
287 end = pvPtr->end;
288 }
289 *dst = c;
290 dst++;
291 if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
292 continue;
293 } else if (c == '{') {
294 level++;
295 } else if (c == '}') {
296 level--;
297 if (level == 0) {
298 dst--; /* Don't copy the last close brace. */
299 break;
300 }
301 } else if (c == '\\') {
302 int count;
303
304 /*
305 * Must always squish out backslash-newlines, even when in
306 * braces. This is needed so that this sequence can appear
307 * anywhere in a command, such as the middle of an expression.
308 */
309
310 if (*src == '\n') {
311 dst[-1] = Tcl_Backslash(src-1, &count);
312 src += count - 1;
313 } else {
314 (void) Tcl_Backslash(src-1, &count);
315 while (count > 1) {
316 if (dst == end) {
317 pvPtr->next = dst;
318 (*pvPtr->expandProc)(pvPtr, 20);
319 dst = pvPtr->next;
320 end = pvPtr->end;
321 }
322 *dst = *src;
323 dst++;
324 src++;
325 count--;
326 }
327 }
328 } else if (c == '\0') {
329 Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
330 *termPtr = string-1;
331 return TCL_ERROR;
332 }
333 }
334
335 *dst = '\0';
336 pvPtr->next = dst;
337 *termPtr = src;
338 return TCL_OK;
339}
340
341
342/*
343 *--------------------------------------------------------------
344 *
345 * TclExpandParseValue --
346 *
347 * This procedure is commonly used as the value of the
348 * expandProc in a ParseValue. It uses malloc to allocate
349 * more space for the result of a parse.
350 *
351 * Results:
352 * The buffer space in *pvPtr is reallocated to something
353 * larger, and if pvPtr->clientData is non-zero the old
354 * buffer is freed. Information is copied from the old
355 * buffer to the new one.
356 *
357 * Side effects:
358 * None.
359 *
360 *--------------------------------------------------------------
361 */
362
363void
364TclExpandParseValue(pvPtr, needed)
365 register ParseValue *pvPtr; /* Information about buffer that
366 * must be expanded. If the clientData
367 * in the structure is non-zero, it
368 * means that the current buffer is
369 * dynamically allocated. */
370 int needed; /* Minimum amount of additional space
371 * to allocate. */
372{
373 int newSpace;
374 char *new;
375
376 /*
377 * Either double the size of the buffer or add enough new space
378 * to meet the demand, whichever produces a larger new buffer.
379 */
380
381 newSpace = (pvPtr->end - pvPtr->buffer) + 1;
382 if (newSpace < needed) {
383 newSpace += needed;
384 } else {
385 newSpace += newSpace;
386 }
387 new = (char *) ckalloc((unsigned) newSpace);
388
389 /*
390 * Copy from old buffer to new, free old buffer if needed, and
391 * mark new buffer as malloc-ed.
392 */
393
394 memcpy((VOID *) new, (VOID *) pvPtr->buffer,
395 (size_t) (pvPtr->next - pvPtr->buffer));
396 pvPtr->next = new + (pvPtr->next - pvPtr->buffer);
397 if (pvPtr->clientData != 0) {
398 ckfree(pvPtr->buffer);
399 }
400 pvPtr->buffer = new;
401 pvPtr->end = new + newSpace - 1;
402 pvPtr->clientData = (ClientData) 1;
403}
404
405
406/*
407 *----------------------------------------------------------------------
408 *
409 * TclWordEnd --
410 *
411 * Given a pointer into a Tcl command, find the end of the next
412 * word of the command.
413 *
414 * Results:
415 * The return value is a pointer to the last character that's part
416 * of the word pointed to by "start". If the word doesn't end
417 * properly within the string then the return value is the address
418 * of the null character at the end of the string.
419 *
420 * Side effects:
421 * None.
422 *
423 *----------------------------------------------------------------------
424 */
425
426char *
427TclWordEnd(start, lastChar, nested, semiPtr)
428 char *start; /* Beginning of a word of a Tcl command. */
429 char *lastChar; /* Terminating character in string. */
430 int nested; /* Zero means this is a top-level command.
431 * One means this is a nested command (close
432 * bracket is a word terminator). */
433 int *semiPtr; /* Set to 1 if word ends with a command-
434 * terminating semi-colon, zero otherwise.
435 * If NULL then ignored. */
436{
437 register char *p;
438 int count;
439
440 if (semiPtr != NULL) {
441 *semiPtr = 0;
442 }
443
444 /*
445 * Skip leading white space (backslash-newline must be treated like
446 * white-space, except that it better not be the last thing in the
447 * command).
448 */
449
450 for (p = start; ; p++) {
451 if (isspace(UCHAR(*p))) {
452 continue;
453 }
454 if ((p[0] == '\\') && (p[1] == '\n')) {
455 if (p+2 == lastChar) {
456 return p+2;
457 }
458 continue;
459 }
460 break;
461 }
462
463 /*
464 * Handle words beginning with a double-quote or a brace.
465 */
466
467 if (*p == '"') {
468 p = QuoteEnd(p+1, lastChar, '"');
469 if (p == lastChar) {
470 return p;
471 }
472 p++;
473 } else if (*p == '{') {
474 int braces = 1;
475 while (braces != 0) {
476 p++;
477 while (*p == '\\') {
478 (void) Tcl_Backslash(p, &count);
479 p += count;
480 }
481 if (*p == '}') {
482 braces--;
483 } else if (*p == '{') {
484 braces++;
485 } else if (p == lastChar) {
486 return p;
487 }
488 }
489 p++;
490 }
491
492 /*
493 * Handle words that don't start with a brace or double-quote.
494 * This code is also invoked if the word starts with a brace or
495 * double-quote and there is garbage after the closing brace or
496 * quote. This is an error as far as Tcl_Eval is concerned, but
497 * for here the garbage is treated as part of the word.
498 */
499
500 while (1) {
501 if (*p == '[') {
502 p = ScriptEnd(p+1, lastChar, 1);
503 if (p == lastChar) {
504 return p;
505 }
506 p++;
507 } else if (*p == '\\') {
508 if (p[1] == '\n') {
509 /*
510 * Backslash-newline: it maps to a space character
511 * that is a word separator, so the word ends just before
512 * the backslash.
513 */
514
515 return p-1;
516 }
517 (void) Tcl_Backslash(p, &count);
518 p += count;
519 } else if (*p == '$') {
520 p = VarNameEnd(p, lastChar);
521 if (p == lastChar) {
522 return p;
523 }
524 p++;
525 } else if (*p == ';') {
526 /*
527 * Include the semi-colon in the word that is returned.
528 */
529
530 if (semiPtr != NULL) {
531 *semiPtr = 1;
532 }
533 return p;
534 } else if (isspace(UCHAR(*p))) {
535 return p-1;
536 } else if ((*p == ']') && nested) {
537 return p-1;
538 } else if (p == lastChar) {
539 if (nested) {
540 /*
541 * Nested commands can't end because of the end of the
542 * string.
543 */
544 return p;
545 }
546 return p-1;
547 } else {
548 p++;
549 }
550 }
551}
552
553
554/*
555 *----------------------------------------------------------------------
556 *
557 * QuoteEnd --
558 *
559 * Given a pointer to a string that obeys the parsing conventions
560 * for quoted things in Tcl, find the end of that quoted thing.
561 * The actual thing may be a quoted argument or a parenthesized
562 * index name.
563 *
564 * Results:
565 * The return value is a pointer to the last character that is
566 * part of the quoted string (i.e the character that's equal to
567 * term). If the quoted string doesn't terminate properly then
568 * the return value is a pointer to the null character at the
569 * end of the string.
570 *
571 * Side effects:
572 * None.
573 *
574 *----------------------------------------------------------------------
575 */
576
577static char *
578QuoteEnd(string, lastChar, term)
579 char *string; /* Pointer to character just after opening
580 * "quote". */
581 char *lastChar; /* Terminating character in string. */
582 int term; /* This character will terminate the
583 * quoted string (e.g. '"' or ')'). */
584{
585 register char *p = string;
586 int count;
587
588 while (*p != term) {
589 if (*p == '\\') {
590 (void) Tcl_Backslash(p, &count);
591 p += count;
592 } else if (*p == '[') {
593 for (p++; *p != ']'; p++) {
594 p = TclWordEnd(p, lastChar, 1, (int *) NULL);
595 if (*p == 0) {
596 return p;
597 }
598 }
599 p++;
600 } else if (*p == '$') {
601 p = VarNameEnd(p, lastChar);
602 if (*p == 0) {
603 return p;
604 }
605 p++;
606 } else if (p == lastChar) {
607 return p;
608 } else {
609 p++;
610 }
611 }
612 return p-1;
613}
614
615
616/*
617 *----------------------------------------------------------------------
618 *
619 * VarNameEnd --
620 *
621 * Given a pointer to a variable reference using $-notation, find
622 * the end of the variable name spec.
623 *
624 * Results:
625 * The return value is a pointer to the last character that
626 * is part of the variable name. If the variable name doesn't
627 * terminate properly then the return value is a pointer to the
628 * null character at the end of the string.
629 *
630 * Side effects:
631 * None.
632 *
633 *----------------------------------------------------------------------
634 */
635
636static char *
637VarNameEnd(string, lastChar)
638 char *string; /* Pointer to dollar-sign character. */
639 char *lastChar; /* Terminating character in string. */
640{
641 register char *p = string+1;
642
643 if (*p == '{') {
644 for (p++; (*p != '}') && (p != lastChar); p++) {
645 /* Empty loop body. */
646 }
647 return p;
648 }
649 while (isalnum(UCHAR(*p)) || (*p == '_')) {
650 p++;
651 }
652 if ((*p == '(') && (p != string+1)) {
653 return QuoteEnd(p+1, lastChar, ')');
654 }
655 return p-1;
656}
657
658
659
660/*
661 *----------------------------------------------------------------------
662 *
663 * ScriptEnd --
664 *
665 * Given a pointer to the beginning of a Tcl script, find the end of
666 * the script.
667 *
668 * Results:
669 * The return value is a pointer to the last character that's part
670 * of the script pointed to by "p". If the command doesn't end
671 * properly within the string then the return value is the address
672 * of the null character at the end of the string.
673 *
674 * Side effects:
675 * None.
676 *
677 *----------------------------------------------------------------------
678 */
679
680static char *
681ScriptEnd(p, lastChar, nested)
682 char *p; /* Script to check. */
683 char *lastChar; /* Terminating character in string. */
684 int nested; /* Zero means this is a top-level command.
685 * One means this is a nested command (the
686 * last character of the script must be
687 * an unquoted ]). */
688{
689 int commentOK = 1;
690 int length;
691
692 while (1) {
693 while (isspace(UCHAR(*p))) {
694 if (*p == '\n') {
695 commentOK = 1;
696 }
697 p++;
698 }
699 if ((*p == '#') && commentOK) {
700 do {
701 if (*p == '\\') {
702 /*
703 * If the script ends with backslash-newline, then
704 * this command isn't complete.
705 */
706
707 if ((p[1] == '\n') && (p+2 == lastChar)) {
708 return p+2;
709 }
710 Tcl_Backslash(p, &length);
711 p += length;
712 } else {
713 p++;
714 }
715 } while ((p != lastChar) && (*p != '\n'));
716 continue;
717 }
718 p = TclWordEnd(p, lastChar, nested, &commentOK);
719 if (p == lastChar) {
720 return p;
721 }
722 p++;
723 if (nested) {
724 if (*p == ']') {
725 return p;
726 }
727 } else {
728 if (p == lastChar) {
729 return p-1;
730 }
731 }
732 }
733}
734
735
736/*
737 *----------------------------------------------------------------------
738 *
739 * Tcl_ParseVar --
740 *
741 * Given a string starting with a $ sign, parse off a variable
742 * name and return its value.
743 *
744 * Results:
745 * The return value is the contents of the variable given by
746 * the leading characters of string. If termPtr isn't NULL,
747 * *termPtr gets filled in with the address of the character
748 * just after the last one in the variable specifier. If the
749 * variable doesn't exist, then the return value is NULL and
750 * an error message will be left in interp->result.
751 *
752 * Side effects:
753 * None.
754 *
755 *----------------------------------------------------------------------
756 */
757
758char *
759Tcl_ParseVar(interp, string, termPtr)
760 Tcl_Interp *interp; /* Context for looking up variable. */
761 register char *string; /* String containing variable name.
762 * First character must be "$". */
763 char **termPtr; /* If non-NULL, points to word to fill
764 * in with character just after last
765 * one in the variable specifier. */
766
767{
768 char *name1, *name1End, c, *result;
769 register char *name2;
770#define NUM_CHARS 200
771 char copyStorage[NUM_CHARS];
772 ParseValue pv;
773
774 /*
775 * There are three cases:
776 * 1. The $ sign is followed by an open curly brace. Then the variable
777 * name is everything up to the next close curly brace, and the
778 * variable is a scalar variable.
779 * 2. The $ sign is not followed by an open curly brace. Then the
780 * variable name is everything up to the next character that isn't
781 * a letter, digit, or underscore, or a "::" namespace separator.
782 * If the following character is an open parenthesis, then the
783 * information between parentheses is the array element name, which
784 * can include any of the substitutions permissible between quotes.
785 * 3. The $ sign is followed by something that isn't a letter, digit,
786 * underscore, or a "::" namespace separator: in this case,
787 * there is no variable name, and "$" is returned.
788 */
789
790 name2 = NULL;
791 string++;
792 if (*string == '{') {
793 string++;
794 name1 = string;
795 while (*string != '}') {
796 if (*string == 0) {
797 Tcl_SetResult(interp, "missing close-brace for variable name",
798 TCL_STATIC);
799 if (termPtr != 0) {
800 *termPtr = string;
801 }
802 return NULL;
803 }
804 string++;
805 }
806 name1End = string;
807 string++;
808 } else {
809 name1 = string;
810 while (isalnum(UCHAR(*string)) || (*string == '_')
811 || (*string == ':')) {
812 if (*string == ':') {
813 if (*(string+1) == ':') {
814 string += 2; /* skip over the initial :: */
815 while (*string == ':') {
816 string++; /* skip over a subsequent : */
817 }
818 } else {
819 break; /* : by itself */
820 }
821 } else {
822 string++;
823 }
824 }
825 if (string == name1) {
826 if (termPtr != 0) {
827 *termPtr = string;
828 }
829 return "$";
830 }
831 name1End = string;
832 if (*string == '(') {
833 char *end;
834
835 /*
836 * Perform substitutions on the array element name, just as
837 * is done for quotes.
838 */
839
840 pv.buffer = pv.next = copyStorage;
841 pv.end = copyStorage + NUM_CHARS - 1;
842 pv.expandProc = TclExpandParseValue;
843 pv.clientData = (ClientData) NULL;
844 if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
845 != TCL_OK) {
846 char msg[200];
847 int length;
848
849 length = string-name1;
850 if (length > 100) {
851 length = 100;
852 }
853 sprintf(msg, "\n (parsing index for array \"%.*s\")",
854 length, name1);
855 Tcl_AddErrorInfo(interp, msg);
856 result = NULL;
857 name2 = pv.buffer;
858 if (termPtr != 0) {
859 *termPtr = end;
860 }
861 goto done;
862 }
863 Tcl_ResetResult(interp);
864 string = end;
865 name2 = pv.buffer;
866 }
867 }
868 if (termPtr != 0) {
869 *termPtr = string;
870 }
871
872 c = *name1End;
873 *name1End = 0;
874 result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
875 *name1End = c;
876
877 done:
878 if ((name2 != NULL) && (pv.buffer != copyStorage)) {
879 ckfree(pv.buffer);
880 }
881 return result;
882}
883
884
885/*
886 *----------------------------------------------------------------------
887 *
888 * Tcl_CommandComplete --
889 *
890 * Given a partial or complete Tcl command, this procedure
891 * determines whether the command is complete in the sense
892 * of having matched braces and quotes and brackets.
893 *
894 * Results:
895 * 1 is returned if the command is complete, 0 otherwise.
896 *
897 * Side effects:
898 * None.
899 *
900 *----------------------------------------------------------------------
901 */
902
903int
904Tcl_CommandComplete(cmd)
905 char *cmd; /* Command to check. */
906{
907 char *p;
908
909 if (*cmd == 0) {
910 return 1;
911 }
912 p = ScriptEnd(cmd, cmd+strlen(cmd), 0);
913 return (*p != 0);
914}
915
916
917/*
918 *----------------------------------------------------------------------
919 *
920 * TclObjCommandComplete --
921 *
922 * Given a partial or complete Tcl command in a Tcl object, this
923 * procedure determines whether the command is complete in the sense of
924 * having matched braces and quotes and brackets.
925 *
926 * Results:
927 * 1 is returned if the command is complete, 0 otherwise.
928 *
929 * Side effects:
930 * None.
931 *
932 *----------------------------------------------------------------------
933 */
934
935int
936TclObjCommandComplete(cmdPtr)
937 Tcl_Obj *cmdPtr; /* Points to object holding command
938 * to check. */
939{
940 char *cmd, *p;
941 int length;
942
943 cmd = Tcl_GetStringFromObj(cmdPtr, &length);
944 if (length == 0) {
945 return 1;
946 }
947 p = ScriptEnd(cmd, cmd+length, /*nested*/ 0);
948 return (*p != 0);
949}
Note: See TracBrowser for help on using the repository browser.