1 |
/* $Header$ */
|
2 |
/*
|
3 |
* tclParse.c --
|
4 |
*
|
5 |
* This file contains procedures that parse Tcl scripts. They
|
6 |
* do so in a general-purpose fashion that can be used for many
|
7 |
* different purposes, including compilation, direct execution,
|
8 |
* code analysis, etc. This file also includes a few additional
|
9 |
* procedures such as Tcl_EvalObjv, Tcl_Eval, and Tcl_EvalEx, which
|
10 |
* allow scripts to be evaluated directly, without compiling.
|
11 |
*
|
12 |
* Copyright (c) 1997 Sun Microsystems, Inc.
|
13 |
* Copyright (c) 1998 by Scriptics Corporation.
|
14 |
*
|
15 |
* See the file "license.terms" for information on usage and redistribution
|
16 |
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
17 |
*
|
18 |
* RCS: @(#) $Id: tclparse.c,v 1.1.1.1 2001/06/13 04:44:26 dtashley Exp $
|
19 |
*/
|
20 |
|
21 |
#include "tclInt.h"
|
22 |
#include "tclPort.h"
|
23 |
|
24 |
/*
|
25 |
* The following table provides parsing information about each possible
|
26 |
* 8-bit character. The table is designed to be referenced with either
|
27 |
* signed or unsigned characters, so it has 384 entries. The first 128
|
28 |
* entries correspond to negative character values, the next 256 correspond
|
29 |
* to positive character values. The last 128 entries are identical to the
|
30 |
* first 128. The table is always indexed with a 128-byte offset (the 128th
|
31 |
* entry corresponds to a character value of 0).
|
32 |
*
|
33 |
* The macro CHAR_TYPE is used to index into the table and return
|
34 |
* information about its character argument. The following return
|
35 |
* values are defined.
|
36 |
*
|
37 |
* TYPE_NORMAL - All characters that don't have special significance
|
38 |
* to the Tcl parser.
|
39 |
* TYPE_SPACE - The character is a whitespace character other
|
40 |
* than newline.
|
41 |
* TYPE_COMMAND_END - Character is newline or semicolon.
|
42 |
* TYPE_SUBS - Character begins a substitution or has other
|
43 |
* special meaning in ParseTokens: backslash, dollar
|
44 |
* sign, open bracket, or null.
|
45 |
* TYPE_QUOTE - Character is a double quote.
|
46 |
* TYPE_CLOSE_PAREN - Character is a right parenthesis.
|
47 |
* TYPE_CLOSE_BRACK - Character is a right square bracket.
|
48 |
* TYPE_BRACE - Character is a curly brace (either left or right).
|
49 |
*/
|
50 |
|
51 |
#define TYPE_NORMAL 0
|
52 |
#define TYPE_SPACE 0x1
|
53 |
#define TYPE_COMMAND_END 0x2
|
54 |
#define TYPE_SUBS 0x4
|
55 |
#define TYPE_QUOTE 0x8
|
56 |
#define TYPE_CLOSE_PAREN 0x10
|
57 |
#define TYPE_CLOSE_BRACK 0x20
|
58 |
#define TYPE_BRACE 0x40
|
59 |
|
60 |
#define CHAR_TYPE(c) (typeTable+128)[(int)(c)]
|
61 |
|
62 |
char typeTable[] = {
|
63 |
/*
|
64 |
* Negative character values, from -128 to -1:
|
65 |
*/
|
66 |
|
67 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
68 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
69 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
70 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
71 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
72 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
73 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
74 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
75 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
76 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
77 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
78 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
79 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
80 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
81 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
82 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
83 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
84 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
85 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
86 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
87 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
88 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
89 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
90 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
91 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
92 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
93 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
94 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
95 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
96 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
97 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
98 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
99 |
|
100 |
/*
|
101 |
* Positive character values, from 0-127:
|
102 |
*/
|
103 |
|
104 |
TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
105 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
106 |
TYPE_NORMAL, TYPE_SPACE, TYPE_COMMAND_END, TYPE_SPACE,
|
107 |
TYPE_SPACE, TYPE_SPACE, TYPE_NORMAL, TYPE_NORMAL,
|
108 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
109 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
110 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
111 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
112 |
TYPE_SPACE, TYPE_NORMAL, TYPE_QUOTE, TYPE_NORMAL,
|
113 |
TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
114 |
TYPE_NORMAL, TYPE_CLOSE_PAREN, TYPE_NORMAL, TYPE_NORMAL,
|
115 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
116 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
117 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
118 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_COMMAND_END,
|
119 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
120 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
121 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
122 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
123 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
124 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
125 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
126 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_SUBS,
|
127 |
TYPE_SUBS, TYPE_CLOSE_BRACK, TYPE_NORMAL, TYPE_NORMAL,
|
128 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
129 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
130 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
131 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
132 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
133 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
134 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_BRACE,
|
135 |
TYPE_NORMAL, TYPE_BRACE, TYPE_NORMAL, TYPE_NORMAL,
|
136 |
|
137 |
/*
|
138 |
* Large unsigned character values, from 128-255:
|
139 |
*/
|
140 |
|
141 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
142 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
143 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
144 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
145 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
146 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
147 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
148 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
149 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
150 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
151 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
152 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
153 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
154 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
155 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
156 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
157 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
158 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
159 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
160 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
161 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
162 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
163 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
164 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
165 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
166 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
167 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
168 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
169 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
170 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
171 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
172 |
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
|
173 |
};
|
174 |
|
175 |
/*
|
176 |
* Prototypes for local procedures defined in this file:
|
177 |
*/
|
178 |
|
179 |
static int CommandComplete _ANSI_ARGS_((char *script,
|
180 |
int length));
|
181 |
static int ParseTokens _ANSI_ARGS_((char *src, int mask,
|
182 |
Tcl_Parse *parsePtr));
|
183 |
static int EvalObjv _ANSI_ARGS_((Tcl_Interp *interp, int objc,
|
184 |
Tcl_Obj *CONST objv[], char *command, int length,
|
185 |
int flags));
|
186 |
|
187 |
/*
|
188 |
*----------------------------------------------------------------------
|
189 |
*
|
190 |
* Tcl_ParseCommand --
|
191 |
*
|
192 |
* Given a string, this procedure parses the first Tcl command
|
193 |
* in the string and returns information about the structure of
|
194 |
* the command.
|
195 |
*
|
196 |
* Results:
|
197 |
* The return value is TCL_OK if the command was parsed
|
198 |
* successfully and TCL_ERROR otherwise. If an error occurs
|
199 |
* and interp isn't NULL then an error message is left in
|
200 |
* its result. On a successful return, parsePtr is filled in
|
201 |
* with information about the command that was parsed.
|
202 |
*
|
203 |
* Side effects:
|
204 |
* If there is insufficient space in parsePtr to hold all the
|
205 |
* information about the command, then additional space is
|
206 |
* malloc-ed. If the procedure returns TCL_OK then the caller must
|
207 |
* eventually invoke Tcl_FreeParse to release any additional space
|
208 |
* that was allocated.
|
209 |
*
|
210 |
*----------------------------------------------------------------------
|
211 |
*/
|
212 |
|
213 |
int
|
214 |
Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
|
215 |
Tcl_Interp *interp; /* Interpreter to use for error reporting;
|
216 |
* if NULL, then no error message is
|
217 |
* provided. */
|
218 |
char *string; /* First character of string containing
|
219 |
* one or more Tcl commands. The string
|
220 |
* must be in writable memory and must
|
221 |
* have one additional byte of space at
|
222 |
* string[length] where we can
|
223 |
* temporarily store a 0 sentinel
|
224 |
* character. */
|
225 |
int numBytes; /* Total number of bytes in string. If < 0,
|
226 |
* the script consists of all bytes up to
|
227 |
* the first null character. */
|
228 |
int nested; /* Non-zero means this is a nested command:
|
229 |
* close bracket should be considered
|
230 |
* a command terminator. If zero, then close
|
231 |
* bracket has no special meaning. */
|
232 |
register Tcl_Parse *parsePtr;
|
233 |
/* Structure to fill in with information
|
234 |
* about the parsed command; any previous
|
235 |
* information in the structure is
|
236 |
* ignored. */
|
237 |
{
|
238 |
register char *src; /* Points to current character
|
239 |
* in the command. */
|
240 |
int type; /* Result returned by CHAR_TYPE(*src). */
|
241 |
Tcl_Token *tokenPtr; /* Pointer to token being filled in. */
|
242 |
int wordIndex; /* Index of word token for current word. */
|
243 |
char utfBytes[TCL_UTF_MAX]; /* Holds result of backslash substitution. */
|
244 |
int terminators; /* CHAR_TYPE bits that indicate the end
|
245 |
* of a command. */
|
246 |
char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to
|
247 |
* point to char after terminating one. */
|
248 |
int length, savedChar;
|
249 |
|
250 |
|
251 |
if (numBytes < 0) {
|
252 |
numBytes = (string? strlen(string) : 0);
|
253 |
}
|
254 |
parsePtr->commentStart = NULL;
|
255 |
parsePtr->commentSize = 0;
|
256 |
parsePtr->commandStart = NULL;
|
257 |
parsePtr->commandSize = 0;
|
258 |
parsePtr->numWords = 0;
|
259 |
parsePtr->tokenPtr = parsePtr->staticTokens;
|
260 |
parsePtr->numTokens = 0;
|
261 |
parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
|
262 |
parsePtr->string = string;
|
263 |
parsePtr->end = string + numBytes;
|
264 |
parsePtr->term = parsePtr->end;
|
265 |
parsePtr->interp = interp;
|
266 |
parsePtr->incomplete = 0;
|
267 |
parsePtr->errorType = TCL_PARSE_SUCCESS;
|
268 |
if (nested != 0) {
|
269 |
terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK;
|
270 |
} else {
|
271 |
terminators = TYPE_COMMAND_END;
|
272 |
}
|
273 |
|
274 |
/*
|
275 |
* Temporarily overwrite the character just after the end of the
|
276 |
* string with a 0 byte. This acts as a sentinel and reduces the
|
277 |
* number of places where we have to check for the end of the
|
278 |
* input string. The original value of the byte is restored at
|
279 |
* the end of the parse.
|
280 |
*/
|
281 |
|
282 |
savedChar = string[numBytes];
|
283 |
if (savedChar != 0) {
|
284 |
string[numBytes] = 0;
|
285 |
}
|
286 |
|
287 |
/*
|
288 |
* Parse any leading space and comments before the first word of the
|
289 |
* command.
|
290 |
*/
|
291 |
|
292 |
src = string;
|
293 |
while (1) {
|
294 |
while ((CHAR_TYPE(*src) == TYPE_SPACE) || (*src == '\n')) {
|
295 |
src++;
|
296 |
}
|
297 |
if ((*src == '\\') && (src[1] == '\n')) {
|
298 |
/*
|
299 |
* Skip backslash-newline sequence: it should be treated
|
300 |
* just like white space.
|
301 |
*/
|
302 |
|
303 |
if ((src + 2) == parsePtr->end) {
|
304 |
parsePtr->incomplete = 1;
|
305 |
}
|
306 |
src += 2;
|
307 |
continue;
|
308 |
}
|
309 |
if (*src != '#') {
|
310 |
break;
|
311 |
}
|
312 |
if (parsePtr->commentStart == NULL) {
|
313 |
parsePtr->commentStart = src;
|
314 |
}
|
315 |
while (1) {
|
316 |
if (src == parsePtr->end) {
|
317 |
if (nested) {
|
318 |
parsePtr->incomplete = nested;
|
319 |
}
|
320 |
parsePtr->commentSize = src - parsePtr->commentStart;
|
321 |
break;
|
322 |
} else if (*src == '\\') {
|
323 |
if ((src[1] == '\n') && ((src + 2) == parsePtr->end)) {
|
324 |
parsePtr->incomplete = 1;
|
325 |
}
|
326 |
Tcl_UtfBackslash(src, &length, utfBytes);
|
327 |
src += length;
|
328 |
} else if (*src == '\n') {
|
329 |
src++;
|
330 |
parsePtr->commentSize = src - parsePtr->commentStart;
|
331 |
break;
|
332 |
} else {
|
333 |
src++;
|
334 |
}
|
335 |
}
|
336 |
}
|
337 |
|
338 |
/*
|
339 |
* The following loop parses the words of the command, one word
|
340 |
* in each iteration through the loop.
|
341 |
*/
|
342 |
|
343 |
parsePtr->commandStart = src;
|
344 |
while (1) {
|
345 |
/*
|
346 |
* Create the token for the word.
|
347 |
*/
|
348 |
|
349 |
if (parsePtr->numTokens == parsePtr->tokensAvailable) {
|
350 |
TclExpandTokenArray(parsePtr);
|
351 |
}
|
352 |
wordIndex = parsePtr->numTokens;
|
353 |
tokenPtr = &parsePtr->tokenPtr[wordIndex];
|
354 |
tokenPtr->type = TCL_TOKEN_WORD;
|
355 |
|
356 |
/*
|
357 |
* Skip white space before the word. Also skip a backslash-newline
|
358 |
* sequence: it should be treated just like white space.
|
359 |
*/
|
360 |
|
361 |
while (1) {
|
362 |
type = CHAR_TYPE(*src);
|
363 |
if (type == TYPE_SPACE) {
|
364 |
src++;
|
365 |
continue;
|
366 |
} else if ((*src == '\\') && (src[1] == '\n')) {
|
367 |
if ((src + 2) == parsePtr->end) {
|
368 |
parsePtr->incomplete = 1;
|
369 |
}
|
370 |
Tcl_UtfBackslash(src, &length, utfBytes);
|
371 |
src += length;
|
372 |
continue;
|
373 |
}
|
374 |
break;
|
375 |
}
|
376 |
if ((type & terminators) != 0) {
|
377 |
parsePtr->term = src;
|
378 |
src++;
|
379 |
break;
|
380 |
}
|
381 |
if (src == parsePtr->end) {
|
382 |
break;
|
383 |
}
|
384 |
tokenPtr->start = src;
|
385 |
parsePtr->numTokens++;
|
386 |
parsePtr->numWords++;
|
387 |
|
388 |
/*
|
389 |
* At this point the word can have one of three forms: something
|
390 |
* enclosed in quotes, something enclosed in braces, or an
|
391 |
* unquoted word (anything else).
|
392 |
*/
|
393 |
|
394 |
if (*src == '"') {
|
395 |
if (Tcl_ParseQuotedString(interp, src, (parsePtr->end - src),
|
396 |
parsePtr, 1, &termPtr) != TCL_OK) {
|
397 |
goto error;
|
398 |
}
|
399 |
src = termPtr;
|
400 |
} else if (*src == '{') {
|
401 |
if (Tcl_ParseBraces(interp, src, (parsePtr->end - src),
|
402 |
parsePtr, 1, &termPtr) != TCL_OK) {
|
403 |
goto error;
|
404 |
}
|
405 |
src = termPtr;
|
406 |
} else {
|
407 |
/*
|
408 |
* This is an unquoted word. Call ParseTokens and let it do
|
409 |
* all of the work.
|
410 |
*/
|
411 |
|
412 |
if (ParseTokens(src, TYPE_SPACE|terminators,
|
413 |
parsePtr) != TCL_OK) {
|
414 |
goto error;
|
415 |
}
|
416 |
src = parsePtr->term;
|
417 |
}
|
418 |
|
419 |
/*
|
420 |
* Finish filling in the token for the word and check for the
|
421 |
* special case of a word consisting of a single range of
|
422 |
* literal text.
|
423 |
*/
|
424 |
|
425 |
tokenPtr = &parsePtr->tokenPtr[wordIndex];
|
426 |
tokenPtr->size = src - tokenPtr->start;
|
427 |
tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1);
|
428 |
if ((tokenPtr->numComponents == 1)
|
429 |
&& (tokenPtr[1].type == TCL_TOKEN_TEXT)) {
|
430 |
tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
|
431 |
}
|
432 |
|
433 |
/*
|
434 |
* Do two additional checks: (a) make sure we're really at the
|
435 |
* end of a word (there might have been garbage left after a
|
436 |
* quoted or braced word), and (b) check for the end of the
|
437 |
* command.
|
438 |
*/
|
439 |
|
440 |
type = CHAR_TYPE(*src);
|
441 |
if (type == TYPE_SPACE) {
|
442 |
src++;
|
443 |
continue;
|
444 |
} else {
|
445 |
/*
|
446 |
* Backslash-newline (and any following white space) must be
|
447 |
* treated as if it were a space character.
|
448 |
*/
|
449 |
|
450 |
if ((*src == '\\') && (src[1] == '\n')) {
|
451 |
if ((src + 2) == parsePtr->end) {
|
452 |
parsePtr->incomplete = 1;
|
453 |
}
|
454 |
Tcl_UtfBackslash(src, &length, utfBytes);
|
455 |
src += length;
|
456 |
continue;
|
457 |
}
|
458 |
}
|
459 |
|
460 |
if ((type & terminators) != 0) {
|
461 |
parsePtr->term = src;
|
462 |
src++;
|
463 |
break;
|
464 |
}
|
465 |
if (src == parsePtr->end) {
|
466 |
break;
|
467 |
}
|
468 |
if (src[-1] == '"') {
|
469 |
if (interp != NULL) {
|
470 |
Tcl_SetResult(interp, "extra characters after close-quote",
|
471 |
TCL_STATIC);
|
472 |
}
|
473 |
parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
|
474 |
} else {
|
475 |
if (interp != NULL) {
|
476 |
Tcl_SetResult(interp, "extra characters after close-brace",
|
477 |
TCL_STATIC);
|
478 |
}
|
479 |
parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
|
480 |
}
|
481 |
parsePtr->term = src;
|
482 |
goto error;
|
483 |
}
|
484 |
|
485 |
|
486 |
parsePtr->commandSize = src - parsePtr->commandStart;
|
487 |
if (savedChar != 0) {
|
488 |
string[numBytes] = (char) savedChar;
|
489 |
}
|
490 |
return TCL_OK;
|
491 |
|
492 |
error:
|
493 |
if (savedChar != 0) {
|
494 |
string[numBytes] = (char) savedChar;
|
495 |
}
|
496 |
Tcl_FreeParse(parsePtr);
|
497 |
if (parsePtr->commandStart == NULL) {
|
498 |
parsePtr->commandStart = string;
|
499 |
}
|
500 |
parsePtr->commandSize = parsePtr->term - parsePtr->commandStart;
|
501 |
return TCL_ERROR;
|
502 |
}
|
503 |
|
504 |
/*
|
505 |
*----------------------------------------------------------------------
|
506 |
*
|
507 |
* ParseTokens --
|
508 |
*
|
509 |
* This procedure forms the heart of the Tcl parser. It parses one
|
510 |
* or more tokens from a string, up to a termination point
|
511 |
* specified by the caller. This procedure is used to parse
|
512 |
* unquoted command words (those not in quotes or braces), words in
|
513 |
* quotes, and array indices for variables.
|
514 |
*
|
515 |
* Results:
|
516 |
* Tokens are added to parsePtr and parsePtr->term is filled in
|
517 |
* with the address of the character that terminated the parse (the
|
518 |
* first one whose CHAR_TYPE matched mask or the character at
|
519 |
* parsePtr->end). The return value is TCL_OK if the parse
|
520 |
* completed successfully and TCL_ERROR otherwise. If a parse
|
521 |
* error occurs and parsePtr->interp isn't NULL, then an error
|
522 |
* message is left in the interpreter's result.
|
523 |
*
|
524 |
* Side effects:
|
525 |
* None.
|
526 |
*
|
527 |
*----------------------------------------------------------------------
|
528 |
*/
|
529 |
|
530 |
static int
|
531 |
ParseTokens(src, mask, parsePtr)
|
532 |
register char *src; /* First character to parse. */
|
533 |
int mask; /* Specifies when to stop parsing. The
|
534 |
* parse stops at the first unquoted
|
535 |
* character whose CHAR_TYPE contains
|
536 |
* any of the bits in mask. */
|
537 |
Tcl_Parse *parsePtr; /* Information about parse in progress.
|
538 |
* Updated with additional tokens and
|
539 |
* termination information. */
|
540 |
{
|
541 |
int type, originalTokens, varToken;
|
542 |
char utfBytes[TCL_UTF_MAX];
|
543 |
Tcl_Token *tokenPtr;
|
544 |
Tcl_Parse nested;
|
545 |
|
546 |
/*
|
547 |
* Each iteration through the following loop adds one token of
|
548 |
* type TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or
|
549 |
* TCL_TOKEN_VARIABLE to parsePtr. For TCL_TOKEN_VARIABLE tokens,
|
550 |
* additional tokens are added for the parsed variable name.
|
551 |
*/
|
552 |
|
553 |
originalTokens = parsePtr->numTokens;
|
554 |
while (1) {
|
555 |
if (parsePtr->numTokens == parsePtr->tokensAvailable) {
|
556 |
TclExpandTokenArray(parsePtr);
|
557 |
}
|
558 |
tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
|
559 |
tokenPtr->start = src;
|
560 |
tokenPtr->numComponents = 0;
|
561 |
|
562 |
type = CHAR_TYPE(*src);
|
563 |
if (type & mask) {
|
564 |
break;
|
565 |
}
|
566 |
|
567 |
if ((type & TYPE_SUBS) == 0) {
|
568 |
/*
|
569 |
* This is a simple range of characters. Scan to find the end
|
570 |
* of the range.
|
571 |
*/
|
572 |
|
573 |
while (1) {
|
574 |
src++;
|
575 |
if (CHAR_TYPE(*src) & (mask | TYPE_SUBS)) {
|
576 |
break;
|
577 |
}
|
578 |
}
|
579 |
tokenPtr->type = TCL_TOKEN_TEXT;
|
580 |
tokenPtr->size = src - tokenPtr->start;
|
581 |
parsePtr->numTokens++;
|
582 |
} else if (*src == '$') {
|
583 |
/*
|
584 |
* This is a variable reference. Call Tcl_ParseVarName to do
|
585 |
* all the dirty work of parsing the name.
|
586 |
*/
|
587 |
|
588 |
varToken = parsePtr->numTokens;
|
589 |
if (Tcl_ParseVarName(parsePtr->interp, src, parsePtr->end - src,
|
590 |
parsePtr, 1) != TCL_OK) {
|
591 |
return TCL_ERROR;
|
592 |
}
|
593 |
src += parsePtr->tokenPtr[varToken].size;
|
594 |
} else if (*src == '[') {
|
595 |
/*
|
596 |
* Command substitution. Call Tcl_ParseCommand recursively
|
597 |
* (and repeatedly) to parse the nested command(s), then
|
598 |
* throw away the parse information.
|
599 |
*/
|
600 |
|
601 |
src++;
|
602 |
while (1) {
|
603 |
if (Tcl_ParseCommand(parsePtr->interp, src,
|
604 |
parsePtr->end - src, 1, &nested) != TCL_OK) {
|
605 |
parsePtr->errorType = nested.errorType;
|
606 |
parsePtr->term = nested.term;
|
607 |
parsePtr->incomplete = nested.incomplete;
|
608 |
return TCL_ERROR;
|
609 |
}
|
610 |
src = nested.commandStart + nested.commandSize;
|
611 |
if (nested.tokenPtr != nested.staticTokens) {
|
612 |
ckfree((char *) nested.tokenPtr);
|
613 |
}
|
614 |
if ((*nested.term == ']') && !nested.incomplete) {
|
615 |
break;
|
616 |
}
|
617 |
if (src == parsePtr->end) {
|
618 |
if (parsePtr->interp != NULL) {
|
619 |
Tcl_SetResult(parsePtr->interp,
|
620 |
"missing close-bracket", TCL_STATIC);
|
621 |
}
|
622 |
parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
|
623 |
parsePtr->term = tokenPtr->start;
|
624 |
parsePtr->incomplete = 1;
|
625 |
return TCL_ERROR;
|
626 |
}
|
627 |
}
|
628 |
tokenPtr->type = TCL_TOKEN_COMMAND;
|
629 |
tokenPtr->size = src - tokenPtr->start;
|
630 |
parsePtr->numTokens++;
|
631 |
} else if (*src == '\\') {
|
632 |
/*
|
633 |
* Backslash substitution.
|
634 |
*/
|
635 |
|
636 |
if (src[1] == '\n') {
|
637 |
if ((src + 2) == parsePtr->end) {
|
638 |
parsePtr->incomplete = 1;
|
639 |
}
|
640 |
|
641 |
/*
|
642 |
* Note: backslash-newline is special in that it is
|
643 |
* treated the same as a space character would be. This
|
644 |
* means that it could terminate the token.
|
645 |
*/
|
646 |
|
647 |
if (mask & TYPE_SPACE) {
|
648 |
break;
|
649 |
}
|
650 |
}
|
651 |
tokenPtr->type = TCL_TOKEN_BS;
|
652 |
Tcl_UtfBackslash(src, &tokenPtr->size, utfBytes);
|
653 |
parsePtr->numTokens++;
|
654 |
src += tokenPtr->size;
|
655 |
} else if (*src == 0) {
|
656 |
/*
|
657 |
* We encountered a null character. If it is the null
|
658 |
* character at the end of the string, then return.
|
659 |
* Otherwise generate a text token for the single
|
660 |
* character.
|
661 |
*/
|
662 |
|
663 |
if (src == parsePtr->end) {
|
664 |
break;
|
665 |
}
|
666 |
tokenPtr->type = TCL_TOKEN_TEXT;
|
667 |
tokenPtr->size = 1;
|
668 |
parsePtr->numTokens++;
|
669 |
src++;
|
670 |
} else {
|
671 |
panic("ParseTokens encountered unknown character");
|
672 |
}
|
673 |
}
|
674 |
if (parsePtr->numTokens == originalTokens) {
|
675 |
/*
|
676 |
* There was nothing in this range of text. Add an empty token
|
677 |
* for the empty range, so that there is always at least one
|
678 |
* token added.
|
679 |
*/
|
680 |
|
681 |
tokenPtr->type = TCL_TOKEN_TEXT;
|
682 |
tokenPtr->size = 0;
|
683 |
parsePtr->numTokens++;
|
684 |
}
|
685 |
parsePtr->term = src;
|
686 |
return TCL_OK;
|
687 |
}
|
688 |
|
689 |
/*
|
690 |
*----------------------------------------------------------------------
|
691 |
*
|
692 |
* Tcl_FreeParse --
|
693 |
*
|
694 |
* This procedure is invoked to free any dynamic storage that may
|
695 |
* have been allocated by a previous call to Tcl_ParseCommand.
|
696 |
*
|
697 |
* Results:
|
698 |
* None.
|
699 |
*
|
700 |
* Side effects:
|
701 |
* If there is any dynamically allocated memory in *parsePtr,
|
702 |
* it is freed.
|
703 |
*
|
704 |
*----------------------------------------------------------------------
|
705 |
*/
|
706 |
|
707 |
void
|
708 |
Tcl_FreeParse(parsePtr)
|
709 |
Tcl_Parse *parsePtr; /* Structure that was filled in by a
|
710 |
* previous call to Tcl_ParseCommand. */
|
711 |
{
|
712 |
if (parsePtr->tokenPtr != parsePtr->staticTokens) {
|
713 |
ckfree((char *) parsePtr->tokenPtr);
|
714 |
parsePtr->tokenPtr = parsePtr->staticTokens;
|
715 |
}
|
716 |
}
|
717 |
|
718 |
/*
|
719 |
*----------------------------------------------------------------------
|
720 |
*
|
721 |
* TclExpandTokenArray --
|
722 |
*
|
723 |
* This procedure is invoked when the current space for tokens in
|
724 |
* a Tcl_Parse structure fills up; it allocates memory to grow the
|
725 |
* token array
|
726 |
*
|
727 |
* Results:
|
728 |
* None.
|
729 |
*
|
730 |
* Side effects:
|
731 |
* Memory is allocated for a new larger token array; the memory
|
732 |
* for the old array is freed, if it had been dynamically allocated.
|
733 |
*
|
734 |
*----------------------------------------------------------------------
|
735 |
*/
|
736 |
|
737 |
void
|
738 |
TclExpandTokenArray(parsePtr)
|
739 |
Tcl_Parse *parsePtr; /* Parse structure whose token space
|
740 |
* has overflowed. */
|
741 |
{
|
742 |
int newCount;
|
743 |
Tcl_Token *newPtr;
|
744 |
|
745 |
newCount = parsePtr->tokensAvailable*2;
|
746 |
newPtr = (Tcl_Token *) ckalloc((unsigned) (newCount * sizeof(Tcl_Token)));
|
747 |
memcpy((VOID *) newPtr, (VOID *) parsePtr->tokenPtr,
|
748 |
(size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token)));
|
749 |
if (parsePtr->tokenPtr != parsePtr->staticTokens) {
|
750 |
ckfree((char *) parsePtr->tokenPtr);
|
751 |
}
|
752 |
parsePtr->tokenPtr = newPtr;
|
753 |
parsePtr->tokensAvailable = newCount;
|
754 |
}
|
755 |
|
756 |
/*
|
757 |
*----------------------------------------------------------------------
|
758 |
*
|
759 |
* EvalObjv --
|
760 |
*
|
761 |
* This procedure evaluates a Tcl command that has already been
|
762 |
* parsed into words, with one Tcl_Obj holding each word.
|
763 |
*
|
764 |
* Results:
|
765 |
* The return value is a standard Tcl completion code such as
|
766 |
* TCL_OK or TCL_ERROR. A result or error message is left in
|
767 |
* interp's result. If an error occurs, this procedure does
|
768 |
* NOT add any information to the errorInfo variable.
|
769 |
*
|
770 |
* Side effects:
|
771 |
* Depends on the command.
|
772 |
*
|
773 |
*----------------------------------------------------------------------
|
774 |
*/
|
775 |
|
776 |
static int
|
777 |
EvalObjv(interp, objc, objv, command, length, flags)
|
778 |
Tcl_Interp *interp; /* Interpreter in which to evaluate the
|
779 |
* command. Also used for error
|
780 |
* reporting. */
|
781 |
int objc; /* Number of words in command. */
|
782 |
Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
|
783 |
* the words that make up the command. */
|
784 |
char *command; /* Points to the beginning of the string
|
785 |
* representation of the command; this
|
786 |
* is used for traces. If the string
|
787 |
* representation of the command is
|
788 |
* unknown, an empty string should be
|
789 |
* supplied. */
|
790 |
int length; /* Number of bytes in command; if -1, all
|
791 |
* characters up to the first null byte are
|
792 |
* used. */
|
793 |
int flags; /* Collection of OR-ed bits that control
|
794 |
* the evaluation of the script. Only
|
795 |
* TCL_EVAL_GLOBAL is currently
|
796 |
* supported. */
|
797 |
|
798 |
{
|
799 |
Command *cmdPtr;
|
800 |
Interp *iPtr = (Interp *) interp;
|
801 |
Tcl_Obj **newObjv;
|
802 |
int i, code;
|
803 |
Trace *tracePtr, *nextPtr;
|
804 |
char **argv, *commandCopy;
|
805 |
CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr
|
806 |
* in case TCL_EVAL_GLOBAL was set. */
|
807 |
|
808 |
Tcl_ResetResult(interp);
|
809 |
if (objc == 0) {
|
810 |
return TCL_OK;
|
811 |
}
|
812 |
|
813 |
/*
|
814 |
* If the interpreter was deleted, return an error.
|
815 |
*/
|
816 |
|
817 |
if (iPtr->flags & DELETED) {
|
818 |
Tcl_AppendToObj(Tcl_GetObjResult(interp),
|
819 |
"attempt to call eval in deleted interpreter", -1);
|
820 |
Tcl_SetErrorCode(interp, "CORE", "IDELETE",
|
821 |
"attempt to call eval in deleted interpreter",
|
822 |
(char *) NULL);
|
823 |
return TCL_ERROR;
|
824 |
}
|
825 |
|
826 |
/*
|
827 |
* Check depth of nested calls to Tcl_Eval: if this gets too large,
|
828 |
* it's probably because of an infinite loop somewhere.
|
829 |
*/
|
830 |
|
831 |
if (iPtr->numLevels >= iPtr->maxNestingDepth) {
|
832 |
iPtr->result = "too many nested calls to Tcl_Eval (infinite loop?)";
|
833 |
return TCL_ERROR;
|
834 |
}
|
835 |
iPtr->numLevels++;
|
836 |
|
837 |
/*
|
838 |
* On the Mac, we will never reach the default recursion limit before
|
839 |
* blowing the stack. So we need to do a check here.
|
840 |
*/
|
841 |
|
842 |
if (TclpCheckStackSpace() == 0) {
|
843 |
/*NOTREACHED*/
|
844 |
iPtr->numLevels--;
|
845 |
iPtr->result = "too many nested calls to Tcl_Eval (infinite loop?)";
|
846 |
return TCL_ERROR;
|
847 |
}
|
848 |
|
849 |
/*
|
850 |
* Find the procedure to execute this command. If there isn't one,
|
851 |
* then see if there is a command "unknown". If so, create a new
|
852 |
* word array with "unknown" as the first word and the original
|
853 |
* command words as arguments. Then call ourselves recursively
|
854 |
* to execute it.
|
855 |
*/
|
856 |
|
857 |
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
|
858 |
if (cmdPtr == NULL) {
|
859 |
newObjv = (Tcl_Obj **) ckalloc((unsigned)
|
860 |
((objc + 1) * sizeof (Tcl_Obj *)));
|
861 |
for (i = objc-1; i >= 0; i--) {
|
862 |
newObjv[i+1] = objv[i];
|
863 |
}
|
864 |
newObjv[0] = Tcl_NewStringObj("unknown", -1);
|
865 |
Tcl_IncrRefCount(newObjv[0]);
|
866 |
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
|
867 |
if (cmdPtr == NULL) {
|
868 |
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
869 |
"invalid command name \"", Tcl_GetString(objv[0]), "\"",
|
870 |
(char *) NULL);
|
871 |
code = TCL_ERROR;
|
872 |
} else {
|
873 |
code = EvalObjv(interp, objc+1, newObjv, command, length, 0);
|
874 |
}
|
875 |
Tcl_DecrRefCount(newObjv[0]);
|
876 |
ckfree((char *) newObjv);
|
877 |
goto done;
|
878 |
}
|
879 |
|
880 |
/*
|
881 |
* Call trace procedures if needed.
|
882 |
*/
|
883 |
|
884 |
argv = NULL;
|
885 |
commandCopy = command;
|
886 |
|
887 |
for (tracePtr = iPtr->tracePtr; tracePtr != NULL; tracePtr = nextPtr) {
|
888 |
nextPtr = tracePtr->nextPtr;
|
889 |
if (iPtr->numLevels > tracePtr->level) {
|
890 |
continue;
|
891 |
}
|
892 |
|
893 |
/*
|
894 |
* This is a bit messy because we have to emulate the old trace
|
895 |
* interface, which uses strings for everything.
|
896 |
*/
|
897 |
|
898 |
if (argv == NULL) {
|
899 |
argv = (char **) ckalloc((unsigned) (objc + 1) * sizeof(char *));
|
900 |
for (i = 0; i < objc; i++) {
|
901 |
argv[i] = Tcl_GetString(objv[i]);
|
902 |
}
|
903 |
argv[objc] = 0;
|
904 |
|
905 |
if (length < 0) {
|
906 |
length = strlen(command);
|
907 |
} else if ((size_t)length < strlen(command)) {
|
908 |
commandCopy = (char *) ckalloc((unsigned) (length + 1));
|
909 |
strncpy(commandCopy, command, (size_t) length);
|
910 |
commandCopy[length] = 0;
|
911 |
}
|
912 |
}
|
913 |
(*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
|
914 |
commandCopy, cmdPtr->proc, cmdPtr->clientData,
|
915 |
objc, argv);
|
916 |
}
|
917 |
if (argv != NULL) {
|
918 |
ckfree((char *) argv);
|
919 |
}
|
920 |
if (commandCopy != command) {
|
921 |
ckfree((char *) commandCopy);
|
922 |
}
|
923 |
|
924 |
/*
|
925 |
* Finally, invoke the command's Tcl_ObjCmdProc.
|
926 |
*/
|
927 |
|
928 |
iPtr->cmdCount++;
|
929 |
savedVarFramePtr = iPtr->varFramePtr;
|
930 |
if (flags & TCL_EVAL_GLOBAL) {
|
931 |
iPtr->varFramePtr = NULL;
|
932 |
}
|
933 |
code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
|
934 |
iPtr->varFramePtr = savedVarFramePtr;
|
935 |
if (Tcl_AsyncReady()) {
|
936 |
code = Tcl_AsyncInvoke(interp, code);
|
937 |
}
|
938 |
|
939 |
/*
|
940 |
* If the interpreter has a non-empty string result, the result
|
941 |
* object is either empty or stale because some procedure set
|
942 |
* interp->result directly. If so, move the string result to the
|
943 |
* result object, then reset the string result.
|
944 |
*/
|
945 |
|
946 |
if (*(iPtr->result) != 0) {
|
947 |
(void) Tcl_GetObjResult(interp);
|
948 |
}
|
949 |
|
950 |
done:
|
951 |
iPtr->numLevels--;
|
952 |
return code;
|
953 |
}
|
954 |
|
955 |
/*
|
956 |
*----------------------------------------------------------------------
|
957 |
*
|
958 |
* Tcl_EvalObjv --
|
959 |
*
|
960 |
* This procedure evaluates a Tcl command that has already been
|
961 |
* parsed into words, with one Tcl_Obj holding each word.
|
962 |
*
|
963 |
* Results:
|
964 |
* The return value is a standard Tcl completion code such as
|
965 |
* TCL_OK or TCL_ERROR. A result or error message is left in
|
966 |
* interp's result.
|
967 |
*
|
968 |
* Side effects:
|
969 |
* Depends on the command.
|
970 |
*
|
971 |
*----------------------------------------------------------------------
|
972 |
*/
|
973 |
|
974 |
int
|
975 |
Tcl_EvalObjv(interp, objc, objv, flags)
|
976 |
Tcl_Interp *interp; /* Interpreter in which to evaluate the
|
977 |
* command. Also used for error
|
978 |
* reporting. */
|
979 |
int objc; /* Number of words in command. */
|
980 |
Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
|
981 |
* the words that make up the command. */
|
982 |
int flags; /* Collection of OR-ed bits that control
|
983 |
* the evaluation of the script. Only
|
984 |
* TCL_EVAL_GLOBAL is currently
|
985 |
* supported. */
|
986 |
{
|
987 |
Interp *iPtr = (Interp *)interp;
|
988 |
Trace *tracePtr;
|
989 |
Tcl_DString cmdBuf;
|
990 |
char *cmdString = "";
|
991 |
int cmdLen = 0;
|
992 |
int code = TCL_OK;
|
993 |
|
994 |
for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) {
|
995 |
/*
|
996 |
* EvalObjv will increment numLevels so use "<" rather than "<="
|
997 |
*/
|
998 |
if (iPtr->numLevels < tracePtr->level) {
|
999 |
int i;
|
1000 |
/*
|
1001 |
* The command will be needed for an execution trace or stack trace
|
1002 |
* generate a command string.
|
1003 |
*/
|
1004 |
cmdtraced:
|
1005 |
Tcl_DStringInit(&cmdBuf);
|
1006 |
for (i = 0; i < objc; i++) {
|
1007 |
Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
|
1008 |
}
|
1009 |
cmdString = Tcl_DStringValue(&cmdBuf);
|
1010 |
cmdLen = Tcl_DStringLength(&cmdBuf);
|
1011 |
break;
|
1012 |
}
|
1013 |
}
|
1014 |
|
1015 |
/*
|
1016 |
* Execute the command if we have not done so already
|
1017 |
*/
|
1018 |
switch (code) {
|
1019 |
case TCL_OK:
|
1020 |
code = EvalObjv(interp, objc, objv, cmdString, cmdLen, flags);
|
1021 |
if (code == TCL_ERROR && cmdLen == 0)
|
1022 |
goto cmdtraced;
|
1023 |
break;
|
1024 |
case TCL_ERROR:
|
1025 |
Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
|
1026 |
break;
|
1027 |
default:
|
1028 |
/*NOTREACHED*/
|
1029 |
break;
|
1030 |
}
|
1031 |
|
1032 |
if (cmdLen != 0) {
|
1033 |
Tcl_DStringFree(&cmdBuf);
|
1034 |
}
|
1035 |
return code;
|
1036 |
}
|
1037 |
|
1038 |
/*
|
1039 |
*----------------------------------------------------------------------
|
1040 |
*
|
1041 |
* Tcl_LogCommandInfo --
|
1042 |
*
|
1043 |
* This procedure is invoked after an error occurs in an interpreter.
|
1044 |
* It adds information to the "errorInfo" variable to describe the
|
1045 |
* command that was being executed when the error occurred.
|
1046 |
*
|
1047 |
* Results:
|
1048 |
* None.
|
1049 |
*
|
1050 |
* Side effects:
|
1051 |
* Information about the command is added to errorInfo and the
|
1052 |
* line number stored internally in the interpreter is set. If this
|
1053 |
* is the first call to this procedure or Tcl_AddObjErrorInfo since
|
1054 |
* an error occurred, then old information in errorInfo is
|
1055 |
* deleted.
|
1056 |
*
|
1057 |
*----------------------------------------------------------------------
|
1058 |
*/
|
1059 |
|
1060 |
void
|
1061 |
Tcl_LogCommandInfo(interp, script, command, length)
|
1062 |
Tcl_Interp *interp; /* Interpreter in which to log information. */
|
1063 |
char *script; /* First character in script containing
|
1064 |
* command (must be <= command). */
|
1065 |
char *command; /* First character in command that
|
1066 |
* generated the error. */
|
1067 |
int length; /* Number of bytes in command (-1 means
|
1068 |
* use all bytes up to first null byte). */
|
1069 |
{
|
1070 |
char buffer[200];
|
1071 |
register char *p;
|
1072 |
char *ellipsis = "";
|
1073 |
Interp *iPtr = (Interp *) interp;
|
1074 |
|
1075 |
if (iPtr->flags & ERR_ALREADY_LOGGED) {
|
1076 |
/*
|
1077 |
* Someone else has already logged error information for this
|
1078 |
* command; we shouldn't add anything more.
|
1079 |
*/
|
1080 |
|
1081 |
return;
|
1082 |
}
|
1083 |
|
1084 |
/*
|
1085 |
* Compute the line number where the error occurred.
|
1086 |
*/
|
1087 |
|
1088 |
iPtr->errorLine = 1;
|
1089 |
for (p = script; p != command; p++) {
|
1090 |
if (*p == '\n') {
|
1091 |
iPtr->errorLine++;
|
1092 |
}
|
1093 |
}
|
1094 |
|
1095 |
/*
|
1096 |
* Create an error message to add to errorInfo, including up to a
|
1097 |
* maximum number of characters of the command.
|
1098 |
*/
|
1099 |
|
1100 |
if (length < 0) {
|
1101 |
length = strlen(command);
|
1102 |
}
|
1103 |
if (length > 150) {
|
1104 |
length = 150;
|
1105 |
ellipsis = "...";
|
1106 |
}
|
1107 |
if (!(iPtr->flags & ERR_IN_PROGRESS)) {
|
1108 |
sprintf(buffer, "\n while executing\n\"%.*s%s\"",
|
1109 |
length, command, ellipsis);
|
1110 |
} else {
|
1111 |
sprintf(buffer, "\n invoked from within\n\"%.*s%s\"",
|
1112 |
length, command, ellipsis);
|
1113 |
}
|
1114 |
Tcl_AddObjErrorInfo(interp, buffer, -1);
|
1115 |
iPtr->flags &= ~ERR_ALREADY_LOGGED;
|
1116 |
}
|
1117 |
|
1118 |
/*
|
1119 |
*----------------------------------------------------------------------
|
1120 |
*
|
1121 |
* Tcl_EvalTokens --
|
1122 |
*
|
1123 |
* Given an array of tokens parsed from a Tcl command (e.g., the
|
1124 |
* tokens that make up a word or the index for an array variable)
|
1125 |
* this procedure evaluates the tokens and concatenates their
|
1126 |
* values to form a single result value.
|
1127 |
*
|
1128 |
* Results:
|
1129 |
* The return value is a pointer to a newly allocated Tcl_Obj
|
1130 |
* containing the value of the array of tokens. The reference
|
1131 |
* count of the returned object has been incremented. If an error
|
1132 |
* occurs in evaluating the tokens then a NULL value is returned
|
1133 |
* and an error message is left in interp's result.
|
1134 |
*
|
1135 |
* Side effects:
|
1136 |
* A new object is allocated to hold the result.
|
1137 |
*
|
1138 |
*----------------------------------------------------------------------
|
1139 |
*/
|
1140 |
|
1141 |
Tcl_Obj *
|
1142 |
Tcl_EvalTokens(interp, tokenPtr, count)
|
1143 |
Tcl_Interp *interp; /* Interpreter in which to lookup
|
1144 |
* variables, execute nested commands,
|
1145 |
* and report errors. */
|
1146 |
Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens
|
1147 |
* to evaluate and concatenate. */
|
1148 |
int count; /* Number of tokens to consider at tokenPtr.
|
1149 |
* Must be at least 1. */
|
1150 |
{
|
1151 |
Tcl_Obj *resultPtr, *indexPtr, *valuePtr, *newPtr;
|
1152 |
char buffer[TCL_UTF_MAX];
|
1153 |
#ifdef TCL_MEM_DEBUG
|
1154 |
# define MAX_VAR_CHARS 5
|
1155 |
#else
|
1156 |
# define MAX_VAR_CHARS 30
|
1157 |
#endif
|
1158 |
char nameBuffer[MAX_VAR_CHARS+1];
|
1159 |
char *varName, *index;
|
1160 |
char *p = NULL; /* Initialized to avoid compiler warning. */
|
1161 |
int length, code;
|
1162 |
|
1163 |
/*
|
1164 |
* The only tricky thing about this procedure is that it attempts to
|
1165 |
* avoid object creation and string copying whenever possible. For
|
1166 |
* example, if the value is just a nested command, then use the
|
1167 |
* command's result object directly.
|
1168 |
*/
|
1169 |
|
1170 |
resultPtr = NULL;
|
1171 |
for ( ; count > 0; count--, tokenPtr++) {
|
1172 |
valuePtr = NULL;
|
1173 |
|
1174 |
/*
|
1175 |
* The switch statement below computes the next value to be
|
1176 |
* concat to the result, as either a range of text or an
|
1177 |
* object.
|
1178 |
*/
|
1179 |
|
1180 |
switch (tokenPtr->type) {
|
1181 |
case TCL_TOKEN_TEXT:
|
1182 |
p = tokenPtr->start;
|
1183 |
length = tokenPtr->size;
|
1184 |
break;
|
1185 |
|
1186 |
case TCL_TOKEN_BS:
|
1187 |
length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
|
1188 |
buffer);
|
1189 |
p = buffer;
|
1190 |
break;
|
1191 |
|
1192 |
case TCL_TOKEN_COMMAND:
|
1193 |
code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
|
1194 |
0);
|
1195 |
if (code != TCL_OK) {
|
1196 |
goto error;
|
1197 |
}
|
1198 |
valuePtr = Tcl_GetObjResult(interp);
|
1199 |
break;
|
1200 |
|
1201 |
case TCL_TOKEN_VARIABLE:
|
1202 |
if (tokenPtr->numComponents == 1) {
|
1203 |
indexPtr = NULL;
|
1204 |
} else {
|
1205 |
indexPtr = Tcl_EvalTokens(interp, tokenPtr+2,
|
1206 |
tokenPtr->numComponents - 1);
|
1207 |
if (indexPtr == NULL) {
|
1208 |
goto error;
|
1209 |
}
|
1210 |
}
|
1211 |
|
1212 |
/*
|
1213 |
* We have to make a copy of the variable name in order
|
1214 |
* to have a null-terminated string. We can't make a
|
1215 |
* temporary modification to the script to null-terminate
|
1216 |
* the name, because a trace callback might potentially
|
1217 |
* reuse the script and be affected by the null character.
|
1218 |
*/
|
1219 |
|
1220 |
if (tokenPtr[1].size <= MAX_VAR_CHARS) {
|
1221 |
varName = nameBuffer;
|
1222 |
} else {
|
1223 |
varName = ckalloc((unsigned) (tokenPtr[1].size + 1));
|
1224 |
}
|
1225 |
strncpy(varName, tokenPtr[1].start, (size_t) tokenPtr[1].size);
|
1226 |
varName[tokenPtr[1].size] = 0;
|
1227 |
if (indexPtr != NULL) {
|
1228 |
index = TclGetString(indexPtr);
|
1229 |
} else {
|
1230 |
index = NULL;
|
1231 |
}
|
1232 |
valuePtr = Tcl_GetVar2Ex(interp, varName, index,
|
1233 |
TCL_LEAVE_ERR_MSG);
|
1234 |
if (varName != nameBuffer) {
|
1235 |
ckfree(varName);
|
1236 |
}
|
1237 |
if (indexPtr != NULL) {
|
1238 |
Tcl_DecrRefCount(indexPtr);
|
1239 |
}
|
1240 |
if (valuePtr == NULL) {
|
1241 |
goto error;
|
1242 |
}
|
1243 |
count -= tokenPtr->numComponents;
|
1244 |
tokenPtr += tokenPtr->numComponents;
|
1245 |
break;
|
1246 |
|
1247 |
default:
|
1248 |
panic("unexpected token type in Tcl_EvalTokens");
|
1249 |
}
|
1250 |
|
1251 |
/*
|
1252 |
* If valuePtr isn't NULL, the next piece of text comes from that
|
1253 |
* object; otherwise, take length bytes starting at p.
|
1254 |
*/
|
1255 |
|
1256 |
if (resultPtr == NULL) {
|
1257 |
if (valuePtr != NULL) {
|
1258 |
resultPtr = valuePtr;
|
1259 |
} else {
|
1260 |
resultPtr = Tcl_NewStringObj(p, length);
|
1261 |
}
|
1262 |
Tcl_IncrRefCount(resultPtr);
|
1263 |
} else {
|
1264 |
if (Tcl_IsShared(resultPtr)) {
|
1265 |
newPtr = Tcl_DuplicateObj(resultPtr);
|
1266 |
Tcl_DecrRefCount(resultPtr);
|
1267 |
resultPtr = newPtr;
|
1268 |
Tcl_IncrRefCount(resultPtr);
|
1269 |
}
|
1270 |
if (valuePtr != NULL) {
|
1271 |
p = Tcl_GetStringFromObj(valuePtr, &length);
|
1272 |
}
|
1273 |
Tcl_AppendToObj(resultPtr, p, length);
|
1274 |
}
|
1275 |
}
|
1276 |
return resultPtr;
|
1277 |
|
1278 |
error:
|
1279 |
if (resultPtr != NULL) {
|
1280 |
Tcl_DecrRefCount(resultPtr);
|
1281 |
}
|
1282 |
return NULL;
|
1283 |
}
|
1284 |
|
1285 |
/*
|
1286 |
*----------------------------------------------------------------------
|
1287 |
*
|
1288 |
* Tcl_EvalEx --
|
1289 |
*
|
1290 |
* This procedure evaluates a Tcl script without using the compiler
|
1291 |
* or byte-code interpreter. It just parses the script, creates
|
1292 |
* values for each word of each command, then calls EvalObjv
|
1293 |
* to execute each command.
|
1294 |
*
|
1295 |
* Results:
|
1296 |
* The return value is a standard Tcl completion code such as
|
1297 |
* TCL_OK or TCL_ERROR. A result or error message is left in
|
1298 |
* interp's result.
|
1299 |
*
|
1300 |
* Side effects:
|
1301 |
* Depends on the script.
|
1302 |
*
|
1303 |
*----------------------------------------------------------------------
|
1304 |
*/
|
1305 |
|
1306 |
int
|
1307 |
Tcl_EvalEx(interp, script, numBytes, flags)
|
1308 |
Tcl_Interp *interp; /* Interpreter in which to evaluate the
|
1309 |
* script. Also used for error reporting. */
|
1310 |
char *script; /* First character of script to evaluate. */
|
1311 |
int numBytes; /* Number of bytes in script. If < 0, the
|
1312 |
* script consists of all bytes up to the
|
1313 |
* first null character. */
|
1314 |
int flags; /* Collection of OR-ed bits that control
|
1315 |
* the evaluation of the script. Only
|
1316 |
* TCL_EVAL_GLOBAL is currently
|
1317 |
* supported. */
|
1318 |
{
|
1319 |
Interp *iPtr = (Interp *) interp;
|
1320 |
char *p, *next;
|
1321 |
Tcl_Parse parse;
|
1322 |
#define NUM_STATIC_OBJS 20
|
1323 |
Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv;
|
1324 |
Tcl_Token *tokenPtr;
|
1325 |
int i, code, commandLength, bytesLeft, nested;
|
1326 |
CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr
|
1327 |
* in case TCL_EVAL_GLOBAL was set. */
|
1328 |
|
1329 |
/*
|
1330 |
* The variables below keep track of how much state has been
|
1331 |
* allocated while evaluating the script, so that it can be freed
|
1332 |
* properly if an error occurs.
|
1333 |
*/
|
1334 |
|
1335 |
int gotParse = 0, objectsUsed = 0;
|
1336 |
|
1337 |
if (numBytes < 0) {
|
1338 |
numBytes = strlen(script);
|
1339 |
}
|
1340 |
Tcl_ResetResult(interp);
|
1341 |
|
1342 |
savedVarFramePtr = iPtr->varFramePtr;
|
1343 |
if (flags & TCL_EVAL_GLOBAL) {
|
1344 |
iPtr->varFramePtr = NULL;
|
1345 |
}
|
1346 |
|
1347 |
/*
|
1348 |
* Each iteration through the following loop parses the next
|
1349 |
* command from the script and then executes it.
|
1350 |
*/
|
1351 |
|
1352 |
objv = staticObjArray;
|
1353 |
p = script;
|
1354 |
bytesLeft = numBytes;
|
1355 |
if (iPtr->evalFlags & TCL_BRACKET_TERM) {
|
1356 |
nested = 1;
|
1357 |
} else {
|
1358 |
nested = 0;
|
1359 |
}
|
1360 |
iPtr->evalFlags = 0;
|
1361 |
do {
|
1362 |
if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse)
|
1363 |
!= TCL_OK) {
|
1364 |
code = TCL_ERROR;
|
1365 |
goto error;
|
1366 |
}
|
1367 |
gotParse = 1;
|
1368 |
if (parse.numWords > 0) {
|
1369 |
/*
|
1370 |
* Generate an array of objects for the words of the command.
|
1371 |
*/
|
1372 |
|
1373 |
if (parse.numWords <= NUM_STATIC_OBJS) {
|
1374 |
objv = staticObjArray;
|
1375 |
} else {
|
1376 |
objv = (Tcl_Obj **) ckalloc((unsigned)
|
1377 |
(parse.numWords * sizeof (Tcl_Obj *)));
|
1378 |
}
|
1379 |
for (objectsUsed = 0, tokenPtr = parse.tokenPtr;
|
1380 |
objectsUsed < parse.numWords;
|
1381 |
objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) {
|
1382 |
objv[objectsUsed] = Tcl_EvalTokens(interp, tokenPtr+1,
|
1383 |
tokenPtr->numComponents);
|
1384 |
if (objv[objectsUsed] == NULL) {
|
1385 |
code = TCL_ERROR;
|
1386 |
goto error;
|
1387 |
}
|
1388 |
}
|
1389 |
|
1390 |
/*
|
1391 |
* Execute the command and free the objects for its words.
|
1392 |
*/
|
1393 |
|
1394 |
code = EvalObjv(interp, objectsUsed, objv, p, bytesLeft, 0);
|
1395 |
if (code != TCL_OK) {
|
1396 |
goto error;
|
1397 |
}
|
1398 |
for (i = 0; i < objectsUsed; i++) {
|
1399 |
Tcl_DecrRefCount(objv[i]);
|
1400 |
}
|
1401 |
objectsUsed = 0;
|
1402 |
if (objv != staticObjArray) {
|
1403 |
ckfree((char *) objv);
|
1404 |
objv = staticObjArray;
|
1405 |
}
|
1406 |
}
|
1407 |
|
1408 |
/*
|
1409 |
* Advance to the next command in the script.
|
1410 |
*/
|
1411 |
|
1412 |
next = parse.commandStart + parse.commandSize;
|
1413 |
bytesLeft -= next - p;
|
1414 |
p = next;
|
1415 |
Tcl_FreeParse(&parse);
|
1416 |
gotParse = 0;
|
1417 |
if ((nested != 0) && (p > script) && (p[-1] == ']')) {
|
1418 |
/*
|
1419 |
* We get here in the special case where the TCL_BRACKET_TERM
|
1420 |
* flag was set in the interpreter and we reached a close
|
1421 |
* bracket in the script. Return immediately.
|
1422 |
*/
|
1423 |
|
1424 |
iPtr->termOffset = (p - 1) - script;
|
1425 |
iPtr->varFramePtr = savedVarFramePtr;
|
1426 |
return TCL_OK;
|
1427 |
}
|
1428 |
} while (bytesLeft > 0);
|
1429 |
iPtr->termOffset = p - script;
|
1430 |
iPtr->varFramePtr = savedVarFramePtr;
|
1431 |
return TCL_OK;
|
1432 |
|
1433 |
error:
|
1434 |
/*
|
1435 |
* Generate various pieces of error information, such as the line
|
1436 |
* number where the error occurred and information to add to the
|
1437 |
* errorInfo variable. Then free resources that had been allocated
|
1438 |
* to the command.
|
1439 |
*/
|
1440 |
|
1441 |
if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
|
1442 |
commandLength = parse.commandSize;
|
1443 |
if ((parse.commandStart + commandLength) != (script + numBytes)) {
|
1444 |
/*
|
1445 |
* The command where the error occurred didn't end at the end
|
1446 |
* of the script (i.e. it ended at a terminator character such
|
1447 |
* as ";". Reduce the length by one so that the error message
|
1448 |
* doesn't include the terminator character.
|
1449 |
*/
|
1450 |
|
1451 |
commandLength -= 1;
|
1452 |
}
|
1453 |
Tcl_LogCommandInfo(interp, script, parse.commandStart, commandLength);
|
1454 |
}
|
1455 |
|
1456 |
for (i = 0; i < objectsUsed; i++) {
|
1457 |
Tcl_DecrRefCount(objv[i]);
|
1458 |
}
|
1459 |
if (gotParse) {
|
1460 |
p = parse.commandStart + parse.commandSize;
|
1461 |
Tcl_FreeParse(&parse);
|
1462 |
if ((nested != 0) && (p > script) && (p[-1] == ']')) {
|
1463 |
/*
|
1464 |
* We get here in the special case where the TCL_BRACKET_TERM
|
1465 |
* flag was set in the interpreter and we reached a close
|
1466 |
* bracket in the script. Return immediately.
|
1467 |
*/
|
1468 |
|
1469 |
iPtr->termOffset = (p - 1) - script;
|
1470 |
} else {
|
1471 |
iPtr->termOffset = p - script;
|
1472 |
}
|
1473 |
}
|
1474 |
if (objv != staticObjArray) {
|
1475 |
ckfree((char *) objv);
|
1476 |
}
|
1477 |
iPtr->varFramePtr = savedVarFramePtr;
|
1478 |
return code;
|
1479 |
}
|
1480 |
|
1481 |
/*
|
1482 |
*----------------------------------------------------------------------
|
1483 |
*
|
1484 |
* Tcl_Eval --
|
1485 |
*
|
1486 |
* Execute a Tcl command in a string. This procedure executes the
|
1487 |
* script directly, rather than compiling it to bytecodes. Before
|
1488 |
* the arrival of the bytecode compiler in Tcl 8.0 Tcl_Eval was
|
1489 |
* the main procedure used for executing Tcl commands, but nowadays
|
1490 |
* it isn't used much.
|
1491 |
*
|
1492 |
* Results:
|
1493 |
* The return value is one of the return codes defined in tcl.h
|
1494 |
* (such as TCL_OK), and interp's result contains a value
|
1495 |
* to supplement the return code. The value of the result
|
1496 |
* will persist only until the next call to Tcl_Eval or Tcl_EvalObj:
|
1497 |
* you must copy it or lose it!
|
1498 |
*
|
1499 |
* Side effects:
|
1500 |
* Can be almost arbitrary, depending on the commands in the script.
|
1501 |
*
|
1502 |
*----------------------------------------------------------------------
|
1503 |
*/
|
1504 |
|
1505 |
int
|
1506 |
Tcl_Eval(interp, string)
|
1507 |
Tcl_Interp *interp; /* Token for command interpreter (returned
|
1508 |
* by previous call to Tcl_CreateInterp). */
|
1509 |
char *string; /* Pointer to TCL command to execute. */
|
1510 |
{
|
1511 |
int code;
|
1512 |
|
1513 |
code = Tcl_EvalEx(interp, string, -1, 0);
|
1514 |
|
1515 |
/*
|
1516 |
* For backwards compatibility with old C code that predates the
|
1517 |
* object system in Tcl 8.0, we have to mirror the object result
|
1518 |
* back into the string result (some callers may expect it there).
|
1519 |
*/
|
1520 |
|
1521 |
Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
|
1522 |
TCL_VOLATILE);
|
1523 |
return code;
|
1524 |
}
|
1525 |
|
1526 |
/*
|
1527 |
*----------------------------------------------------------------------
|
1528 |
*
|
1529 |
* Tcl_EvalObj, Tcl_GlobalEvalObj --
|
1530 |
*
|
1531 |
* These functions are deprecated but we keep them around for backwards
|
1532 |
* compatibility reasons.
|
1533 |
*
|
1534 |
* Results:
|
1535 |
* See the functions they call.
|
1536 |
*
|
1537 |
* Side effects:
|
1538 |
* See the functions they call.
|
1539 |
*
|
1540 |
*----------------------------------------------------------------------
|
1541 |
*/
|
1542 |
|
1543 |
#undef Tcl_EvalObj
|
1544 |
int
|
1545 |
Tcl_EvalObj(interp, objPtr)
|
1546 |
Tcl_Interp * interp;
|
1547 |
Tcl_Obj * objPtr;
|
1548 |
{
|
1549 |
return Tcl_EvalObjEx(interp, objPtr, 0);
|
1550 |
}
|
1551 |
|
1552 |
#undef Tcl_GlobalEvalObj
|
1553 |
int
|
1554 |
Tcl_GlobalEvalObj(interp, objPtr)
|
1555 |
Tcl_Interp * interp;
|
1556 |
Tcl_Obj * objPtr;
|
1557 |
{
|
1558 |
return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
|
1559 |
}
|
1560 |
|
1561 |
/*
|
1562 |
*----------------------------------------------------------------------
|
1563 |
*
|
1564 |
* Tcl_ParseVarName --
|
1565 |
*
|
1566 |
* Given a string starting with a $ sign, parse off a variable
|
1567 |
* name and return information about the parse.
|
1568 |
*
|
1569 |
* Results:
|
1570 |
* The return value is TCL_OK if the command was parsed
|
1571 |
* successfully and TCL_ERROR otherwise. If an error occurs and
|
1572 |
* interp isn't NULL then an error message is left in its result.
|
1573 |
* On a successful return, tokenPtr and numTokens fields of
|
1574 |
* parsePtr are filled in with information about the variable name
|
1575 |
* that was parsed. The "size" field of the first new token gives
|
1576 |
* the total number of bytes in the variable name. Other fields in
|
1577 |
* parsePtr are undefined.
|
1578 |
*
|
1579 |
* Side effects:
|
1580 |
* If there is insufficient space in parsePtr to hold all the
|
1581 |
* information about the command, then additional space is
|
1582 |
* malloc-ed. If the procedure returns TCL_OK then the caller must
|
1583 |
* eventually invoke Tcl_FreeParse to release any additional space
|
1584 |
* that was allocated.
|
1585 |
*
|
1586 |
*----------------------------------------------------------------------
|
1587 |
*/
|
1588 |
|
1589 |
int
|
1590 |
Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
|
1591 |
Tcl_Interp *interp; /* Interpreter to use for error reporting;
|
1592 |
* if NULL, then no error message is
|
1593 |
* provided. */
|
1594 |
char *string; /* String containing variable name. First
|
1595 |
* character must be "$". */
|
1596 |
int numBytes; /* Total number of bytes in string. If < 0,
|
1597 |
* the string consists of all bytes up to the
|
1598 |
* first null character. */
|
1599 |
Tcl_Parse *parsePtr; /* Structure to fill in with information
|
1600 |
* about the variable name. */
|
1601 |
int append; /* Non-zero means append tokens to existing
|
1602 |
* information in parsePtr; zero means ignore
|
1603 |
* existing tokens in parsePtr and reinitialize
|
1604 |
* it. */
|
1605 |
{
|
1606 |
Tcl_Token *tokenPtr;
|
1607 |
char *end, *src;
|
1608 |
unsigned char c;
|
1609 |
int varIndex, offset;
|
1610 |
Tcl_UniChar ch;
|
1611 |
unsigned array;
|
1612 |
|
1613 |
if (numBytes >= 0) {
|
1614 |
end = string + numBytes;
|
1615 |
} else {
|
1616 |
end = string + strlen(string);
|
1617 |
}
|
1618 |
|
1619 |
if (!append) {
|
1620 |
parsePtr->numWords = 0;
|
1621 |
parsePtr->tokenPtr = parsePtr->staticTokens;
|
1622 |
parsePtr->numTokens = 0;
|
1623 |
parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
|
1624 |
parsePtr->string = string;
|
1625 |
parsePtr->end = end;
|
1626 |
parsePtr->interp = interp;
|
1627 |
parsePtr->errorType = TCL_PARSE_SUCCESS;
|
1628 |
parsePtr->incomplete = 0;
|
1629 |
}
|
1630 |
|
1631 |
/*
|
1632 |
* Generate one token for the variable, an additional token for the
|
1633 |
* name, plus any number of additional tokens for the index, if
|
1634 |
* there is one.
|
1635 |
*/
|
1636 |
|
1637 |
src = string;
|
1638 |
if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) {
|
1639 |
TclExpandTokenArray(parsePtr);
|
1640 |
}
|
1641 |
tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
|
1642 |
tokenPtr->type = TCL_TOKEN_VARIABLE;
|
1643 |
tokenPtr->start = src;
|
1644 |
varIndex = parsePtr->numTokens;
|
1645 |
parsePtr->numTokens++;
|
1646 |
tokenPtr++;
|
1647 |
src++;
|
1648 |
if (src >= end) {
|
1649 |
goto justADollarSign;
|
1650 |
}
|
1651 |
tokenPtr->type = TCL_TOKEN_TEXT;
|
1652 |
tokenPtr->start = src;
|
1653 |
tokenPtr->numComponents = 0;
|
1654 |
|
1655 |
/*
|
1656 |
* The name of the variable can have three forms:
|
1657 |
* 1. The $ sign is followed by an open curly brace. Then
|
1658 |
* the variable name is everything up to the next close
|
1659 |
* curly brace, and the variable is a scalar variable.
|
1660 |
* 2. The $ sign is not followed by an open curly brace. Then
|
1661 |
* the variable name is everything up to the next
|
1662 |
* character that isn't a letter, digit, or underscore.
|
1663 |
* :: sequences are also considered part of the variable
|
1664 |
* name, in order to support namespaces. If the following
|
1665 |
* character is an open parenthesis, then the information
|
1666 |
* between parentheses is the array element name.
|
1667 |
* 3. The $ sign is followed by something that isn't a letter,
|
1668 |
* digit, or underscore: in this case, there is no variable
|
1669 |
* name and the token is just "$".
|
1670 |
*/
|
1671 |
|
1672 |
if (*src == '{') {
|
1673 |
src++;
|
1674 |
tokenPtr->type = TCL_TOKEN_TEXT;
|
1675 |
tokenPtr->start = src;
|
1676 |
tokenPtr->numComponents = 0;
|
1677 |
while (1) {
|
1678 |
if (src == end) {
|
1679 |
if (interp != NULL) {
|
1680 |
Tcl_SetResult(interp,
|
1681 |
"missing close-brace for variable name",
|
1682 |
TCL_STATIC);
|
1683 |
}
|
1684 |
parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
|
1685 |
parsePtr->term = tokenPtr->start-1;
|
1686 |
parsePtr->incomplete = 1;
|
1687 |
goto error;
|
1688 |
}
|
1689 |
if (*src == '}') {
|
1690 |
break;
|
1691 |
}
|
1692 |
src++;
|
1693 |
}
|
1694 |
tokenPtr->size = src - tokenPtr->start;
|
1695 |
tokenPtr[-1].size = src - tokenPtr[-1].start;
|
1696 |
parsePtr->numTokens++;
|
1697 |
src++;
|
1698 |
} else {
|
1699 |
tokenPtr->type = TCL_TOKEN_TEXT;
|
1700 |
tokenPtr->start = src;
|
1701 |
tokenPtr->numComponents = 0;
|
1702 |
while (src != end) {
|
1703 |
offset = Tcl_UtfToUniChar(src, &ch);
|
1704 |
c = UCHAR(ch);
|
1705 |
if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
|
1706 |
src += offset;
|
1707 |
continue;
|
1708 |
}
|
1709 |
if ((c == ':') && (((src+1) != end) && (src[1] == ':'))) {
|
1710 |
src += 2;
|
1711 |
while ((src != end) && (*src == ':')) {
|
1712 |
src += 1;
|
1713 |
}
|
1714 |
continue;
|
1715 |
}
|
1716 |
break;
|
1717 |
}
|
1718 |
|
1719 |
/*
|
1720 |
* Support for empty array names here.
|
1721 |
*/
|
1722 |
array = ((src != end) && (*src == '('));
|
1723 |
tokenPtr->size = src - tokenPtr->start;
|
1724 |
if (tokenPtr->size == 0 && !array) {
|
1725 |
goto justADollarSign;
|
1726 |
}
|
1727 |
parsePtr->numTokens++;
|
1728 |
if (array) {
|
1729 |
/*
|
1730 |
* This is a reference to an array element. Call
|
1731 |
* ParseTokens recursively to parse the element name,
|
1732 |
* since it could contain any number of substitutions.
|
1733 |
*/
|
1734 |
|
1735 |
if (ParseTokens(src+1, TYPE_CLOSE_PAREN, parsePtr)
|
1736 |
!= TCL_OK) {
|
1737 |
goto error;
|
1738 |
}
|
1739 |
if ((parsePtr->term == end) || (*parsePtr->term != ')')) {
|
1740 |
if (parsePtr->interp != NULL) {
|
1741 |
Tcl_SetResult(parsePtr->interp, "missing )",
|
1742 |
TCL_STATIC);
|
1743 |
}
|
1744 |
parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
|
1745 |
parsePtr->term = src;
|
1746 |
parsePtr->incomplete = 1;
|
1747 |
goto error;
|
1748 |
}
|
1749 |
src = parsePtr->term + 1;
|
1750 |
}
|
1751 |
}
|
1752 |
tokenPtr = &parsePtr->tokenPtr[varIndex];
|
1753 |
tokenPtr->size = src - tokenPtr->start;
|
1754 |
tokenPtr->numComponents = parsePtr->numTokens - (varIndex + 1);
|
1755 |
return TCL_OK;
|
1756 |
|
1757 |
/*
|
1758 |
* The dollar sign isn't followed by a variable name.
|
1759 |
* replace the TCL_TOKEN_VARIABLE token with a
|
1760 |
* TCL_TOKEN_TEXT token for the dollar sign.
|
1761 |
*/
|
1762 |
|
1763 |
justADollarSign:
|
1764 |
tokenPtr = &parsePtr->tokenPtr[varIndex];
|
1765 |
tokenPtr->type = TCL_TOKEN_TEXT;
|
1766 |
tokenPtr->size = 1;
|
1767 |
tokenPtr->numComponents = 0;
|
1768 |
return TCL_OK;
|
1769 |
|
1770 |
error:
|
1771 |
Tcl_FreeParse(parsePtr);
|
1772 |
return TCL_ERROR;
|
1773 |
}
|
1774 |
|
1775 |
/*
|
1776 |
*----------------------------------------------------------------------
|
1777 |
*
|
1778 |
* Tcl_ParseVar --
|
1779 |
*
|
1780 |
* Given a string starting with a $ sign, parse off a variable
|
1781 |
* name and return its value.
|
1782 |
*
|
1783 |
* Results:
|
1784 |
* The return value is the contents of the variable given by
|
1785 |
* the leading characters of string. If termPtr isn't NULL,
|
1786 |
* *termPtr gets filled in with the address of the character
|
1787 |
* just after the last one in the variable specifier. If the
|
1788 |
* variable doesn't exist, then the return value is NULL and
|
1789 |
* an error message will be left in interp's result.
|
1790 |
*
|
1791 |
* Side effects:
|
1792 |
* None.
|
1793 |
*
|
1794 |
*----------------------------------------------------------------------
|
1795 |
*/
|
1796 |
|
1797 |
char *
|
1798 |
Tcl_ParseVar(interp, string, termPtr)
|
1799 |
Tcl_Interp *interp; /* Context for looking up variable. */
|
1800 |
register char *string; /* String containing variable name.
|
1801 |
* First character must be "$". */
|
1802 |
char **termPtr; /* If non-NULL, points to word to fill
|
1803 |
* in with character just after last
|
1804 |
* one in the variable specifier. */
|
1805 |
|
1806 |
{
|
1807 |
Tcl_Parse parse;
|
1808 |
register Tcl_Obj *objPtr;
|
1809 |
|
1810 |
if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) {
|
1811 |
return NULL;
|
1812 |
}
|
1813 |
|
1814 |
if (termPtr != NULL) {
|
1815 |
*termPtr = string + parse.tokenPtr->size;
|
1816 |
}
|
1817 |
if (parse.numTokens == 1) {
|
1818 |
/*
|
1819 |
* There isn't a variable name after all: the $ is just a $.
|
1820 |
*/
|
1821 |
|
1822 |
return "$";
|
1823 |
}
|
1824 |
|
1825 |
objPtr = Tcl_EvalTokens(interp, parse.tokenPtr, parse.numTokens);
|
1826 |
if (objPtr == NULL) {
|
1827 |
return NULL;
|
1828 |
}
|
1829 |
|
1830 |
/*
|
1831 |
* At this point we should have an object containing the value of
|
1832 |
* a variable. Just return the string from that object.
|
1833 |
*/
|
1834 |
|
1835 |
#ifdef TCL_COMPILE_DEBUG
|
1836 |
if (objPtr->refCount < 2) {
|
1837 |
panic("Tcl_ParseVar got temporary object from Tcl_EvalTokens");
|
1838 |
}
|
1839 |
#endif /*TCL_COMPILE_DEBUG*/
|
1840 |
TclDecrRefCount(objPtr);
|
1841 |
return TclGetString(objPtr);
|
1842 |
}
|
1843 |
|
1844 |
/*
|
1845 |
*----------------------------------------------------------------------
|
1846 |
*
|
1847 |
* Tcl_ParseBraces --
|
1848 |
*
|
1849 |
* Given a string in braces such as a Tcl command argument or a string
|
1850 |
* value in a Tcl expression, this procedure parses the string and
|
1851 |
* returns information about the parse.
|
1852 |
*
|
1853 |
* Results:
|
1854 |
* The return value is TCL_OK if the string was parsed successfully and
|
1855 |
* TCL_ERROR otherwise. If an error occurs and interp isn't NULL then
|
1856 |
* an error message is left in its result. On a successful return,
|
1857 |
* tokenPtr and numTokens fields of parsePtr are filled in with
|
1858 |
* information about the string that was parsed. Other fields in
|
1859 |
* parsePtr are undefined. termPtr is set to point to the character
|
1860 |
* just after the last one in the braced string.
|
1861 |
*
|
1862 |
* Side effects:
|
1863 |
* If there is insufficient space in parsePtr to hold all the
|
1864 |
* information about the command, then additional space is
|
1865 |
* malloc-ed. If the procedure returns TCL_OK then the caller must
|
1866 |
* eventually invoke Tcl_FreeParse to release any additional space
|
1867 |
* that was allocated.
|
1868 |
*
|
1869 |
*----------------------------------------------------------------------
|
1870 |
*/
|
1871 |
|
1872 |
int
|
1873 |
Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
|
1874 |
Tcl_Interp *interp; /* Interpreter to use for error reporting;
|
1875 |
* if NULL, then no error message is
|
1876 |
* provided. */
|
1877 |
char *string; /* String containing the string in braces.
|
1878 |
* The first character must be '{'. */
|
1879 |
int numBytes; /* Total number of bytes in string. If < 0,
|
1880 |
* the string consists of all bytes up to
|
1881 |
* the first null character. */
|
1882 |
register Tcl_Parse *parsePtr;
|
1883 |
/* Structure to fill in with information
|
1884 |
* about the string. */
|
1885 |
int append; /* Non-zero means append tokens to existing
|
1886 |
* information in parsePtr; zero means
|
1887 |
* ignore existing tokens in parsePtr and
|
1888 |
* reinitialize it. */
|
1889 |
char **termPtr; /* If non-NULL, points to word in which to
|
1890 |
* store a pointer to the character just
|
1891 |
* after the terminating '}' if the parse
|
1892 |
* was successful. */
|
1893 |
|
1894 |
{
|
1895 |
char utfBytes[TCL_UTF_MAX]; /* For result of backslash substitution. */
|
1896 |
Tcl_Token *tokenPtr;
|
1897 |
register char *src, *end;
|
1898 |
int startIndex, level, length;
|
1899 |
|
1900 |
if ((numBytes >= 0) || (string == NULL)) {
|
1901 |
end = string + numBytes;
|
1902 |
} else {
|
1903 |
end = string + strlen(string);
|
1904 |
}
|
1905 |
|
1906 |
if (!append) {
|
1907 |
parsePtr->numWords = 0;
|
1908 |
parsePtr->tokenPtr = parsePtr->staticTokens;
|
1909 |
parsePtr->numTokens = 0;
|
1910 |
parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
|
1911 |
parsePtr->string = string;
|
1912 |
parsePtr->end = end;
|
1913 |
parsePtr->interp = interp;
|
1914 |
parsePtr->errorType = TCL_PARSE_SUCCESS;
|
1915 |
}
|
1916 |
|
1917 |
src = string+1;
|
1918 |
startIndex = parsePtr->numTokens;
|
1919 |
|
1920 |
if (parsePtr->numTokens == parsePtr->tokensAvailable) {
|
1921 |
TclExpandTokenArray(parsePtr);
|
1922 |
}
|
1923 |
tokenPtr = &parsePtr->tokenPtr[startIndex];
|
1924 |
tokenPtr->type = TCL_TOKEN_TEXT;
|
1925 |
tokenPtr->start = src;
|
1926 |
tokenPtr->numComponents = 0;
|
1927 |
level = 1;
|
1928 |
while (1) {
|
1929 |
while (CHAR_TYPE(*src) == TYPE_NORMAL) {
|
1930 |
src++;
|
1931 |
}
|
1932 |
if (*src == '}') {
|
1933 |
level--;
|
1934 |
if (level == 0) {
|
1935 |
break;
|
1936 |
}
|
1937 |
src++;
|
1938 |
} else if (*src == '{') {
|
1939 |
level++;
|
1940 |
src++;
|
1941 |
} else if (*src == '\\') {
|
1942 |
Tcl_UtfBackslash(src, &length, utfBytes);
|
1943 |
if (src[1] == '\n') {
|
1944 |
/*
|
1945 |
* A backslash-newline sequence must be collapsed, even
|
1946 |
* inside braces, so we have to split the word into
|
1947 |
* multiple tokens so that the backslash-newline can be
|
1948 |
* represented explicitly.
|
1949 |
*/
|
1950 |
|
1951 |
if ((src + 2) == end) {
|
1952 |
parsePtr->incomplete = 1;
|
1953 |
}
|
1954 |
tokenPtr->size = (src - tokenPtr->start);
|
1955 |
if (tokenPtr->size != 0) {
|
1956 |
parsePtr->numTokens++;
|
1957 |
}
|
1958 |
if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) {
|
1959 |
TclExpandTokenArray(parsePtr);
|
1960 |
}
|
1961 |
tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
|
1962 |
tokenPtr->type = TCL_TOKEN_BS;
|
1963 |
tokenPtr->start = src;
|
1964 |
tokenPtr->size = length;
|
1965 |
tokenPtr->numComponents = 0;
|
1966 |
parsePtr->numTokens++;
|
1967 |
|
1968 |
src += length;
|
1969 |
tokenPtr++;
|
1970 |
tokenPtr->type = TCL_TOKEN_TEXT;
|
1971 |
tokenPtr->start = src;
|
1972 |
tokenPtr->numComponents = 0;
|
1973 |
} else {
|
1974 |
src += length;
|
1975 |
}
|
1976 |
} else if (src == end) {
|
1977 |
int openBrace;
|
1978 |
|
1979 |
if (interp != NULL) {
|
1980 |
Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
|
1981 |
}
|
1982 |
/*
|
1983 |
* Search the source string for a possible open
|
1984 |
* brace within the context of a comment. Since we
|
1985 |
* aren't performing a full Tcl parse, just look for
|
1986 |
* an open brace preceeded by a '<whitspace>#' on
|
1987 |
* the same line.
|
1988 |
*/
|
1989 |
openBrace = 0;
|
1990 |
while (src > string ) {
|
1991 |
switch (*src) {
|
1992 |
case '{':
|
1993 |
openBrace = 1;
|
1994 |
break;
|
1995 |
case '\n':
|
1996 |
openBrace = 0;
|
1997 |
break;
|
1998 |
case '#':
|
1999 |
if ((openBrace == 1) && (isspace(UCHAR(src[-1])))) {
|
2000 |
if (interp != NULL) {
|
2001 |
Tcl_AppendResult(interp,
|
2002 |
": possible unbalanced brace in comment",
|
2003 |
(char *) NULL);
|
2004 |
}
|
2005 |
openBrace = -1;
|
2006 |
break;
|
2007 |
}
|
2008 |
break;
|
2009 |
}
|
2010 |
if (openBrace == -1) {
|
2011 |
break;
|
2012 |
}
|
2013 |
src--;
|
2014 |
}
|
2015 |
parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
|
2016 |
parsePtr->term = string;
|
2017 |
parsePtr->incomplete = 1;
|
2018 |
goto error;
|
2019 |
} else {
|
2020 |
src++;
|
2021 |
}
|
2022 |
}
|
2023 |
|
2024 |
/*
|
2025 |
* Decide if we need to finish emitting a partially-finished token.
|
2026 |
* There are 3 cases:
|
2027 |
* {abc \newline xyz} or {xyz} - finish emitting "xyz" token
|
2028 |
* {abc \newline} - don't emit token after \newline
|
2029 |
* {} - finish emitting zero-sized token
|
2030 |
* The last case ensures that there is a token (even if empty) that
|
2031 |
* describes the braced string.
|
2032 |
*/
|
2033 |
|
2034 |
if ((src != tokenPtr->start)
|
2035 |
|| (parsePtr->numTokens == startIndex)) {
|
2036 |
tokenPtr->size = (src - tokenPtr->start);
|
2037 |
parsePtr->numTokens++;
|
2038 |
}
|
2039 |
if (termPtr != NULL) {
|
2040 |
*termPtr = src+1;
|
2041 |
}
|
2042 |
return TCL_OK;
|
2043 |
|
2044 |
error:
|
2045 |
Tcl_FreeParse(parsePtr);
|
2046 |
return TCL_ERROR;
|
2047 |
}
|
2048 |
|
2049 |
/*
|
2050 |
*----------------------------------------------------------------------
|
2051 |
*
|
2052 |
* Tcl_ParseQuotedString --
|
2053 |
*
|
2054 |
* Given a double-quoted string such as a quoted Tcl command argument
|
2055 |
* or a quoted value in a Tcl expression, this procedure parses the
|
2056 |
* string and returns information about the parse.
|
2057 |
*
|
2058 |
* Results:
|
2059 |
* The return value is TCL_OK if the string was parsed successfully and
|
2060 |
* TCL_ERROR otherwise. If an error occurs and interp isn't NULL then
|
2061 |
* an error message is left in its result. On a successful return,
|
2062 |
* tokenPtr and numTokens fields of parsePtr are filled in with
|
2063 |
* information about the string that was parsed. Other fields in
|
2064 |
* parsePtr are undefined. termPtr is set to point to the character
|
2065 |
* just after the quoted string's terminating close-quote.
|
2066 |
*
|
2067 |
* Side effects:
|
2068 |
* If there is insufficient space in parsePtr to hold all the
|
2069 |
* information about the command, then additional space is
|
2070 |
* malloc-ed. If the procedure returns TCL_OK then the caller must
|
2071 |
* eventually invoke Tcl_FreeParse to release any additional space
|
2072 |
* that was allocated.
|
2073 |
*
|
2074 |
*----------------------------------------------------------------------
|
2075 |
*/
|
2076 |
|
2077 |
int
|
2078 |
Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
|
2079 |
Tcl_Interp *interp; /* Interpreter to use for error reporting;
|
2080 |
* if NULL, then no error message is
|
2081 |
* provided. */
|
2082 |
char *string; /* String containing the quoted string.
|
2083 |
* The first character must be '"'. */
|
2084 |
int numBytes; /* Total number of bytes in string. If < 0,
|
2085 |
* the string consists of all bytes up to
|
2086 |
* the first null character. */
|
2087 |
register Tcl_Parse *parsePtr;
|
2088 |
/* Structure to fill in with information
|
2089 |
* about the string. */
|
2090 |
int append; /* Non-zero means append tokens to existing
|
2091 |
* information in parsePtr; zero means
|
2092 |
* ignore existing tokens in parsePtr and
|
2093 |
* reinitialize it. */
|
2094 |
char **termPtr; /* If non-NULL, points to word in which to
|
2095 |
* store a pointer to the character just
|
2096 |
* after the quoted string's terminating
|
2097 |
* close-quote if the parse succeeds. */
|
2098 |
{
|
2099 |
char *end;
|
2100 |
|
2101 |
if ((numBytes >= 0) || (string == NULL)) {
|
2102 |
end = string + numBytes;
|
2103 |
} else {
|
2104 |
end = string + strlen(string);
|
2105 |
}
|
2106 |
|
2107 |
if (!append) {
|
2108 |
parsePtr->numWords = 0;
|
2109 |
parsePtr->tokenPtr = parsePtr->staticTokens;
|
2110 |
parsePtr->numTokens = 0;
|
2111 |
parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
|
2112 |
parsePtr->string = string;
|
2113 |
parsePtr->end = end;
|
2114 |
parsePtr->interp = interp;
|
2115 |
parsePtr->errorType = TCL_PARSE_SUCCESS;
|
2116 |
}
|
2117 |
|
2118 |
if (ParseTokens(string+1, TYPE_QUOTE, parsePtr) != TCL_OK) {
|
2119 |
goto error;
|
2120 |
}
|
2121 |
if (*parsePtr->term != '"') {
|
2122 |
if (interp != NULL) {
|
2123 |
Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC);
|
2124 |
}
|
2125 |
parsePtr->errorType = TCL_PARSE_MISSING_QUOTE;
|
2126 |
parsePtr->term = string;
|
2127 |
parsePtr->incomplete = 1;
|
2128 |
goto error;
|
2129 |
}
|
2130 |
if (termPtr != NULL) {
|
2131 |
*termPtr = (parsePtr->term + 1);
|
2132 |
}
|
2133 |
return TCL_OK;
|
2134 |
|
2135 |
error:
|
2136 |
Tcl_FreeParse(parsePtr);
|
2137 |
return TCL_ERROR;
|
2138 |
}
|
2139 |
|
2140 |
/*
|
2141 |
*----------------------------------------------------------------------
|
2142 |
*
|
2143 |
* CommandComplete --
|
2144 |
*
|
2145 |
* This procedure is shared by TclCommandComplete and
|
2146 |
* Tcl_ObjCommandcoComplete; it does all the real work of seeing
|
2147 |
* whether a script is complete
|
2148 |
*
|
2149 |
* Results:
|
2150 |
* 1 is returned if the script is complete, 0 if there are open
|
2151 |
* delimiters such as " or (. 1 is also returned if there is a
|
2152 |
* parse error in the script other than unmatched delimiters.
|
2153 |
*
|
2154 |
* Side effects:
|
2155 |
* None.
|
2156 |
*
|
2157 |
*----------------------------------------------------------------------
|
2158 |
*/
|
2159 |
|
2160 |
static int
|
2161 |
CommandComplete(script, length)
|
2162 |
char *script; /* Script to check. */
|
2163 |
int length; /* Number of bytes in script. */
|
2164 |
{
|
2165 |
Tcl_Parse parse;
|
2166 |
char *p, *end;
|
2167 |
int result;
|
2168 |
|
2169 |
p = script;
|
2170 |
end = p + length;
|
2171 |
while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse)
|
2172 |
== TCL_OK) {
|
2173 |
p = parse.commandStart + parse.commandSize;
|
2174 |
if (*p == 0) {
|
2175 |
break;
|
2176 |
}
|
2177 |
Tcl_FreeParse(&parse);
|
2178 |
}
|
2179 |
if (parse.incomplete) {
|
2180 |
result = 0;
|
2181 |
} else {
|
2182 |
result = 1;
|
2183 |
}
|
2184 |
Tcl_FreeParse(&parse);
|
2185 |
return result;
|
2186 |
}
|
2187 |
|
2188 |
/*
|
2189 |
*----------------------------------------------------------------------
|
2190 |
*
|
2191 |
* Tcl_CommandComplete --
|
2192 |
*
|
2193 |
* Given a partial or complete Tcl script, this procedure
|
2194 |
* determines whether the script is complete in the sense
|
2195 |
* of having matched braces and quotes and brackets.
|
2196 |
*
|
2197 |
* Results:
|
2198 |
* 1 is returned if the script is complete, 0 otherwise.
|
2199 |
* 1 is also returned if there is a parse error in the script
|
2200 |
* other than unmatched delimiters.
|
2201 |
*
|
2202 |
* Side effects:
|
2203 |
* None.
|
2204 |
*
|
2205 |
*----------------------------------------------------------------------
|
2206 |
*/
|
2207 |
|
2208 |
int
|
2209 |
Tcl_CommandComplete(script)
|
2210 |
char *script; /* Script to check. */
|
2211 |
{
|
2212 |
return CommandComplete(script, (int) strlen(script));
|
2213 |
}
|
2214 |
|
2215 |
/*
|
2216 |
*----------------------------------------------------------------------
|
2217 |
*
|
2218 |
* TclObjCommandComplete --
|
2219 |
*
|
2220 |
* Given a partial or complete Tcl command in a Tcl object, this
|
2221 |
* procedure determines whether the command is complete in the sense of
|
2222 |
* having matched braces and quotes and brackets.
|
2223 |
*
|
2224 |
* Results:
|
2225 |
* 1 is returned if the command is complete, 0 otherwise.
|
2226 |
*
|
2227 |
* Side effects:
|
2228 |
* None.
|
2229 |
*
|
2230 |
*----------------------------------------------------------------------
|
2231 |
*/
|
2232 |
|
2233 |
int
|
2234 |
TclObjCommandComplete(objPtr)
|
2235 |
Tcl_Obj *objPtr; /* Points to object holding script
|
2236 |
* to check. */
|
2237 |
{
|
2238 |
char *script;
|
2239 |
int length;
|
2240 |
|
2241 |
script = Tcl_GetStringFromObj(objPtr, &length);
|
2242 |
return CommandComplete(script, length);
|
2243 |
}
|
2244 |
|
2245 |
/*
|
2246 |
*----------------------------------------------------------------------
|
2247 |
*
|
2248 |
* TclIsLocalScalar --
|
2249 |
*
|
2250 |
* Check to see if a given string is a legal scalar variable
|
2251 |
* name with no namespace qualifiers or substitutions.
|
2252 |
*
|
2253 |
* Results:
|
2254 |
* Returns 1 if the variable is a local scalar.
|
2255 |
*
|
2256 |
* Side effects:
|
2257 |
* None.
|
2258 |
*
|
2259 |
*----------------------------------------------------------------------
|
2260 |
*/
|
2261 |
|
2262 |
int
|
2263 |
TclIsLocalScalar(src, len)
|
2264 |
CONST char *src;
|
2265 |
int len;
|
2266 |
{
|
2267 |
CONST char *p;
|
2268 |
CONST char *lastChar = src + (len - 1);
|
2269 |
|
2270 |
for (p = src; p <= lastChar; p++) {
|
2271 |
if ((CHAR_TYPE(*p) != TYPE_NORMAL) &&
|
2272 |
(CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
|
2273 |
/*
|
2274 |
* TCL_COMMAND_END is returned for the last character
|
2275 |
* of the string. By this point we know it isn't
|
2276 |
* an array or namespace reference.
|
2277 |
*/
|
2278 |
|
2279 |
return 0;
|
2280 |
}
|
2281 |
if (*p == '(') {
|
2282 |
if (*lastChar == ')') { /* we have an array element */
|
2283 |
return 0;
|
2284 |
}
|
2285 |
} else if (*p == ':') {
|
2286 |
if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
|
2287 |
return 0;
|
2288 |
}
|
2289 |
}
|
2290 |
}
|
2291 |
|
2292 |
return 1;
|
2293 |
}
|
2294 |
|
2295 |
/* End of tclparse.c */
|