Planet

navi

home

PPS

about

screenshots

download

development

forum

Context Navigation

source: downloads/tcl8.5.2/generic/tclParse.c @ 35

Last change on this file since 35 was 25, checked in by landauf, 18 years ago
added tcl to libs
File size: 70.2 KB

Rev	Line
[25]	1	/*
	2	* tclParse.c --
	3	*
	4	* This file contains functions that parse Tcl scripts. They do so in a
	5	* general-purpose fashion that can be used for many different purposes,
	6	* including compilation, direct execution, code analysis, etc.
	7	*
	8	* Copyright (c) 1997 Sun Microsystems, Inc.
	9	* Copyright (c) 1998-2000 Ajuba Solutions.
	10	* Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
	11	*
	12	* See the file "license.terms" for information on usage and redistribution of
	13	* this file, and for a DISCLAIMER OF ALL WARRANTIES.
	14	*
	15	* RCS: @(#) $Id: tclParse.c,v 1.62 2008/01/23 21:58:36 dgp Exp $
	16	*/
	17
	18	#include "tclInt.h"
	19
	20	/*
	21	* The following table provides parsing information about each possible 8-bit
	22	* character. The table is designed to be referenced with either signed or
	23	* unsigned characters, so it has 384 entries. The first 128 entries
	24	* correspond to negative character values, the next 256 correspond to
	25	* positive character values. The last 128 entries are identical to the first
	26	* 128. The table is always indexed with a 128-byte offset (the 128th entry
	27	* corresponds to a character value of 0).
	28	*
	29	* The macro CHAR_TYPE is used to index into the table and return information
	30	* about its character argument. The following return values are defined.
	31	*
	32	* TYPE_NORMAL - All characters that don't have special significance to
	33	* the Tcl parser.
	34	* TYPE_SPACE - The character is a whitespace character other than
	35	* newline.
	36	* TYPE_COMMAND_END - Character is newline or semicolon.
	37	* TYPE_SUBS - Character begins a substitution or has other special
	38	* meaning in ParseTokens: backslash, dollar sign, or
	39	* open bracket.
	40	* TYPE_QUOTE - Character is a double quote.
	41	* TYPE_CLOSE_PAREN - Character is a right parenthesis.
	42	* TYPE_CLOSE_BRACK - Character is a right square bracket.
	43	* TYPE_BRACE - Character is a curly brace (either left or right).
	44	*/
	45
	46	#define TYPE_NORMAL 0
	47	#define TYPE_SPACE 0x1
	48	#define TYPE_COMMAND_END 0x2
	49	#define TYPE_SUBS 0x4
	50	#define TYPE_QUOTE 0x8
	51	#define TYPE_CLOSE_PAREN 0x10
	52	#define TYPE_CLOSE_BRACK 0x20
	53	#define TYPE_BRACE 0x40
	54
	55	#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]
	56
	57	static const char charTypeTable[] = {
	58	/*
	59	* Negative character values, from -128 to -1:
	60	*/
	61
	62	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	63	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	64	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	65	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	66	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	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
	95	/*
	96	* Positive character values, from 0-127:
	97	*/
	98
	99	TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	100	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	101	TYPE_NORMAL, TYPE_SPACE, TYPE_COMMAND_END, TYPE_SPACE,
	102	TYPE_SPACE, TYPE_SPACE, TYPE_NORMAL, TYPE_NORMAL,
	103	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	104	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	105	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	106	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	107	TYPE_SPACE, TYPE_NORMAL, TYPE_QUOTE, TYPE_NORMAL,
	108	TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	109	TYPE_NORMAL, TYPE_CLOSE_PAREN, TYPE_NORMAL, TYPE_NORMAL,
	110	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	111	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	112	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	113	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_COMMAND_END,
	114	TYPE_NORMAL, TYPE_NORMAL, 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_NORMAL,
	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_SUBS,
	122	TYPE_SUBS, TYPE_CLOSE_BRACK, 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_NORMAL,
	127	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	128	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	129	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_BRACE,
	130	TYPE_NORMAL, TYPE_BRACE, TYPE_NORMAL, TYPE_NORMAL,
	131
	132	/*
	133	* Large unsigned character values, from 128-255:
	134	*/
	135
	136	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	137	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	138	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	139	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	140	TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
	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	};
	169
	170	/*
	171	* Prototypes for local functions defined in this file:
	172	*/
	173
	174	static inline int CommandComplete(const char *script, int numBytes);
	175	static int ParseComment(const char *src, int numBytes,
	176	Tcl_Parse *parsePtr);
	177	static int ParseTokens(const char *src, int numBytes, int mask,
	178	int flags, Tcl_Parse *parsePtr);
	179	static int ParseWhiteSpace(const char *src, int numBytes,
	180	int incompletePtr, char typePtr);
	181
	182	/*
	183	*----------------------------------------------------------------------
	184	*
	185	* TclParseInit --
	186	*
	187	* Initialize the fields of a Tcl_Parse struct.
	188	*
	189	* Results:
	190	* None.
	191	*
	192	* Side effects:
	193	* The Tcl_Parse struct pointed to by parsePtr gets initialized.
	194	*
	195	*----------------------------------------------------------------------
	196	*/
	197
	198	void
	199	TclParseInit(
	200	Tcl_Interp interp, / Interpreter to use for error reporting */
	201	const char start, / Start of string to be parsed. */
	202	int numBytes, /* Total number of bytes in string. If < 0,
	203	* the script consists of all bytes up to the
	204	* first null character. */
	205	Tcl_Parse parsePtr) / Points to struct to initialize */
	206	{
	207	parsePtr->numWords = 0;
	208	parsePtr->tokenPtr = parsePtr->staticTokens;
	209	parsePtr->numTokens = 0;
	210	parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
	211	parsePtr->string = start;
	212	parsePtr->end = start + numBytes;
	213	parsePtr->term = parsePtr->end;
	214	parsePtr->interp = interp;
	215	parsePtr->incomplete = 0;
	216	parsePtr->errorType = TCL_PARSE_SUCCESS;
	217	}
	218
	219	/*
	220	*----------------------------------------------------------------------
	221	*
	222	* Tcl_ParseCommand --
	223	*
	224	* Given a string, this function parses the first Tcl command in the
	225	* string and returns information about the structure of the command.
	226	*
	227	* Results:
	228	* The return value is TCL_OK if the command was parsed successfully and
	229	* TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an
	230	* error message is left in its result. On a successful return, parsePtr
	231	* is filled in with information about the command that was parsed.
	232	*
	233	* Side effects:
	234	* If there is insufficient space in parsePtr to hold all the information
	235	* about the command, then additional space is malloc-ed. If the function
	236	* returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to
	237	* release any additional space that was allocated.
	238	*
	239	*----------------------------------------------------------------------
	240	*/
	241
	242	int
	243	Tcl_ParseCommand(
	244	Tcl_Interp interp, / Interpreter to use for error reporting; if
	245	* NULL, then no error message is provided. */
	246	const char start, / First character of string containing one or
	247	* more Tcl commands. */
	248	register int numBytes, /* Total number of bytes in string. If < 0,
	249	* the script consists of all bytes up to the
	250	* first null character. */
	251	int nested, /* Non-zero means this is a nested command:
	252	* close bracket should be considered a
	253	* command terminator. If zero, then close
	254	* bracket has no special meaning. */
	255	register Tcl_Parse *parsePtr)
	256	/* Structure to fill in with information about
	257	* the parsed command; any previous
	258	* information in the structure is ignored. */
	259	{
	260	register const char src; / Points to current character in the
	261	* command. */
	262	char type; /* Result returned by CHAR_TYPE(src). /
	263	Tcl_Token tokenPtr; / Pointer to token being filled in. */
	264	int wordIndex; /* Index of word token for current word. */
	265	int terminators; /* CHAR_TYPE bits that indicate the end of a
	266	* command. */
	267	const char termPtr; / Set by Tcl_ParseBraces/QuotedString to
	268	* point to char after terminating one. */
	269	int scanned;
	270
	271	if ((start == NULL) && (numBytes != 0)) {
	272	if (interp != NULL) {
	273	Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC);
	274	}
	275	return TCL_ERROR;
	276	}
	277	if (numBytes < 0) {
	278	numBytes = strlen(start);
	279	}
	280	TclParseInit(interp, start, numBytes, parsePtr);
	281	parsePtr->commentStart = NULL;
	282	parsePtr->commentSize = 0;
	283	parsePtr->commandStart = NULL;
	284	parsePtr->commandSize = 0;
	285	if (nested != 0) {
	286	terminators = TYPE_COMMAND_END \| TYPE_CLOSE_BRACK;
	287	} else {
	288	terminators = TYPE_COMMAND_END;
	289	}
	290
	291	/*
	292	* Parse any leading space and comments before the first word of the
	293	* command.
	294	*/
	295
	296	scanned = ParseComment(start, numBytes, parsePtr);
	297	src = (start + scanned);
	298	numBytes -= scanned;
	299	if (numBytes == 0) {
	300	if (nested) {
	301	parsePtr->incomplete = nested;
	302	}
	303	}
	304
	305	/*
	306	* The following loop parses the words of the command, one word in each
	307	* iteration through the loop.
	308	*/
	309
	310	parsePtr->commandStart = src;
	311	while (1) {
	312	int expandWord = 0;
	313
	314	/*
	315	* Create the token for the word.
	316	*/
	317
	318	TclGrowParseTokenArray(parsePtr, 1);
	319	wordIndex = parsePtr->numTokens;
	320	tokenPtr = &parsePtr->tokenPtr[wordIndex];
	321	tokenPtr->type = TCL_TOKEN_WORD;
	322
	323	/*
	324	* Skip white space before the word. Also skip a backslash-newline
	325	* sequence: it should be treated just like white space.
	326	*/
	327
	328	scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type);
	329	src += scanned;
	330	numBytes -= scanned;
	331	if (numBytes == 0) {
	332	parsePtr->term = src;
	333	break;
	334	}
	335	if ((type & terminators) != 0) {
	336	parsePtr->term = src;
	337	src++;
	338	break;
	339	}
	340	tokenPtr->start = src;
	341	parsePtr->numTokens++;
	342	parsePtr->numWords++;
	343
	344	/*
	345	* At this point the word can have one of four forms: something
	346	* enclosed in quotes, something enclosed in braces, and expanding
	347	* word, or an unquoted word (anything else).
	348	*/
	349
	350	parseWord:
	351	if (*src == '"') {
	352	if (Tcl_ParseQuotedString(interp, src, numBytes, parsePtr, 1,
	353	&termPtr) != TCL_OK) {
	354	goto error;
	355	}
	356	src = termPtr;
	357	numBytes = parsePtr->end - src;
	358	} else if (*src == '{') {
	359	int expIdx = wordIndex + 1;
	360	Tcl_Token *expPtr;
	361
	362	if (Tcl_ParseBraces(interp, src, numBytes, parsePtr, 1,
	363	&termPtr) != TCL_OK) {
	364	goto error;
	365	}
	366	src = termPtr;
	367	numBytes = parsePtr->end - src;
	368
	369	/*
	370	* Check whether the braces contained the word expansion prefix
	371	* {*}
	372	*/
	373
	374	expPtr = &parsePtr->tokenPtr[expIdx];
	375	if ((0 == expandWord)
	376	/* Haven't seen prefix already */
	377	&& (1 == parsePtr->numTokens - expIdx)
	378	/* Only one token */
	379	&& (((1 == (size_t) expPtr->size)
	380	/* Same length as prefix */
	381	&& (expPtr->start[0] == '*')))
	382	/* Is the prefix */
	383	&& (numBytes > 0) && (0 == ParseWhiteSpace(termPtr,
	384	numBytes, &parsePtr->incomplete, &type))
	385	&& (type != TYPE_COMMAND_END)
	386	/* Non-whitespace follows */) {
	387	expandWord = 1;
	388	parsePtr->numTokens--;
	389	goto parseWord;
	390	}
	391	} else {
	392	/*
	393	* This is an unquoted word. Call ParseTokens and let it do all of
	394	* the work.
	395	*/
	396
	397	if (ParseTokens(src, numBytes, TYPE_SPACE\|terminators,
	398	TCL_SUBST_ALL, parsePtr) != TCL_OK) {
	399	goto error;
	400	}
	401	src = parsePtr->term;
	402	numBytes = parsePtr->end - src;
	403	}
	404
	405	/*
	406	* Finish filling in the token for the word and check for the special
	407	* case of a word consisting of a single range of literal text.
	408	*/
	409
	410	tokenPtr = &parsePtr->tokenPtr[wordIndex];
	411	tokenPtr->size = src - tokenPtr->start;
	412	tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1);
	413	if (expandWord) {
	414	int i, isLiteral = 1;
	415
	416	/*
	417	* When a command includes a word that is an expanded literal; for
	418	* example, {*}{1 2 3}, the parser performs that expansion
	419	* immediately, generating several TCL_TOKEN_SIMPLE_WORDs instead
	420	* of a single TCL_TOKEN_EXPAND_WORD that the Tcl_ParseCommand()
	421	* caller might have to expand. This notably makes it simpler for
	422	* those callers that wish to track line endings, such as those
	423	* that implement key parts of TIP 280.
	424	*
	425	* First check whether the thing to be expanded is a literal,
	426	* in the sense of being composed entirely of TCL_TOKEN_TEXT
	427	* tokens.
	428	*/
	429
	430	for (i = 1; i <= tokenPtr->numComponents; i++) {
	431	if (tokenPtr[i].type != TCL_TOKEN_TEXT) {
	432	isLiteral = 0;
	433	break;
	434	}
	435	}
	436
	437	if (isLiteral) {
	438	int elemCount = 0, code = TCL_OK;
	439	const char nextElem, listEnd, *elemStart;
	440
	441	/*
	442	* The word to be expanded is a literal, so determine the
	443	* boundaries of the literal string to be treated as a list
	444	* and expanded. That literal string starts at
	445	* tokenPtr[1].start, and includes all bytes up to, but not
	446	* including (tokenPtr[tokenPtr->numComponents].start +
	447	* tokenPtr[tokenPtr->numComponents].size)
	448	*/
	449
	450	listEnd = (tokenPtr[tokenPtr->numComponents].start +
	451	tokenPtr[tokenPtr->numComponents].size);
	452	nextElem = tokenPtr[1].start;
	453
	454	/*
	455	* Step through the literal string, parsing and counting list
	456	* elements.
	457	*/
	458
	459	while (nextElem < listEnd) {
	460	code = TclFindElement(NULL, nextElem, listEnd - nextElem,
	461	&elemStart, &nextElem, NULL, NULL);
	462	if (code != TCL_OK) break;
	463	if (elemStart < listEnd) {
	464	elemCount++;
	465	}
	466	}
	467
	468	if (code != TCL_OK) {
	469	/*
	470	* Some list element could not be parsed. This means the
	471	* literal string was not in fact a valid list. Defer the
	472	* handling of this to compile/eval time, where code is
	473	* already in place to report the "attempt to expand a
	474	* non-list" error.
	475	*/
	476
	477	tokenPtr->type = TCL_TOKEN_EXPAND_WORD;
	478	} else if (elemCount == 0) {
	479	/*
	480	* We are expanding a literal empty list. This means that
	481	* the expanding word completely disappears, leaving no
	482	* word generated this pass through the loop. Adjust
	483	* accounting appropriately.
	484	*/
	485
	486	parsePtr->numWords--;
	487	parsePtr->numTokens = wordIndex;
	488	} else {
	489	/*
	490	* Recalculate the number of Tcl_Tokens needed to store
	491	* tokens representing the expanded list.
	492	*/
	493
	494	int growthNeeded = wordIndex + 2*elemCount
	495	- parsePtr->numTokens;
	496	parsePtr->numWords += elemCount - 1;
	497	if (growthNeeded > 0) {
	498	TclGrowParseTokenArray(parsePtr, growthNeeded);
	499	tokenPtr = &parsePtr->tokenPtr[wordIndex];
	500	}
	501	parsePtr->numTokens = wordIndex + 2*elemCount;
	502
	503	/*
	504	* Generate a TCL_TOKEN_SIMPLE_WORD token sequence for
	505	* each element of the literal list we are expanding in
	506	* place. Take care with the start and size fields of each
	507	* token so they point to the right literal characters in
	508	* the original script to represent the right expanded
	509	* word value.
	510	*/
	511
	512	nextElem = tokenPtr[1].start;
	513	while (isspace(UCHAR(*nextElem))) {
	514	nextElem++;
	515	}
	516	while (nextElem < listEnd) {
	517	tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
	518	tokenPtr->numComponents = 1;
	519	tokenPtr->start = nextElem;
	520
	521	tokenPtr++;
	522	tokenPtr->type = TCL_TOKEN_TEXT;
	523	tokenPtr->numComponents = 0;
	524	TclFindElement(NULL, nextElem, listEnd - nextElem,
	525	&(tokenPtr->start), &nextElem,
	526	&(tokenPtr->size), NULL);
	527	if (tokenPtr->start + tokenPtr->size == listEnd) {
	528	tokenPtr[-1].size = listEnd - tokenPtr[-1].start;
	529	} else {
	530	tokenPtr[-1].size = tokenPtr->start
	531	+ tokenPtr->size - tokenPtr[-1].start;
	532	tokenPtr[-1].size += (isspace(UCHAR(
	533	tokenPtr->start[tokenPtr->size])) == 0);
	534	}
	535
	536	tokenPtr++;
	537	}
	538	}
	539	} else {
	540	/*
	541	* The word to be expanded is not a literal, so defer
	542	* expansion to compile/eval time by marking with a
	543	* TCL_TOKEN_EXPAND_WORD token.
	544	*/
	545
	546	tokenPtr->type = TCL_TOKEN_EXPAND_WORD;
	547	}
	548	} else if ((tokenPtr->numComponents == 1)
	549	&& (tokenPtr[1].type == TCL_TOKEN_TEXT)) {
	550	tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
	551	}
	552
	553	/*
	554	* Do two additional checks: (a) make sure we're really at the end of
	555	* a word (there might have been garbage left after a quoted or braced
	556	* word), and (b) check for the end of the command.
	557	*/
	558
	559	scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type);
	560	if (scanned) {
	561	src += scanned;
	562	numBytes -= scanned;
	563	continue;
	564	}
	565
	566	if (numBytes == 0) {
	567	parsePtr->term = src;
	568	break;
	569	}
	570	if ((type & terminators) != 0) {
	571	parsePtr->term = src;
	572	src++;
	573	break;
	574	}
	575	if (src[-1] == '"') {
	576	if (interp != NULL) {
	577	Tcl_SetResult(interp, "extra characters after close-quote",
	578	TCL_STATIC);
	579	}
	580	parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
	581	} else {
	582	if (interp != NULL) {
	583	Tcl_SetResult(interp, "extra characters after close-brace",
	584	TCL_STATIC);
	585	}
	586	parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
	587	}
	588	parsePtr->term = src;
	589	goto error;
	590	}
	591
	592	parsePtr->commandSize = src - parsePtr->commandStart;
	593	return TCL_OK;
	594
	595	error:
	596	Tcl_FreeParse(parsePtr);
	597	parsePtr->commandSize = parsePtr->end - parsePtr->commandStart;
	598	return TCL_ERROR;
	599	}
	600
	601	/*
	602	*----------------------------------------------------------------------
	603	*
	604	* ParseWhiteSpace --
	605	*
	606	* Scans up to numBytes bytes starting at src, consuming white space
	607	* between words as defined by Tcl's parsing rules.
	608	*
	609	* Results:
	610	* Returns the number of bytes recognized as white space. Records at
	611	* parsePtr, information about the parse. Records at typePtr the
	612	* character type of the non-whitespace character that terminated the
	613	* scan.
	614	*
	615	* Side effects:
	616	* None.
	617	*
	618	*----------------------------------------------------------------------
	619	*/
	620
	621	static int
	622	ParseWhiteSpace(
	623	const char src, / First character to parse. */
	624	register int numBytes, /* Max number of bytes to scan. */
	625	int incompletePtr, / Set this boolean memory to true if parsing
	626	* indicates an incomplete command. */
	627	char typePtr) / Points to location to store character type
	628	* of character that ends run of whitespace */
	629	{
	630	register char type = TYPE_NORMAL;
	631	register const char *p = src;
	632
	633	while (1) {
	634	while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) {
	635	numBytes--;
	636	p++;
	637	}
	638	if (numBytes && (type & TYPE_SUBS)) {
	639	if (*p != '\\') {
	640	break;
	641	}
	642	if (--numBytes == 0) {
	643	break;
	644	}
	645	if (p[1] != '\n') {
	646	break;
	647	}
	648	p+=2;
	649	if (--numBytes == 0) {
	650	*incompletePtr = 1;
	651	break;
	652	}
	653	continue;
	654	}
	655	break;
	656	}
	657	*typePtr = type;
	658	return (p - src);
	659	}
	660
	661	/*
	662	*----------------------------------------------------------------------
	663	*
	664	* TclParseAllWhiteSpace --
	665	*
	666	* Scans up to numBytes bytes starting at src, consuming all white space
	667	* including the command-terminating newline characters.
	668	*
	669	* Results:
	670	* Returns the number of bytes recognized as white space.
	671	*
	672	*----------------------------------------------------------------------
	673	*/
	674
	675	int
	676	TclParseAllWhiteSpace(
	677	const char src, / First character to parse. */
	678	int numBytes) /* Max number of byes to scan */
	679	{
	680	int dummy;
	681	char type;
	682	const char *p = src;
	683
	684	do {
	685	int scanned = ParseWhiteSpace(p, numBytes, &dummy, &type);
	686
	687	p += scanned;
	688	numBytes -= scanned;
	689	} while (numBytes && (*p == '\n') && (p++, --numBytes));
	690	return (p-src);
	691	}
	692
	693	/*
	694	*----------------------------------------------------------------------
	695	*
	696	* TclParseHex --
	697	*
	698	* Scans a hexadecimal number as a Tcl_UniChar value (e.g., for parsing
	699	* \x and \u escape sequences). At most numBytes bytes are scanned.
	700	*
	701	* Results:
	702	* The numeric value is stored in *resultPtr. Returns the number of bytes
	703	* consumed.
	704	*
	705	* Notes:
	706	* Relies on the following properties of the ASCII character set, with
	707	* which UTF-8 is compatible:
	708	*
	709	* The digits '0' .. '9' and the letters 'A' .. 'Z' and 'a' .. 'z' occupy
	710	* consecutive code points, and '0' < 'A' < 'a'.
	711	*
	712	*----------------------------------------------------------------------
	713	*/
	714
	715	int
	716	TclParseHex(
	717	const char src, / First character to parse. */
	718	int numBytes, /* Max number of byes to scan */
	719	Tcl_UniChar resultPtr) / Points to storage provided by caller where
	720	* the Tcl_UniChar resulting from the
	721	* conversion is to be written. */
	722	{
	723	Tcl_UniChar result = 0;
	724	register const char *p = src;
	725
	726	while (numBytes--) {
	727	unsigned char digit = UCHAR(*p);
	728
	729	if (!isxdigit(digit)) {
	730	break;
	731	}
	732
	733	++p;
	734	result <<= 4;
	735
	736	if (digit >= 'a') {
	737	result \|= (10 + digit - 'a');
	738	} else if (digit >= 'A') {
	739	result \|= (10 + digit - 'A');
	740	} else {
	741	result \|= (digit - '0');
	742	}
	743	}
	744
	745	*resultPtr = result;
	746	return (p - src);
	747	}
	748
	749	/*
	750	*----------------------------------------------------------------------
	751	*
	752	* TclParseBackslash --
	753	*
	754	* Scans up to numBytes bytes starting at src, consuming a backslash
	755	* sequence as defined by Tcl's parsing rules.
	756	*
	757	* Results:
	758	* Records at readPtr the number of bytes making up the backslash
	759	* sequence. Records at dst the UTF-8 encoded equivalent of that
	760	* backslash sequence. Returns the number of bytes written to dst, at
	761	* most TCL_UTF_MAX. Either readPtr or dst may be NULL, if the results
	762	* are not needed, but the return value is the same either way.
	763	*
	764	* Side effects:
	765	* None.
	766	*
	767	*----------------------------------------------------------------------
	768	*/
	769
	770	int
	771	TclParseBackslash(
	772	const char src, / Points to the backslash character of a a
	773	* backslash sequence. */
	774	int numBytes, /* Max number of bytes to scan. */
	775	int readPtr, / NULL, or points to storage where the number
	776	* of bytes scanned should be written. */
	777	char dst) / NULL, or points to buffer where the UTF-8
	778	* encoding of the backslash sequence is to be
	779	* written. At most TCL_UTF_MAX bytes will be
	780	* written there. */
	781	{
	782	register const char *p = src+1;
	783	Tcl_UniChar result;
	784	int count;
	785	char buf[TCL_UTF_MAX];
	786
	787	if (numBytes == 0) {
	788	if (readPtr != NULL) {
	789	*readPtr = 0;
	790	}
	791	return 0;
	792	}
	793
	794	if (dst == NULL) {
	795	dst = buf;
	796	}
	797
	798	if (numBytes == 1) {
	799	/*
	800	* Can only scan the backslash, so return it.
	801	*/
	802
	803	result = '\\';
	804	count = 1;
	805	goto done;
	806	}
	807
	808	count = 2;
	809	switch (*p) {
	810	/*
	811	* Note: in the conversions below, use absolute values (e.g., 0xa)
	812	* rather than symbolic values (e.g. \n) that get converted by the
	813	* compiler. It's possible that compilers on some platforms will do
	814	* the symbolic conversions differently, which could result in
	815	* non-portable Tcl scripts.
	816	*/
	817
	818	case 'a':
	819	result = 0x7;
	820	break;
	821	case 'b':
	822	result = 0x8;
	823	break;
	824	case 'f':
	825	result = 0xc;
	826	break;
	827	case 'n':
	828	result = 0xa;
	829	break;
	830	case 'r':
	831	result = 0xd;
	832	break;
	833	case 't':
	834	result = 0x9;
	835	break;
	836	case 'v':
	837	result = 0xb;
	838	break;
	839	case 'x':
	840	count += TclParseHex(p+1, numBytes-1, &result);
	841	if (count == 2) {
	842	/*
	843	* No hexadigits -> This is just "x".
	844	*/
	845
	846	result = 'x';
	847	} else {
	848	/*
	849	* Keep only the last byte (2 hex digits).
	850	*/
	851	result = (unsigned char) result;
	852	}
	853	break;
	854	case 'u':
	855	count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-1, &result);
	856	if (count == 2) {
	857	/*
	858	* No hexadigits -> This is just "u".
	859	*/
	860	result = 'u';
	861	}
	862	break;
	863	case '\n':
	864	count--;
	865	do {
	866	p++;
	867	count++;
	868	} while ((count < numBytes) && ((p == ' ') \|\| (p == '\t')));
	869	result = ' ';
	870	break;
	871	case 0:
	872	result = '\\';
	873	count = 1;
	874	break;
	875	default:
	876	/*
	877	* Check for an octal number \oo?o?
	878	*/
	879
	880	if (isdigit(UCHAR(p)) && (UCHAR(p) < '8')) { /* INTL: digit */
	881	result = (unsigned char)(*p - '0');
	882	p++;
	883	if ((numBytes == 2) \|\| !isdigit(UCHAR(p)) / INTL: digit */
	884	\|\| (UCHAR(*p) >= '8')) {
	885	break;
	886	}
	887	count = 3;
	888	result = (unsigned char)((result << 3) + (*p - '0'));
	889	p++;
	890	if ((numBytes == 3) \|\| !isdigit(UCHAR(p)) / INTL: digit */
	891	\|\| (UCHAR(*p) >= '8')) {
	892	break;
	893	}
	894	count = 4;
	895	result = (unsigned char)((result << 3) + (*p - '0'));
	896	break;
	897	}
	898
	899	/*
	900	* We have to convert here in case the user has put a backslash in
	901	* front of a multi-byte utf-8 character. While this means nothing
	902	* special, we shouldn't break up a correct utf-8 character. [Bug
	903	* #217987] test subst-3.2
	904	*/
	905
	906	if (Tcl_UtfCharComplete(p, numBytes - 1)) {
	907	count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */
	908	} else {
	909	char utfBytes[TCL_UTF_MAX];
	910
	911	memcpy(utfBytes, p, (size_t) (numBytes - 1));
	912	utfBytes[numBytes - 1] = '\0';
	913	count = Tcl_UtfToUniChar(utfBytes, &result) + 1;
	914	}
	915	break;
	916	}
	917
	918	done:
	919	if (readPtr != NULL) {
	920	*readPtr = count;
	921	}
	922	return Tcl_UniCharToUtf((int) result, dst);
	923	}
	924
	925	/*
	926	*----------------------------------------------------------------------
	927	*
	928	* ParseComment --
	929	*
	930	* Scans up to numBytes bytes starting at src, consuming a Tcl comment as
	931	* defined by Tcl's parsing rules.
	932	*
	933	* Results:
	934	* Records in parsePtr information about the parse. Returns the number of
	935	* bytes consumed.
	936	*
	937	* Side effects:
	938	* None.
	939	*
	940	*----------------------------------------------------------------------
	941	*/
	942
	943	static int
	944	ParseComment(
	945	const char src, / First character to parse. */
	946	register int numBytes, /* Max number of bytes to scan. */
	947	Tcl_Parse parsePtr) / Information about parse in progress.
	948	* Updated if parsing indicates an incomplete
	949	* command. */
	950	{
	951	register const char *p = src;
	952
	953	while (numBytes) {
	954	char type;
	955	int scanned;
	956
	957	scanned = TclParseAllWhiteSpace(p, numBytes);
	958	p += scanned;
	959	numBytes -= scanned;
	960
	961	if ((numBytes == 0) \|\| (*p != '#')) {
	962	break;
	963	}
	964	if (parsePtr->commentStart == NULL) {
	965	parsePtr->commentStart = p;
	966	}
	967
	968	while (numBytes) {
	969	if (*p == '\\') {
	970	scanned = ParseWhiteSpace(p, numBytes, &parsePtr->incomplete,
	971	&type);
	972	if (scanned) {
	973	p += scanned;
	974	numBytes -= scanned;
	975	} else {
	976	/*
	977	* General backslash substitution in comments isn't part
	978	* of the formal spec, but test parse-15.47 and history
	979	* indicate that it has been the de facto rule. Don't
	980	* change it now.
	981	*/
	982
	983	TclParseBackslash(p, numBytes, &scanned, NULL);
	984	p += scanned;
	985	numBytes -= scanned;
	986	}
	987	} else {
	988	p++;
	989	numBytes--;
	990	if (p[-1] == '\n') {
	991	break;
	992	}
	993	}
	994	}
	995	parsePtr->commentSize = p - parsePtr->commentStart;
	996	}
	997	return (p - src);
	998	}
	999
	1000	/*
	1001	*----------------------------------------------------------------------
	1002	*
	1003	* ParseTokens --
	1004	*
	1005	* This function forms the heart of the Tcl parser. It parses one or more
	1006	* tokens from a string, up to a termination point specified by the
	1007	* caller. This function is used to parse unquoted command words (those
	1008	* not in quotes or braces), words in quotes, and array indices for
	1009	* variables. No more than numBytes bytes will be scanned.
	1010	*
	1011	* Results:
	1012	* Tokens are added to parsePtr and parsePtr->term is filled in with the
	1013	* address of the character that terminated the parse (the first one
	1014	* whose CHAR_TYPE matched mask or the character at parsePtr->end). The
	1015	* return value is TCL_OK if the parse completed successfully and
	1016	* TCL_ERROR otherwise. If a parse error occurs and parsePtr->interp is
	1017	* not NULL, then an error message is left in the interpreter's result.
	1018	*
	1019	* Side effects:
	1020	* None.
	1021	*
	1022	*----------------------------------------------------------------------
	1023	*/
	1024
	1025	static int
	1026	ParseTokens(
	1027	register const char src, / First character to parse. */
	1028	register int numBytes, /* Max number of bytes to scan. */
	1029	int mask, /* Specifies when to stop parsing. The parse
	1030	* stops at the first unquoted character whose
	1031	* CHAR_TYPE contains any of the bits in
	1032	* mask. */
	1033	int flags, /* OR-ed bits indicating what substitutions to
	1034	* perform: TCL_SUBST_COMMANDS,
	1035	* TCL_SUBST_VARIABLES, and
	1036	* TCL_SUBST_BACKSLASHES */
	1037	Tcl_Parse parsePtr) / Information about parse in progress.
	1038	* Updated with additional tokens and
	1039	* termination information. */
	1040	{
	1041	char type;
	1042	int originalTokens;
	1043	int noSubstCmds = !(flags & TCL_SUBST_COMMANDS);
	1044	int noSubstVars = !(flags & TCL_SUBST_VARIABLES);
	1045	int noSubstBS = !(flags & TCL_SUBST_BACKSLASHES);
	1046	Tcl_Token *tokenPtr;
	1047
	1048	/*
	1049	* Each iteration through the following loop adds one token of type
	1050	* TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or TCL_TOKEN_VARIABLE
	1051	* to parsePtr. For TCL_TOKEN_VARIABLE tokens, additional tokens are added
	1052	* for the parsed variable name.
	1053	*/
	1054
	1055	originalTokens = parsePtr->numTokens;
	1056	while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) {
	1057	TclGrowParseTokenArray(parsePtr, 1);
	1058	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
	1059	tokenPtr->start = src;
	1060	tokenPtr->numComponents = 0;
	1061
	1062	if ((type & TYPE_SUBS) == 0) {
	1063	/*
	1064	* This is a simple range of characters. Scan to find the end of
	1065	* the range.
	1066	*/
	1067
	1068	while ((++src, --numBytes)
	1069	&& !(CHAR_TYPE(*src) & (mask \| TYPE_SUBS))) {
	1070	/* empty loop */
	1071	}
	1072	tokenPtr->type = TCL_TOKEN_TEXT;
	1073	tokenPtr->size = src - tokenPtr->start;
	1074	parsePtr->numTokens++;
	1075	} else if (*src == '$') {
	1076	int varToken;
	1077
	1078	if (noSubstVars) {
	1079	tokenPtr->type = TCL_TOKEN_TEXT;
	1080	tokenPtr->size = 1;
	1081	parsePtr->numTokens++;
	1082	src++;
	1083	numBytes--;
	1084	continue;
	1085	}
	1086
	1087	/*
	1088	* This is a variable reference. Call Tcl_ParseVarName to do all
	1089	* the dirty work of parsing the name.
	1090	*/
	1091
	1092	varToken = parsePtr->numTokens;
	1093	if (Tcl_ParseVarName(parsePtr->interp, src, numBytes, parsePtr,
	1094	1) != TCL_OK) {
	1095	return TCL_ERROR;
	1096	}
	1097	src += parsePtr->tokenPtr[varToken].size;
	1098	numBytes -= parsePtr->tokenPtr[varToken].size;
	1099	} else if (*src == '[') {
	1100	Tcl_Parse *nestedPtr;
	1101
	1102	if (noSubstCmds) {
	1103	tokenPtr->type = TCL_TOKEN_TEXT;
	1104	tokenPtr->size = 1;
	1105	parsePtr->numTokens++;
	1106	src++;
	1107	numBytes--;
	1108	continue;
	1109	}
	1110
	1111	/*
	1112	* Command substitution. Call Tcl_ParseCommand recursively (and
	1113	* repeatedly) to parse the nested command(s), then throw away the
	1114	* parse information.
	1115	*/
	1116
	1117	src++;
	1118	numBytes--;
	1119	nestedPtr = (Tcl_Parse *)
	1120	TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse));
	1121	while (1) {
	1122	if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1,
	1123	nestedPtr) != TCL_OK) {
	1124	parsePtr->errorType = nestedPtr->errorType;
	1125	parsePtr->term = nestedPtr->term;
	1126	parsePtr->incomplete = nestedPtr->incomplete;
	1127	TclStackFree(parsePtr->interp, nestedPtr);
	1128	return TCL_ERROR;
	1129	}
	1130	src = nestedPtr->commandStart + nestedPtr->commandSize;
	1131	numBytes = parsePtr->end - src;
	1132	Tcl_FreeParse(nestedPtr);
	1133
	1134	/*
	1135	* Check for the closing ']' that ends the command
	1136	* substitution. It must have been the last character of the
	1137	* parsed command.
	1138	*/
	1139
	1140	if ((nestedPtr->term < parsePtr->end)
	1141	&& (*(nestedPtr->term) == ']')
	1142	&& !(nestedPtr->incomplete)) {
	1143	break;
	1144	}
	1145	if (numBytes == 0) {
	1146	if (parsePtr->interp != NULL) {
	1147	Tcl_SetResult(parsePtr->interp,
	1148	"missing close-bracket", TCL_STATIC);
	1149	}
	1150	parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
	1151	parsePtr->term = tokenPtr->start;
	1152	parsePtr->incomplete = 1;
	1153	TclStackFree(parsePtr->interp, nestedPtr);
	1154	return TCL_ERROR;
	1155	}
	1156	}
	1157	TclStackFree(parsePtr->interp, nestedPtr);
	1158	tokenPtr->type = TCL_TOKEN_COMMAND;
	1159	tokenPtr->size = src - tokenPtr->start;
	1160	parsePtr->numTokens++;
	1161	} else if (*src == '\\') {
	1162	if (noSubstBS) {
	1163	tokenPtr->type = TCL_TOKEN_TEXT;
	1164	tokenPtr->size = 1;
	1165	parsePtr->numTokens++;
	1166	src++;
	1167	numBytes--;
	1168	continue;
	1169	}
	1170
	1171	/*
	1172	* Backslash substitution.
	1173	*/
	1174
	1175	TclParseBackslash(src, numBytes, &tokenPtr->size, NULL);
	1176
	1177	if (tokenPtr->size == 1) {
	1178	/*
	1179	* Just a backslash, due to end of string.
	1180	*/
	1181
	1182	tokenPtr->type = TCL_TOKEN_TEXT;
	1183	parsePtr->numTokens++;
	1184	src++;
	1185	numBytes--;
	1186	continue;
	1187	}
	1188
	1189	if (src[1] == '\n') {
	1190	if (numBytes == 2) {
	1191	parsePtr->incomplete = 1;
	1192	}
	1193
	1194	/*
	1195	* Note: backslash-newline is special in that it is treated
	1196	* the same as a space character would be. This means that it
	1197	* could terminate the token.
	1198	*/
	1199
	1200	if (mask & TYPE_SPACE) {
	1201	if (parsePtr->numTokens == originalTokens) {
	1202	goto finishToken;
	1203	}
	1204	break;
	1205	}
	1206	}
	1207
	1208	tokenPtr->type = TCL_TOKEN_BS;
	1209	parsePtr->numTokens++;
	1210	src += tokenPtr->size;
	1211	numBytes -= tokenPtr->size;
	1212	} else if (*src == 0) {
	1213	tokenPtr->type = TCL_TOKEN_TEXT;
	1214	tokenPtr->size = 1;
	1215	parsePtr->numTokens++;
	1216	src++;
	1217	numBytes--;
	1218	} else {
	1219	Tcl_Panic("ParseTokens encountered unknown character");
	1220	}
	1221	}
	1222	if (parsePtr->numTokens == originalTokens) {
	1223	/*
	1224	* There was nothing in this range of text. Add an empty token for the
	1225	* empty range, so that there is always at least one token added.
	1226	*/
	1227
	1228	TclGrowParseTokenArray(parsePtr, 1);
	1229	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
	1230	tokenPtr->start = src;
	1231	tokenPtr->numComponents = 0;
	1232
	1233	finishToken:
	1234	tokenPtr->type = TCL_TOKEN_TEXT;
	1235	tokenPtr->size = 0;
	1236	parsePtr->numTokens++;
	1237	}
	1238	parsePtr->term = src;
	1239	return TCL_OK;
	1240	}
	1241
	1242	/*
	1243	*----------------------------------------------------------------------
	1244	*
	1245	* Tcl_FreeParse --
	1246	*
	1247	* This function is invoked to free any dynamic storage that may have
	1248	* been allocated by a previous call to Tcl_ParseCommand.
	1249	*
	1250	* Results:
	1251	* None.
	1252	*
	1253	* Side effects:
	1254	* If there is any dynamically allocated memory in *parsePtr, it is
	1255	* freed.
	1256	*
	1257	*----------------------------------------------------------------------
	1258	*/
	1259
	1260	void
	1261	Tcl_FreeParse(
	1262	Tcl_Parse parsePtr) / Structure that was filled in by a previous
	1263	* call to Tcl_ParseCommand. */
	1264	{
	1265	if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	1266	ckfree((char *) parsePtr->tokenPtr);
	1267	parsePtr->tokenPtr = parsePtr->staticTokens;
	1268	}
	1269	}
	1270
	1271	/*
	1272	*----------------------------------------------------------------------
	1273	*
	1274	* Tcl_ParseVarName --
	1275	*
	1276	* Given a string starting with a $ sign, parse off a variable name and
	1277	* return information about the parse. No more than numBytes bytes will
	1278	* be scanned.
	1279	*
	1280	* Results:
	1281	* The return value is TCL_OK if the command was parsed successfully and
	1282	* TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an
	1283	* error message is left in its result. On a successful return, tokenPtr
	1284	* and numTokens fields of parsePtr are filled in with information about
	1285	* the variable name that was parsed. The "size" field of the first new
	1286	* token gives the total number of bytes in the variable name. Other
	1287	* fields in parsePtr are undefined.
	1288	*
	1289	* Side effects:
	1290	* If there is insufficient space in parsePtr to hold all the information
	1291	* about the command, then additional space is malloc-ed. If the function
	1292	* returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to
	1293	* release any additional space that was allocated.
	1294	*
	1295	*----------------------------------------------------------------------
	1296	*/
	1297
	1298	int
	1299	Tcl_ParseVarName(
	1300	Tcl_Interp interp, / Interpreter to use for error reporting; if
	1301	* NULL, then no error message is provided. */
	1302	const char start, / Start of variable substitution string.
	1303	* First character must be "$". */
	1304	register int numBytes, /* Total number of bytes in string. If < 0,
	1305	* the string consists of all bytes up to the
	1306	* first null character. */
	1307	Tcl_Parse parsePtr, / Structure to fill in with information about
	1308	* the variable name. */
	1309	int append) /* Non-zero means append tokens to existing
	1310	* information in parsePtr; zero means ignore
	1311	* existing tokens in parsePtr and
	1312	* reinitialize it. */
	1313	{
	1314	Tcl_Token *tokenPtr;
	1315	register const char *src;
	1316	unsigned char c;
	1317	int varIndex, offset;
	1318	Tcl_UniChar ch;
	1319	unsigned array;
	1320
	1321	if ((numBytes == 0) \|\| (start == NULL)) {
	1322	return TCL_ERROR;
	1323	}
	1324	if (numBytes < 0) {
	1325	numBytes = strlen(start);
	1326	}
	1327
	1328	if (!append) {
	1329	TclParseInit(interp, start, numBytes, parsePtr);
	1330	}
	1331
	1332	/*
	1333	* Generate one token for the variable, an additional token for the name,
	1334	* plus any number of additional tokens for the index, if there is one.
	1335	*/
	1336
	1337	src = start;
	1338	TclGrowParseTokenArray(parsePtr, 2);
	1339	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
	1340	tokenPtr->type = TCL_TOKEN_VARIABLE;
	1341	tokenPtr->start = src;
	1342	varIndex = parsePtr->numTokens;
	1343	parsePtr->numTokens++;
	1344	tokenPtr++;
	1345	src++;
	1346	numBytes--;
	1347	if (numBytes == 0) {
	1348	goto justADollarSign;
	1349	}
	1350	tokenPtr->type = TCL_TOKEN_TEXT;
	1351	tokenPtr->start = src;
	1352	tokenPtr->numComponents = 0;
	1353
	1354	/*
	1355	* The name of the variable can have three forms:
	1356	* 1. The $ sign is followed by an open curly brace. Then the variable
	1357	* name is everything up to the next close curly brace, and the
	1358	* variable is a scalar variable.
	1359	* 2. The $ sign is not followed by an open curly brace. Then the variable
	1360	* name is everything up to the next character that isn't a letter,
	1361	* digit, or underscore. :: sequences are also considered part of the
	1362	* variable name, in order to support namespaces. If the following
	1363	* character is an open parenthesis, then the information between
	1364	* parentheses is the array element name.
	1365	* 3. The $ sign is followed by something that isn't a letter, digit, or
	1366	* underscore: in this case, there is no variable name and the token is
	1367	* just "$".
	1368	*/
	1369
	1370	if (*src == '{') {
	1371	src++;
	1372	numBytes--;
	1373	tokenPtr->type = TCL_TOKEN_TEXT;
	1374	tokenPtr->start = src;
	1375	tokenPtr->numComponents = 0;
	1376
	1377	while (numBytes && (*src != '}')) {
	1378	numBytes--;
	1379	src++;
	1380	}
	1381	if (numBytes == 0) {
	1382	if (parsePtr->interp != NULL) {
	1383	Tcl_SetResult(parsePtr->interp,
	1384	"missing close-brace for variable name", TCL_STATIC);
	1385	}
	1386	parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
	1387	parsePtr->term = tokenPtr->start-1;
	1388	parsePtr->incomplete = 1;
	1389	goto error;
	1390	}
	1391	tokenPtr->size = src - tokenPtr->start;
	1392	tokenPtr[-1].size = src - tokenPtr[-1].start;
	1393	parsePtr->numTokens++;
	1394	src++;
	1395	} else {
	1396	tokenPtr->type = TCL_TOKEN_TEXT;
	1397	tokenPtr->start = src;
	1398	tokenPtr->numComponents = 0;
	1399
	1400	while (numBytes) {
	1401	if (Tcl_UtfCharComplete(src, numBytes)) {
	1402	offset = Tcl_UtfToUniChar(src, &ch);
	1403	} else {
	1404	char utfBytes[TCL_UTF_MAX];
	1405
	1406	memcpy(utfBytes, src, (size_t) numBytes);
	1407	utfBytes[numBytes] = '\0';
	1408	offset = Tcl_UtfToUniChar(utfBytes, &ch);
	1409	}
	1410	c = UCHAR(ch);
	1411	if (isalnum(c) \|\| (c == '_')) { /* INTL: ISO only, UCHAR. */
	1412	src += offset;
	1413	numBytes -= offset;
	1414	continue;
	1415	}
	1416	if ((c == ':') && (numBytes != 1) && (src[1] == ':')) {
	1417	src += 2;
	1418	numBytes -= 2;
	1419	while (numBytes && (*src == ':')) {
	1420	src++;
	1421	numBytes--;
	1422	}
	1423	continue;
	1424	}
	1425	break;
	1426	}
	1427
	1428	/*
	1429	* Support for empty array names here.
	1430	*/
	1431
	1432	array = (numBytes && (*src == '('));
	1433	tokenPtr->size = src - tokenPtr->start;
	1434	if ((tokenPtr->size == 0) && !array) {
	1435	goto justADollarSign;
	1436	}
	1437	parsePtr->numTokens++;
	1438	if (array) {
	1439	/*
	1440	* This is a reference to an array element. Call ParseTokens
	1441	* recursively to parse the element name, since it could contain
	1442	* any number of substitutions.
	1443	*/
	1444
	1445	if (TCL_OK != ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN,
	1446	TCL_SUBST_ALL, parsePtr)) {
	1447	goto error;
	1448	}
	1449	if ((parsePtr->term == src+numBytes) \|\| (*parsePtr->term != ')')){
	1450	if (parsePtr->interp != NULL) {
	1451	Tcl_SetResult(parsePtr->interp, "missing )",
	1452	TCL_STATIC);
	1453	}
	1454	parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
	1455	parsePtr->term = src;
	1456	parsePtr->incomplete = 1;
	1457	goto error;
	1458	}
	1459	src = parsePtr->term + 1;
	1460	}
	1461	}
	1462	tokenPtr = &parsePtr->tokenPtr[varIndex];
	1463	tokenPtr->size = src - tokenPtr->start;
	1464	tokenPtr->numComponents = parsePtr->numTokens - (varIndex + 1);
	1465	return TCL_OK;
	1466
	1467	/*
	1468	* The dollar sign isn't followed by a variable name. Replace the
	1469	* TCL_TOKEN_VARIABLE token with a TCL_TOKEN_TEXT token for the dollar
	1470	* sign.
	1471	*/
	1472
	1473	justADollarSign:
	1474	tokenPtr = &parsePtr->tokenPtr[varIndex];
	1475	tokenPtr->type = TCL_TOKEN_TEXT;
	1476	tokenPtr->size = 1;
	1477	tokenPtr->numComponents = 0;
	1478	return TCL_OK;
	1479
	1480	error:
	1481	Tcl_FreeParse(parsePtr);
	1482	return TCL_ERROR;
	1483	}
	1484
	1485	/*
	1486	*----------------------------------------------------------------------
	1487	*
	1488	* Tcl_ParseVar --
	1489	*
	1490	* Given a string starting with a $ sign, parse off a variable name and
	1491	* return its value.
	1492	*
	1493	* Results:
	1494	* The return value is the contents of the variable given by the leading
	1495	* characters of string. If termPtr isn't NULL, *termPtr gets filled in
	1496	* with the address of the character just after the last one in the
	1497	* variable specifier. If the variable doesn't exist, then the return
	1498	* value is NULL and an error message will be left in interp's result.
	1499	*
	1500	* Side effects:
	1501	* None.
	1502	*
	1503	*----------------------------------------------------------------------
	1504	*/
	1505
	1506	const char *
	1507	Tcl_ParseVar(
	1508	Tcl_Interp interp, / Context for looking up variable. */
	1509	register const char start, / Start of variable substitution. First
	1510	* character must be "$". */
	1511	const char *termPtr) / If non-NULL, points to word to fill in with
	1512	* character just after last one in the
	1513	* variable specifier. */
	1514	{
	1515	register Tcl_Obj *objPtr;
	1516	int code;
	1517	Tcl_Parse parsePtr = (Tcl_Parse )
	1518	TclStackAlloc(interp, sizeof(Tcl_Parse));
	1519
	1520	if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) {
	1521	TclStackFree(interp, parsePtr);
	1522	return NULL;
	1523	}
	1524
	1525	if (termPtr != NULL) {
	1526	*termPtr = start + parsePtr->tokenPtr->size;
	1527	}
	1528	if (parsePtr->numTokens == 1) {
	1529	/*
	1530	* There isn't a variable name after all: the $ is just a $.
	1531	*/
	1532
	1533	TclStackFree(interp, parsePtr);
	1534	return "$";
	1535	}
	1536
	1537	code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens,
	1538	NULL, 1);
	1539	TclStackFree(interp, parsePtr);
	1540	if (code != TCL_OK) {
	1541	return NULL;
	1542	}
	1543	objPtr = Tcl_GetObjResult(interp);
	1544
	1545	/*
	1546	* At this point we should have an object containing the value of a
	1547	* variable. Just return the string from that object.
	1548	*
	1549	* This should have returned the object for the user to manage, but
	1550	* instead we have some weak reference to the string value in the object,
	1551	* which is why we make sure the object exists after resetting the result.
	1552	* This isn't ideal, but it's the best we can do with the current
	1553	* documented interface. -- hobbs
	1554	*/
	1555
	1556	if (!Tcl_IsShared(objPtr)) {
	1557	Tcl_IncrRefCount(objPtr);
	1558	}
	1559	Tcl_ResetResult(interp);
	1560	return TclGetString(objPtr);
	1561	}
	1562
	1563	/*
	1564	*----------------------------------------------------------------------
	1565	*
	1566	* Tcl_ParseBraces --
	1567	*
	1568	* Given a string in braces such as a Tcl command argument or a string
	1569	* value in a Tcl expression, this function parses the string and returns
	1570	* information about the parse. No more than numBytes bytes will be
	1571	* scanned.
	1572	*
	1573	* Results:
	1574	* The return value is TCL_OK if the string was parsed successfully and
	1575	* TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an
	1576	* error message is left in its result. On a successful return, tokenPtr
	1577	* and numTokens fields of parsePtr are filled in with information about
	1578	* the string that was parsed. Other fields in parsePtr are undefined.
	1579	* termPtr is set to point to the character just after the last one in
	1580	* the braced string.
	1581	*
	1582	* Side effects:
	1583	* If there is insufficient space in parsePtr to hold all the information
	1584	* about the command, then additional space is malloc-ed. If the function
	1585	* returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to
	1586	* release any additional space that was allocated.
	1587	*
	1588	*----------------------------------------------------------------------
	1589	*/
	1590
	1591	int
	1592	Tcl_ParseBraces(
	1593	Tcl_Interp interp, / Interpreter to use for error reporting; if
	1594	* NULL, then no error message is provided. */
	1595	const char start, / Start of string enclosed in braces. The
	1596	* first character must be {'. */
	1597	register int numBytes, /* Total number of bytes in string. If < 0,
	1598	* the string consists of all bytes up to the
	1599	* first null character. */
	1600	register Tcl_Parse *parsePtr,
	1601	/* Structure to fill in with information about
	1602	* the string. */
	1603	int append, /* Non-zero means append tokens to existing
	1604	* information in parsePtr; zero means ignore
	1605	* existing tokens in parsePtr and
	1606	* reinitialize it. */
	1607	const char *termPtr) / If non-NULL, points to word in which to
	1608	* store a pointer to the character just after
	1609	* the terminating '}' if the parse was
	1610	* successful. */
	1611	{
	1612	Tcl_Token *tokenPtr;
	1613	register const char *src;
	1614	int startIndex, level, length;
	1615
	1616	if ((numBytes == 0) \|\| (start == NULL)) {
	1617	return TCL_ERROR;
	1618	}
	1619	if (numBytes < 0) {
	1620	numBytes = strlen(start);
	1621	}
	1622
	1623	if (!append) {
	1624	TclParseInit(interp, start, numBytes, parsePtr);
	1625	}
	1626
	1627	src = start;
	1628	startIndex = parsePtr->numTokens;
	1629
	1630	TclGrowParseTokenArray(parsePtr, 1);
	1631	tokenPtr = &parsePtr->tokenPtr[startIndex];
	1632	tokenPtr->type = TCL_TOKEN_TEXT;
	1633	tokenPtr->start = src+1;
	1634	tokenPtr->numComponents = 0;
	1635	level = 1;
	1636	while (1) {
	1637	while (++src, --numBytes) {
	1638	if (CHAR_TYPE(*src) != TYPE_NORMAL) {
	1639	break;
	1640	}
	1641	}
	1642	if (numBytes == 0) {
	1643	goto missingBraceError;
	1644	}
	1645
	1646	switch (*src) {
	1647	case '{':
	1648	level++;
	1649	break;
	1650	case '}':
	1651	if (--level == 0) {
	1652	/*
	1653	* Decide if we need to finish emitting a partially-finished
	1654	* token. There are 3 cases:
	1655	* {abc \newline xyz} or {xyz}
	1656	* - finish emitting "xyz" token
	1657	* {abc \newline}
	1658	* - don't emit token after \newline
	1659	* {} - finish emitting zero-sized token
	1660	*
	1661	* The last case ensures that there is a token (even if empty)
	1662	* that describes the braced string.
	1663	*/
	1664
	1665	if ((src != tokenPtr->start)
	1666	\|\| (parsePtr->numTokens == startIndex)) {
	1667	tokenPtr->size = (src - tokenPtr->start);
	1668	parsePtr->numTokens++;
	1669	}
	1670	if (termPtr != NULL) {
	1671	*termPtr = src+1;
	1672	}
	1673	return TCL_OK;
	1674	}
	1675	break;
	1676	case '\\':
	1677	TclParseBackslash(src, numBytes, &length, NULL);
	1678	if ((length > 1) && (src[1] == '\n')) {
	1679	/*
	1680	* A backslash-newline sequence must be collapsed, even inside
	1681	* braces, so we have to split the word into multiple tokens
	1682	* so that the backslash-newline can be represented
	1683	* explicitly.
	1684	*/
	1685
	1686	if (numBytes == 2) {
	1687	parsePtr->incomplete = 1;
	1688	}
	1689	tokenPtr->size = (src - tokenPtr->start);
	1690	if (tokenPtr->size != 0) {
	1691	parsePtr->numTokens++;
	1692	}
	1693	TclGrowParseTokenArray(parsePtr, 2);
	1694	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
	1695	tokenPtr->type = TCL_TOKEN_BS;
	1696	tokenPtr->start = src;
	1697	tokenPtr->size = length;
	1698	tokenPtr->numComponents = 0;
	1699	parsePtr->numTokens++;
	1700
	1701	src += length - 1;
	1702	numBytes -= length - 1;
	1703	tokenPtr++;
	1704	tokenPtr->type = TCL_TOKEN_TEXT;
	1705	tokenPtr->start = src + 1;
	1706	tokenPtr->numComponents = 0;
	1707	} else {
	1708	src += length - 1;
	1709	numBytes -= length - 1;
	1710	}
	1711	break;
	1712	}
	1713	}
	1714
	1715	missingBraceError:
	1716	parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
	1717	parsePtr->term = start;
	1718	parsePtr->incomplete = 1;
	1719	if (parsePtr->interp == NULL) {
	1720	/*
	1721	* Skip straight to the exit code since we have no interpreter to put
	1722	* error message in.
	1723	*/
	1724
	1725	goto error;
	1726	}
	1727
	1728	Tcl_SetResult(parsePtr->interp, "missing close-brace", TCL_STATIC);
	1729
	1730	/*
	1731	* Guess if the problem is due to comments by searching the source string
	1732	* for a possible open brace within the context of a comment. Since we
	1733	* aren't performing a full Tcl parse, just look for an open brace
	1734	* preceded by a '<whitespace>#' on the same line.
	1735	*/
	1736
	1737	{
	1738	register int openBrace = 0;
	1739
	1740	while (--src > start) {
	1741	switch (*src) {
	1742	case '{':
	1743	openBrace = 1;
	1744	break;
	1745	case '\n':
	1746	openBrace = 0;
	1747	break;
	1748	case '#' :
	1749	if (openBrace && isspace(UCHAR(src[-1]))) {
	1750	Tcl_AppendResult(parsePtr->interp,
	1751	": possible unbalanced brace in comment", NULL);
	1752	goto error;
	1753	}
	1754	break;
	1755	}
	1756	}
	1757	}
	1758
	1759	error:
	1760	Tcl_FreeParse(parsePtr);
	1761	return TCL_ERROR;
	1762	}
	1763
	1764	/*
	1765	*----------------------------------------------------------------------
	1766	*
	1767	* Tcl_ParseQuotedString --
	1768	*
	1769	* Given a double-quoted string such as a quoted Tcl command argument or
	1770	* a quoted value in a Tcl expression, this function parses the string
	1771	* and returns information about the parse. No more than numBytes bytes
	1772	* will be scanned.
	1773	*
	1774	* Results:
	1775	* The return value is TCL_OK if the string was parsed successfully and
	1776	* TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an
	1777	* error message is left in its result. On a successful return, tokenPtr
	1778	* and numTokens fields of parsePtr are filled in with information about
	1779	* the string that was parsed. Other fields in parsePtr are undefined.
	1780	* termPtr is set to point to the character just after the quoted
	1781	* string's terminating close-quote.
	1782	*
	1783	* Side effects:
	1784	* If there is insufficient space in parsePtr to hold all the information
	1785	* about the command, then additional space is malloc-ed. If the function
	1786	* returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to
	1787	* release any additional space that was allocated.
	1788	*
	1789	*----------------------------------------------------------------------
	1790	*/
	1791
	1792	int
	1793	Tcl_ParseQuotedString(
	1794	Tcl_Interp interp, / Interpreter to use for error reporting; if
	1795	* NULL, then no error message is provided. */
	1796	const char start, / Start of the quoted string. The first
	1797	* character must be '"'. */
	1798	register int numBytes, /* Total number of bytes in string. If < 0,
	1799	* the string consists of all bytes up to the
	1800	* first null character. */
	1801	register Tcl_Parse *parsePtr,
	1802	/* Structure to fill in with information about
	1803	* the string. */
	1804	int append, /* Non-zero means append tokens to existing
	1805	* information in parsePtr; zero means ignore
	1806	* existing tokens in parsePtr and
	1807	* reinitialize it. */
	1808	const char *termPtr) / If non-NULL, points to word in which to
	1809	* store a pointer to the character just after
	1810	* the quoted string's terminating close-quote
	1811	* if the parse succeeds. */
	1812	{
	1813	if ((numBytes == 0) \|\| (start == NULL)) {
	1814	return TCL_ERROR;
	1815	}
	1816	if (numBytes < 0) {
	1817	numBytes = strlen(start);
	1818	}
	1819
	1820	if (!append) {
	1821	TclParseInit(interp, start, numBytes, parsePtr);
	1822	}
	1823
	1824	if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE, TCL_SUBST_ALL,
	1825	parsePtr)) {
	1826	goto error;
	1827	}
	1828	if (*parsePtr->term != '"') {
	1829	if (parsePtr->interp != NULL) {
	1830	Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC);
	1831	}
	1832	parsePtr->errorType = TCL_PARSE_MISSING_QUOTE;
	1833	parsePtr->term = start;
	1834	parsePtr->incomplete = 1;
	1835	goto error;
	1836	}
	1837	if (termPtr != NULL) {
	1838	*termPtr = (parsePtr->term + 1);
	1839	}
	1840	return TCL_OK;
	1841
	1842	error:
	1843	Tcl_FreeParse(parsePtr);
	1844	return TCL_ERROR;
	1845	}
	1846
	1847	/*
	1848	*----------------------------------------------------------------------
	1849	*
	1850	* Tcl_SubstObj --
	1851	*
	1852	* This function performs the substitutions specified on the given string
	1853	* as described in the user documentation for the "subst" Tcl command.
	1854	*
	1855	* Results:
	1856	* A Tcl_Obj* containing the substituted string, or NULL to indicate that
	1857	* an error occurred.
	1858	*
	1859	* Side effects:
	1860	* See the user documentation.
	1861	*
	1862	*----------------------------------------------------------------------
	1863	*/
	1864
	1865	Tcl_Obj *
	1866	Tcl_SubstObj(
	1867	Tcl_Interp interp, / Interpreter in which substitution occurs */
	1868	Tcl_Obj objPtr, / The value to be substituted. */
	1869	int flags) /* What substitutions to do. */
	1870	{
	1871	int length, tokensLeft, code;
	1872	Tcl_Token *endTokenPtr;
	1873	Tcl_Obj result, errMsg = NULL;
	1874	CONST char *p = TclGetStringFromObj(objPtr, &length);
	1875	Tcl_Parse parsePtr = (Tcl_Parse )
	1876	TclStackAlloc(interp, sizeof(Tcl_Parse));
	1877
	1878	TclParseInit(interp, p, length, parsePtr);
	1879
	1880	/*
	1881	* First parse the string rep of objPtr, as if it were enclosed as a
	1882	* "-quoted word in a normal Tcl command. Honor flags that selectively
	1883	* inhibit types of substitution.
	1884	*/
	1885
	1886	if (TCL_OK != ParseTokens(p, length, /* mask */ 0, flags, parsePtr)) {
	1887	/*
	1888	* There was a parse error. Save the error message for possible
	1889	* reporting later.
	1890	*/
	1891
	1892	errMsg = Tcl_GetObjResult(interp);
	1893	Tcl_IncrRefCount(errMsg);
	1894
	1895	/*
	1896	* We need to re-parse to get the portion of the string we can [subst]
	1897	* before the parse error. Sadly, all the Tcl_Token's created by the
	1898	* first parse attempt are gone, freed according to the public spec
	1899	* for the Tcl_Parse* routines. The only clue we have is parse.term,
	1900	* which points to either the unmatched opener, or to characters that
	1901	* follow a close brace or close quote.
	1902	*
	1903	* Call ParseTokens again, working on the string up to parse.term.
	1904	* Keep repeating until we get a good parse on a prefix.
	1905	*/
	1906
	1907	do {
	1908	parsePtr->numTokens = 0;
	1909	parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
	1910	parsePtr->end = parsePtr->term;
	1911	parsePtr->incomplete = 0;
	1912	parsePtr->errorType = TCL_PARSE_SUCCESS;
	1913	} while (TCL_OK !=
	1914	ParseTokens(p, parsePtr->end - p, 0, flags, parsePtr));
	1915
	1916	/*
	1917	* The good parse will have to be followed by {, (, or [.
	1918	*/
	1919
	1920	switch (*(parsePtr->term)) {
	1921	case '{':
	1922	/*
	1923	* Parse error was a missing } in a ${varname} variable
	1924	* substitution at the toplevel. We will subst everything up to
	1925	* that broken variable substitution before reporting the parse
	1926	* error. Substituting the leftover '$' will have no side-effects,
	1927	* so the current token stream is fine.
	1928	*/
	1929	break;
	1930
	1931	case '(':
	1932	/*
	1933	* Parse error was during the parsing of the index part of an
	1934	* array variable substitution at the toplevel.
	1935	*/
	1936
	1937	if (*(parsePtr->term - 1) == '$') {
	1938	/*
	1939	* Special case where removing the array index left us with
	1940	* just a dollar sign (array variable with name the empty
	1941	* string as its name), instead of with a scalar variable
	1942	* reference.
	1943	*
	1944	* As in the previous case, existing token stream is OK.
	1945	*/
	1946	} else {
	1947	/*
	1948	* The current parse includes a successful parse of a scalar
	1949	* variable substitution where there should have been an array
	1950	* variable substitution. We remove that mistaken part of the
	1951	* parse before moving on. A scalar variable substitution is
	1952	* two tokens.
	1953	*/
	1954
	1955	Tcl_Token *varTokenPtr =
	1956	parsePtr->tokenPtr + parsePtr->numTokens - 2;
	1957
	1958	if (varTokenPtr->type != TCL_TOKEN_VARIABLE) {
	1959	Tcl_Panic("Tcl_SubstObj: programming error");
	1960	}
	1961	if (varTokenPtr[1].type != TCL_TOKEN_TEXT) {
	1962	Tcl_Panic("Tcl_SubstObj: programming error");
	1963	}
	1964	parsePtr->numTokens -= 2;
	1965	}
	1966	break;
	1967	case '[':
	1968	/*
	1969	* Parse error occurred during parsing of a toplevel command
	1970	* substitution.
	1971	*/
	1972
	1973	parsePtr->end = p + length;
	1974	p = parsePtr->term + 1;
	1975	length = parsePtr->end - p;
	1976	if (length == 0) {
	1977	/*
	1978	* No commands, just an unmatched [. As in previous cases,
	1979	* existing token stream is OK.
	1980	*/
	1981	} else {
	1982	/*
	1983	* We want to add the parsing of as many commands as we can
	1984	* within that substitution until we reach the actual parse
	1985	* error. We'll do additional parsing to determine what length
	1986	* to claim for the final TCL_TOKEN_COMMAND token.
	1987	*/
	1988
	1989	Tcl_Token *tokenPtr;
	1990	const char *lastTerm = parsePtr->term;
	1991	Tcl_Parse nestedPtr = (Tcl_Parse )
	1992	TclStackAlloc(interp, sizeof(Tcl_Parse));
	1993
	1994	while (TCL_OK ==
	1995	Tcl_ParseCommand(NULL, p, length, 0, nestedPtr)) {
	1996	Tcl_FreeParse(nestedPtr);
	1997	p = nestedPtr->term + (nestedPtr->term < nestedPtr->end);
	1998	length = nestedPtr->end - p;
	1999	if ((length == 0) && (nestedPtr->term == nestedPtr->end)) {
	2000	/*
	2001	* If we run out of string, blame the missing close
	2002	* bracket on the last command, and do not evaluate it
	2003	* during substitution.
	2004	*/
	2005
	2006	break;
	2007	}
	2008	lastTerm = nestedPtr->term;
	2009	}
	2010	TclStackFree(interp, nestedPtr);
	2011
	2012	if (lastTerm == parsePtr->term) {
	2013	/*
	2014	* Parse error in first command. No commands to subst, add
	2015	* no more tokens.
	2016	*/
	2017	break;
	2018	}
	2019
	2020	/*
	2021	* Create a command substitution token for whatever commands
	2022	* got parsed.
	2023	*/
	2024
	2025	TclGrowParseTokenArray(parsePtr, 1);
	2026	tokenPtr = &(parsePtr->tokenPtr[parsePtr->numTokens]);
	2027	tokenPtr->start = parsePtr->term;
	2028	tokenPtr->numComponents = 0;
	2029	tokenPtr->type = TCL_TOKEN_COMMAND;
	2030	tokenPtr->size = lastTerm - tokenPtr->start + 1;
	2031	parsePtr->numTokens++;
	2032	}
	2033	break;
	2034
	2035	default:
	2036	Tcl_Panic("bad parse in Tcl_SubstObj: %c", p[length]);
	2037	}
	2038	}
	2039
	2040	/*
	2041	* Next, substitute the parsed tokens just as in normal Tcl evaluation.
	2042	*/
	2043
	2044	endTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
	2045	tokensLeft = parsePtr->numTokens;
	2046	code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
	2047	&tokensLeft, 1);
	2048	if (code == TCL_OK) {
	2049	Tcl_FreeParse(parsePtr);
	2050	TclStackFree(interp, parsePtr);
	2051	if (errMsg != NULL) {
	2052	Tcl_SetObjResult(interp, errMsg);
	2053	Tcl_DecrRefCount(errMsg);
	2054	return NULL;
	2055	}
	2056	return Tcl_GetObjResult(interp);
	2057	}
	2058
	2059	result = Tcl_NewObj();
	2060	while (1) {
	2061	switch (code) {
	2062	case TCL_ERROR:
	2063	Tcl_FreeParse(parsePtr);
	2064	TclStackFree(interp, parsePtr);
	2065	Tcl_DecrRefCount(result);
	2066	if (errMsg != NULL) {
	2067	Tcl_DecrRefCount(errMsg);
	2068	}
	2069	return NULL;
	2070	case TCL_BREAK:
	2071	tokensLeft = 0; /* Halt substitution */
	2072	default:
	2073	Tcl_AppendObjToObj(result, Tcl_GetObjResult(interp));
	2074	}
	2075
	2076	if (tokensLeft == 0) {
	2077	Tcl_FreeParse(parsePtr);
	2078	TclStackFree(interp, parsePtr);
	2079	if (errMsg != NULL) {
	2080	if (code != TCL_BREAK) {
	2081	Tcl_DecrRefCount(result);
	2082	Tcl_SetObjResult(interp, errMsg);
	2083	Tcl_DecrRefCount(errMsg);
	2084	return NULL;
	2085	}
	2086	Tcl_DecrRefCount(errMsg);
	2087	}
	2088	return result;
	2089	}
	2090
	2091	code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
	2092	&tokensLeft, 1);
	2093	}
	2094	}
	2095
	2096	/*
	2097	*----------------------------------------------------------------------
	2098	*
	2099	* TclSubstTokens --
	2100	*
	2101	* Accepts an array of count Tcl_Token's, and creates a result value in
	2102	* the interp from concatenating the results of performing Tcl
	2103	* substitution on each Tcl_Token. Substitution is interrupted if any
	2104	* non-TCL_OK completion code arises.
	2105	*
	2106	* Results:
	2107	* The return value is a standard Tcl completion code. The result in
	2108	* interp is the substituted value, or an error message if TCL_ERROR is
	2109	* returned. If tokensLeftPtr is not NULL, then it points to an int where
	2110	* the number of tokens remaining to be processed is written.
	2111	*
	2112	* Side effects:
	2113	* Can be anything, depending on the types of substitution done.
	2114	*
	2115	*----------------------------------------------------------------------
	2116	*/
	2117
	2118	int
	2119	TclSubstTokens(
	2120	Tcl_Interp interp, / Interpreter in which to lookup variables,
	2121	* execute nested commands, and report
	2122	* errors. */
	2123	Tcl_Token tokenPtr, / Pointer to first in an array of tokens to
	2124	* evaluate and concatenate. */
	2125	int count, /* Number of tokens to consider at tokenPtr.
	2126	* Must be at least 1. */
	2127	int tokensLeftPtr, / If not NULL, points to memory where an
	2128	* integer representing the number of tokens
	2129	* left to be substituted will be written */
	2130	int line) /* The line the script starts on. */
	2131	{
	2132	Tcl_Obj *result;
	2133	int code = TCL_OK;
	2134
	2135	/*
	2136	* Each pass through this loop will substitute one token, and its
	2137	* components, if any. The only thing tricky here is that we go to some
	2138	* effort to pass Tcl_Obj's through untouched, to avoid string copying and
	2139	* Tcl_Obj creation if possible, to aid performance and limit shimmering.
	2140	*
	2141	* Further optimization opportunities might be to check for the equivalent
	2142	* of Tcl_SetObjResult(interp, Tcl_GetObjResult(interp)) and omit them.
	2143	*/
	2144
	2145	result = NULL;
	2146	for (; count>0 && code==TCL_OK ; count--, tokenPtr++) {
	2147	Tcl_Obj *appendObj = NULL;
	2148	const char *append = NULL;
	2149	int appendByteLength = 0;
	2150	char utfCharBytes[TCL_UTF_MAX];
	2151
	2152	switch (tokenPtr->type) {
	2153	case TCL_TOKEN_TEXT:
	2154	append = tokenPtr->start;
	2155	appendByteLength = tokenPtr->size;
	2156	break;
	2157
	2158	case TCL_TOKEN_BS:
	2159	appendByteLength = Tcl_UtfBackslash(tokenPtr->start, NULL,
	2160	utfCharBytes);
	2161	append = utfCharBytes;
	2162	break;
	2163
	2164	case TCL_TOKEN_COMMAND: {
	2165	Interp iPtr = (Interp ) interp;
	2166
	2167	iPtr->numLevels++;
	2168	code = TclInterpReady(interp);
	2169	if (code == TCL_OK) {
	2170	/* TIP #280: Transfer line information to nested command */
	2171	code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
	2172	0, line);
	2173	}
	2174	iPtr->numLevels--;
	2175	appendObj = Tcl_GetObjResult(interp);
	2176	break;
	2177	}
	2178
	2179	case TCL_TOKEN_VARIABLE: {
	2180	Tcl_Obj *arrayIndex = NULL;
	2181	Tcl_Obj *varName = NULL;
	2182
	2183	if (tokenPtr->numComponents > 1) {
	2184	/*
	2185	* Subst the index part of an array variable reference.
	2186	*/
	2187
	2188	code = TclSubstTokens(interp, tokenPtr+2,
	2189	tokenPtr->numComponents - 1, NULL, line);
	2190	arrayIndex = Tcl_GetObjResult(interp);
	2191	Tcl_IncrRefCount(arrayIndex);
	2192	}
	2193
	2194	if (code == TCL_OK) {
	2195	varName = Tcl_NewStringObj(tokenPtr[1].start,
	2196	tokenPtr[1].size);
	2197	appendObj = Tcl_ObjGetVar2(interp, varName, arrayIndex,
	2198	TCL_LEAVE_ERR_MSG);
	2199	Tcl_DecrRefCount(varName);
	2200	if (appendObj == NULL) {
	2201	code = TCL_ERROR;
	2202	}
	2203	}
	2204
	2205	switch (code) {
	2206	case TCL_OK: /* Got value */
	2207	case TCL_ERROR: /* Already have error message */
	2208	case TCL_BREAK: /* Will not substitute anyway */
	2209	case TCL_CONTINUE: /* Will not substitute anyway */
	2210	break;
	2211	default:
	2212	/*
	2213	* All other return codes, we will subst the result from the
	2214	* code-throwing evaluation.
	2215	*/
	2216
	2217	appendObj = Tcl_GetObjResult(interp);
	2218	}
	2219
	2220	if (arrayIndex != NULL) {
	2221	Tcl_DecrRefCount(arrayIndex);
	2222	}
	2223	count -= tokenPtr->numComponents;
	2224	tokenPtr += tokenPtr->numComponents;
	2225	break;
	2226	}
	2227
	2228	default:
	2229	Tcl_Panic("unexpected token type in TclSubstTokens: %d",
	2230	tokenPtr->type);
	2231	}
	2232
	2233	if ((code == TCL_BREAK) \|\| (code == TCL_CONTINUE)) {
	2234	/*
	2235	* Inhibit substitution.
	2236	*/
	2237	continue;
	2238	}
	2239
	2240	if (result == NULL) {
	2241	/*
	2242	* First pass through. If we have a Tcl_Obj, just use it. If not,
	2243	* create one from our string.
	2244	*/
	2245
	2246	if (appendObj != NULL) {
	2247	result = appendObj;
	2248	} else {
	2249	result = Tcl_NewStringObj(append, appendByteLength);
	2250	}
	2251	Tcl_IncrRefCount(result);
	2252	} else {
	2253	/*
	2254	* Subsequent passes. Append to result.
	2255	*/
	2256
	2257	if (Tcl_IsShared(result)) {
	2258	Tcl_DecrRefCount(result);
	2259	result = Tcl_DuplicateObj(result);
	2260	Tcl_IncrRefCount(result);
	2261	}
	2262	if (appendObj != NULL) {
	2263	Tcl_AppendObjToObj(result, appendObj);
	2264	} else {
	2265	Tcl_AppendToObj(result, append, appendByteLength);
	2266	}
	2267	}
	2268	}
	2269
	2270	if (code != TCL_ERROR) { /* Keep error message in result! */
	2271	if (result != NULL) {
	2272	Tcl_SetObjResult(interp, result);
	2273	} else {
	2274	Tcl_ResetResult(interp);
	2275	}
	2276	}
	2277	if (tokensLeftPtr != NULL) {
	2278	*tokensLeftPtr = count;
	2279	}
	2280	if (result != NULL) {
	2281	Tcl_DecrRefCount(result);
	2282	}
	2283	return code;
	2284	}
	2285
	2286	/*
	2287	*----------------------------------------------------------------------
	2288	*
	2289	* CommandComplete --
	2290	*
	2291	* This function is shared by TclCommandComplete and
	2292	* Tcl_ObjCommandComplete; it does all the real work of seeing whether a
	2293	* script is complete
	2294	*
	2295	* Results:
	2296	* 1 is returned if the script is complete, 0 if there are open
	2297	* delimiters such as " or (. 1 is also returned if there is a parse
	2298	* error in the script other than unmatched delimiters.
	2299	*
	2300	* Side effects:
	2301	* None.
	2302	*
	2303	*----------------------------------------------------------------------
	2304	*/
	2305
	2306	static inline int
	2307	CommandComplete(
	2308	const char script, / Script to check. */
	2309	int numBytes) /* Number of bytes in script. */
	2310	{
	2311	Tcl_Parse parse;
	2312	const char p, end;
	2313	int result;
	2314
	2315	p = script;
	2316	end = p + numBytes;
	2317	while (Tcl_ParseCommand(NULL, p, end - p, 0, &parse) == TCL_OK) {
	2318	p = parse.commandStart + parse.commandSize;
	2319	if (p >= end) {
	2320	break;
	2321	}
	2322	Tcl_FreeParse(&parse);
	2323	}
	2324	if (parse.incomplete) {
	2325	result = 0;
	2326	} else {
	2327	result = 1;
	2328	}
	2329	Tcl_FreeParse(&parse);
	2330	return result;
	2331	}
	2332
	2333	/*
	2334	*----------------------------------------------------------------------
	2335	*
	2336	* Tcl_CommandComplete --
	2337	*
	2338	* Given a partial or complete Tcl script, this function determines
	2339	* whether the script is complete in the sense of having matched braces
	2340	* and quotes and brackets.
	2341	*
	2342	* Results:
	2343	* 1 is returned if the script is complete, 0 otherwise. 1 is also
	2344	* returned if there is a parse error in the script other than unmatched
	2345	* delimiters.
	2346	*
	2347	* Side effects:
	2348	* None.
	2349	*
	2350	*----------------------------------------------------------------------
	2351	*/
	2352
	2353	int
	2354	Tcl_CommandComplete(
	2355	const char script) / Script to check. */
	2356	{
	2357	return CommandComplete(script, (int) strlen(script));
	2358	}
	2359
	2360	/*
	2361	*----------------------------------------------------------------------
	2362	*
	2363	* TclObjCommandComplete --
	2364	*
	2365	* Given a partial or complete Tcl command in a Tcl object, this function
	2366	* determines whether the command is complete in the sense of having
	2367	* matched braces and quotes and brackets.
	2368	*
	2369	* Results:
	2370	* 1 is returned if the command is complete, 0 otherwise.
	2371	*
	2372	* Side effects:
	2373	* None.
	2374	*
	2375	*----------------------------------------------------------------------
	2376	*/
	2377
	2378	int
	2379	TclObjCommandComplete(
	2380	Tcl_Obj objPtr) / Points to object holding script to
	2381	* check. */
	2382	{
	2383	int length;
	2384	const char *script = Tcl_GetStringFromObj(objPtr, &length);
	2385
	2386	return CommandComplete(script, length);
	2387	}
	2388
	2389	/*
	2390	*----------------------------------------------------------------------
	2391	*
	2392	* TclIsLocalScalar --
	2393	*
	2394	* Check to see if a given string is a legal scalar variable name with no
	2395	* namespace qualifiers or substitutions.
	2396	*
	2397	* Results:
	2398	* Returns 1 if the variable is a local scalar.
	2399	*
	2400	* Side effects:
	2401	* None.
	2402	*
	2403	*----------------------------------------------------------------------
	2404	*/
	2405
	2406	int
	2407	TclIsLocalScalar(
	2408	const char *src,
	2409	int len)
	2410	{
	2411	const char *p;
	2412	const char *lastChar = src + (len - 1);
	2413
	2414	for (p=src ; p<=lastChar ; p++) {
	2415	if ((CHAR_TYPE(*p) != TYPE_NORMAL) &&
	2416	(CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
	2417	/*
	2418	* TCL_COMMAND_END is returned for the last character of the
	2419	* string. By this point we know it isn't an array or namespace
	2420	* reference.
	2421	*/
	2422
	2423	return 0;
	2424	}
	2425	if (*p == '(') {
	2426	if (lastChar == ')') { / We have an array element */
	2427	return 0;
	2428	}
	2429	} else if (*p == ':') {
	2430	if ((p != lastChar) && (p+1) == ':') { / qualified name */
	2431	return 0;
	2432	}
	2433	}
	2434	}
	2435
	2436	return 1;
	2437	}
	2438
	2439	/*
	2440	* Local Variables:
	2441	* mode: c
	2442	* c-basic-offset: 4
	2443	* fill-column: 78
	2444	* End:
	2445	*/

Note: See TracBrowser for help on using the repository browser.

Download in other formats: