tclparse.c

linux系统下的音频通信

	    p++;
	    while (*p == '\\') {
		(void) Tcl_Backslash(p, &count);
		p += count;
	    }
	    if (*p == '}') {
		braces--;
	    } else if (*p == '{') {
		braces++;
	    } else if (p == lastChar) {
		return p;
	    }
	}
	p++;
    }

    /*
     * Handle words that don't start with a brace or double-quote.
     * This code is also invoked if the word starts with a brace or
     * double-quote and there is garbage after the closing brace or
     * quote.  This is an error as far as Tcl_Eval is concerned, but
     * for here the garbage is treated as part of the word.
     */

    while (1) {
	if (*p == '[') {
	    p = ScriptEnd(p+1, lastChar, 1);
	    if (p == lastChar) {
		return p;
	    }
	    p++;
	} else if (*p == '\\') {
	    if (p[1] == '\n') {
		/*
		 * Backslash-newline:  it maps to a space character
		 * that is a word separator, so the word ends just before
		 * the backslash.
		 */

		return p-1;
	    }
	    (void) Tcl_Backslash(p, &count);
	    p += count;
	} else if (*p == '$') {
	    p = VarNameEnd(p, lastChar);
	    if (p == lastChar) {
		return p;
	    }
	    p++;
	} else if (*p == ';') {
	    /*
	     * Include the semi-colon in the word that is returned.
	     */

	    if (semiPtr != NULL) {
		*semiPtr = 1;
	    }
	    return p;
	} else if (isspace(UCHAR(*p))) {
	    return p-1;
	} else if ((*p == ']') && nested) {
	    return p-1;
	} else if (p == lastChar) {
	    if (nested) {
		/*
		 * Nested commands can't end because of the end of the
		 * string.
		 */
		return p;
	    }
	    return p-1;
	} else {
	    p++;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * QuoteEnd --
 *
 *	Given a pointer to a string that obeys the parsing conventions
 *	for quoted things in Tcl, find the end of that quoted thing.
 *	The actual thing may be a quoted argument or a parenthesized
 *	index name.
 *
 * Results:
 *	The return value is a pointer to the last character that is
 *	part of the quoted string (i.e the character that's equal to
 *	term).  If the quoted string doesn't terminate properly then
 *	the return value is a pointer to the null character at the
 *	end of the string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static char *
QuoteEnd(string, lastChar, term)
    char *string;		/* Pointer to character just after opening
				 * "quote". */
    char *lastChar;		/* Terminating character in string. */
    int term;			/* This character will terminate the
				 * quoted string (e.g. '"' or ')'). */
{
    register char *p = string;
    int count;

    while (*p != term) {
	if (*p == '\\') {
	    (void) Tcl_Backslash(p, &count);
	    p += count;
	} else if (*p == '[') {
	    for (p++; *p != ']'; p++) {
		p = TclWordEnd(p, lastChar, 1, (int *) NULL);
		if (*p == 0) {
		    return p;
		}
	    }
	    p++;
	} else if (*p == '$') {
	    p = VarNameEnd(p, lastChar);
	    if (*p == 0) {
		return p;
	    }
	    p++;
	} else if (p == lastChar) {
	    return p;
	} else {
	    p++;
	}
    }
    return p-1;
}

/*
 *----------------------------------------------------------------------
 *
 * VarNameEnd --
 *
 *	Given a pointer to a variable reference using $-notation, find
 *	the end of the variable name spec.
 *
 * Results:
 *	The return value is a pointer to the last character that
 *	is part of the variable name.  If the variable name doesn't
 *	terminate properly then the return value is a pointer to the
 *	null character at the end of the string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static char *
VarNameEnd(string, lastChar)
    char *string;		/* Pointer to dollar-sign character. */
    char *lastChar;		/* Terminating character in string. */
{
    register char *p = string+1;

    if (*p == '{') {
	for (p++; (*p != '}') && (p != lastChar); p++) {
	    /* Empty loop body. */
	}
	return p;
    }
    while (isalnum(UCHAR(*p)) || (*p == '_')) {
	p++;
    }
    if ((*p == '(') && (p != string+1)) {
	return QuoteEnd(p+1, lastChar, ')');
    }
    return p-1;
}


/*
 *----------------------------------------------------------------------
 *
 * ScriptEnd --
 *
 *	Given a pointer to the beginning of a Tcl script, find the end of
 *	the script.
 *
 * Results:
 *	The return value is a pointer to the last character that's part
 *	of the script pointed to by "p".  If the command doesn't end
 *	properly within the string then the return value is the address
 *	of the null character at the end of the string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static char *
ScriptEnd(p, lastChar, nested)
    char *p;			/* Script to check. */
    char *lastChar;		/* Terminating character in string. */
    int nested;			/* Zero means this is a top-level command.
				 * One means this is a nested command (the
				 * last character of the script must be
				 * an unquoted ]). */
{
    int commentOK = 1;
    int length;

    while (1) {
	while (isspace(UCHAR(*p))) {
	    if (*p == '\n') {
		commentOK = 1;
	    }
	    p++;
	}
	if ((*p == '#') && commentOK) {
	    do {
		if (*p == '\\') {
		    /*
		     * If the script ends with backslash-newline, then
		     * this command isn't complete.
		     */

		    if ((p[1] == '\n') && (p+2 == lastChar)) {
			return p+2;
		    }
		    Tcl_Backslash(p, &length);
		    p += length;
		} else {
		    p++;
		}
	    } while ((p != lastChar) && (*p != '\n'));
	    continue;
	}
	p = TclWordEnd(p, lastChar, nested, &commentOK);
	if (p == lastChar) {
	    return p;
	}
	p++;
	if (nested) {
	    if (*p == ']') {
		return p;
	    }
	} else {
	    if (p == lastChar) {
		return p-1;
	    }
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ParseVar --
 *
 *	Given a string starting with a $ sign, parse off a variable
 *	name and return its value.
 *
 * Results:
 *	The return value is the contents of the variable given by
 *	the leading characters of string.  If termPtr isn't NULL,
 *	*termPtr gets filled in with the address of the character
 *	just after the last one in the variable specifier.  If the
 *	variable doesn't exist, then the return value is NULL and
 *	an error message will be left in interp->result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_ParseVar(interp, string, termPtr)
    Tcl_Interp *interp;			/* Context for looking up variable. */
    register char *string;		/* String containing variable name.
					 * First character must be "$". */
    char **termPtr;			/* If non-NULL, points to word to fill
					 * in with character just after last
					 * one in the variable specifier. */

{
    char *name1, *name1End, c, *result;
    register char *name2;
#define NUM_CHARS 200
    char copyStorage[NUM_CHARS];
    ParseValue pv;

    /*
     * There are three cases:
     * 1. The $ sign is followed by an open curly brace.  Then the variable
     *    name is everything up to the next close curly brace, and the
     *    variable is a scalar variable.
     * 2. The $ sign is not followed by an open curly brace.  Then the
     *    variable name is everything up to the next character that isn't
     *    a letter, digit, or underscore, or a "::" namespace separator.
     *    If the following character is an open parenthesis, then the
     *    information between parentheses is the array element name, which
     *    can include any of the substitutions permissible between quotes.
     * 3. The $ sign is followed by something that isn't a letter, digit,
     *    underscore, or a "::" namespace separator: in this case,
     *    there is no variable name, and "$" is returned.
     */

    name2 = NULL;
    string++;
    if (*string == '{') {
	string++;
	name1 = string;
	while (*string != '}') {
	    if (*string == 0) {
		Tcl_SetResult(interp, "missing close-brace for variable name",
			TCL_STATIC);
		if (termPtr != 0) {
		    *termPtr = string;
		}
		return NULL;
	    }
	    string++;
	}
	name1End = string;
	string++;
    } else {
	name1 = string;
	while (isalnum(UCHAR(*string)) || (*string == '_')
	        || (*string == ':')) {
	    if (*string == ':') {
		if (*(string+1) == ':') {
                    string += 2;  /* skip over the initial :: */
		    while (*string == ':') {
			string++; /* skip over a subsequent : */
		    }
		} else {
		    break;	  /* : by itself */
                }
	    } else {
		string++;
	    }
	}
	if (string == name1) {
	    if (termPtr != 0) {
		*termPtr = string;
	    }
	    return "$";
	}
	name1End = string;
	if (*string == '(') {
	    char *end;

	    /*
	     * Perform substitutions on the array element name, just as
	     * is done for quotes.
	     */

	    pv.buffer = pv.next = copyStorage;
	    pv.end = copyStorage + NUM_CHARS - 1;
	    pv.expandProc = TclExpandParseValue;
	    pv.clientData = (ClientData) NULL;
	    if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
		    != TCL_OK) {
		char msg[200];
		int length;

		length = string-name1;
		if (length > 100) {
		    length = 100;
		}
		sprintf(msg, "\n    (parsing index for array \"%.*s\")",
			length, name1);
		Tcl_AddErrorInfo(interp, msg);
		result = NULL;
		name2 = pv.buffer;
		if (termPtr != 0) {
		    *termPtr = end;
		}
		goto done;
	    }
	    Tcl_ResetResult(interp);
	    string = end;
	    name2 = pv.buffer;
	}
    }
    if (termPtr != 0) {
	*termPtr = string;
    }

    c = *name1End;
    *name1End = 0;
    result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
    *name1End = c;

    done:
    if ((name2 != NULL) && (pv.buffer != copyStorage)) {
	ckfree(pv.buffer);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CommandComplete --
 *
 *	Given a partial or complete Tcl command, this procedure
 *	determines whether the command is complete in the sense
 *	of having matched braces and quotes and brackets.
 *
 * Results:
 *	1 is returned if the command is complete, 0 otherwise.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_CommandComplete(cmd)
    char *cmd;			/* Command to check. */
{
    char *p;

    if (*cmd == 0) {
	return 1;
    }
    p = ScriptEnd(cmd, cmd+strlen(cmd), 0);
    return (*p != 0);
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjCommandComplete --
 *
 *	Given a partial or complete Tcl command in a Tcl object, this
 *	procedure determines whether the command is complete in the sense of
 *	having matched braces and quotes and brackets.
 *
 * Results:
 *	1 is returned if the command is complete, 0 otherwise.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclObjCommandComplete(cmdPtr)
    Tcl_Obj *cmdPtr;			/* Points to object holding command
					 * to check. */
{
    char *cmd, *p;
    int length;

    cmd = Tcl_GetStringFromObj(cmdPtr, &length);
    if (length == 0) {
	return 1;
    }
    p = ScriptEnd(cmd, cmd+length, /*nested*/ 0);
    return (*p != 0);
}