/*
|
/*
|
* tclParse.c --
|
* tclParse.c --
|
*
|
*
|
* This file contains a collection of procedures that are used
|
* This file contains a collection of procedures that are used
|
* to parse Tcl commands or parts of commands (like quoted
|
* to parse Tcl commands or parts of commands (like quoted
|
* strings or nested sub-commands).
|
* strings or nested sub-commands).
|
*
|
*
|
* Copyright (c) 1987-1993 The Regents of the University of California.
|
* Copyright (c) 1987-1993 The Regents of the University of California.
|
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
|
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
|
*
|
*
|
* See the file "license.terms" for information on usage and redistribution
|
* See the file "license.terms" for information on usage and redistribution
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
*
|
*
|
* RCS: @(#) $Id: tclParse.c,v 1.1.1.1 2002-01-16 10:25:28 markom Exp $
|
* RCS: @(#) $Id: tclParse.c,v 1.1.1.1 2002-01-16 10:25:28 markom Exp $
|
*/
|
*/
|
|
|
#include "tclInt.h"
|
#include "tclInt.h"
|
#include "tclPort.h"
|
#include "tclPort.h"
|
|
|
/*
|
/*
|
* Function prototypes for procedures local to this file:
|
* Function prototypes for procedures local to this file:
|
*/
|
*/
|
|
|
static char * QuoteEnd _ANSI_ARGS_((char *string, char *lastChar,
|
static char * QuoteEnd _ANSI_ARGS_((char *string, char *lastChar,
|
int term));
|
int term));
|
static char * ScriptEnd _ANSI_ARGS_((char *p, char *lastChar,
|
static char * ScriptEnd _ANSI_ARGS_((char *p, char *lastChar,
|
int nested));
|
int nested));
|
static char * VarNameEnd _ANSI_ARGS_((char *string, char *lastChar));
|
static char * VarNameEnd _ANSI_ARGS_((char *string, char *lastChar));
|
|
|
/*
|
/*
|
*--------------------------------------------------------------
|
*--------------------------------------------------------------
|
*
|
*
|
* TclParseQuotes --
|
* TclParseQuotes --
|
*
|
*
|
* This procedure parses a double-quoted string such as a
|
* This procedure parses a double-quoted string such as a
|
* quoted Tcl command argument or a quoted value in a Tcl
|
* quoted Tcl command argument or a quoted value in a Tcl
|
* expression. This procedure is also used to parse array
|
* expression. This procedure is also used to parse array
|
* element names within parentheses, or anything else that
|
* element names within parentheses, or anything else that
|
* needs all the substitutions that happen in quotes.
|
* needs all the substitutions that happen in quotes.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is a standard Tcl result, which is
|
* The return value is a standard Tcl result, which is
|
* TCL_OK unless there was an error while parsing the
|
* TCL_OK unless there was an error while parsing the
|
* quoted string. If an error occurs then interp->result
|
* quoted string. If an error occurs then interp->result
|
* contains a standard error message. *TermPtr is filled
|
* contains a standard error message. *TermPtr is filled
|
* in with the address of the character just after the
|
* in with the address of the character just after the
|
* last one successfully processed; this is usually the
|
* last one successfully processed; this is usually the
|
* character just after the matching close-quote. The
|
* character just after the matching close-quote. The
|
* fully-substituted contents of the quotes are stored in
|
* fully-substituted contents of the quotes are stored in
|
* standard fashion in *pvPtr, null-terminated with
|
* standard fashion in *pvPtr, null-terminated with
|
* pvPtr->next pointing to the terminating null character.
|
* pvPtr->next pointing to the terminating null character.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The buffer space in pvPtr may be enlarged by calling its
|
* The buffer space in pvPtr may be enlarged by calling its
|
* expandProc.
|
* expandProc.
|
*
|
*
|
*--------------------------------------------------------------
|
*--------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
|
TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
|
Tcl_Interp *interp; /* Interpreter to use for nested command
|
Tcl_Interp *interp; /* Interpreter to use for nested command
|
* evaluations and error messages. */
|
* evaluations and error messages. */
|
char *string; /* Character just after opening double-
|
char *string; /* Character just after opening double-
|
* quote. */
|
* quote. */
|
int termChar; /* Character that terminates "quoted" string
|
int termChar; /* Character that terminates "quoted" string
|
* (usually double-quote, but sometimes
|
* (usually double-quote, but sometimes
|
* right-paren or something else). */
|
* right-paren or something else). */
|
int flags; /* Flags to pass to nested Tcl_Eval calls. */
|
int flags; /* Flags to pass to nested Tcl_Eval calls. */
|
char **termPtr; /* Store address of terminating character
|
char **termPtr; /* Store address of terminating character
|
* here. */
|
* here. */
|
ParseValue *pvPtr; /* Information about where to place
|
ParseValue *pvPtr; /* Information about where to place
|
* fully-substituted result of parse. */
|
* fully-substituted result of parse. */
|
{
|
{
|
register char *src, *dst, c;
|
register char *src, *dst, c;
|
char *lastChar = string + strlen(string);
|
char *lastChar = string + strlen(string);
|
|
|
src = string;
|
src = string;
|
dst = pvPtr->next;
|
dst = pvPtr->next;
|
|
|
while (1) {
|
while (1) {
|
if (dst == pvPtr->end) {
|
if (dst == pvPtr->end) {
|
/*
|
/*
|
* Target buffer space is about to run out. Make more space.
|
* Target buffer space is about to run out. Make more space.
|
*/
|
*/
|
|
|
pvPtr->next = dst;
|
pvPtr->next = dst;
|
(*pvPtr->expandProc)(pvPtr, 1);
|
(*pvPtr->expandProc)(pvPtr, 1);
|
dst = pvPtr->next;
|
dst = pvPtr->next;
|
}
|
}
|
|
|
c = *src;
|
c = *src;
|
src++;
|
src++;
|
if (c == termChar) {
|
if (c == termChar) {
|
*dst = '\0';
|
*dst = '\0';
|
pvPtr->next = dst;
|
pvPtr->next = dst;
|
*termPtr = src;
|
*termPtr = src;
|
return TCL_OK;
|
return TCL_OK;
|
} else if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
|
} else if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
|
copy:
|
copy:
|
*dst = c;
|
*dst = c;
|
dst++;
|
dst++;
|
continue;
|
continue;
|
} else if (c == '$') {
|
} else if (c == '$') {
|
int length;
|
int length;
|
char *value;
|
char *value;
|
|
|
value = Tcl_ParseVar(interp, src-1, termPtr);
|
value = Tcl_ParseVar(interp, src-1, termPtr);
|
if (value == NULL) {
|
if (value == NULL) {
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
src = *termPtr;
|
src = *termPtr;
|
length = strlen(value);
|
length = strlen(value);
|
if ((pvPtr->end - dst) <= length) {
|
if ((pvPtr->end - dst) <= length) {
|
pvPtr->next = dst;
|
pvPtr->next = dst;
|
(*pvPtr->expandProc)(pvPtr, length);
|
(*pvPtr->expandProc)(pvPtr, length);
|
dst = pvPtr->next;
|
dst = pvPtr->next;
|
}
|
}
|
strcpy(dst, value);
|
strcpy(dst, value);
|
dst += length;
|
dst += length;
|
continue;
|
continue;
|
} else if (c == '[') {
|
} else if (c == '[') {
|
int result;
|
int result;
|
|
|
pvPtr->next = dst;
|
pvPtr->next = dst;
|
result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
|
result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
|
if (result != TCL_OK) {
|
if (result != TCL_OK) {
|
return result;
|
return result;
|
}
|
}
|
src = *termPtr;
|
src = *termPtr;
|
dst = pvPtr->next;
|
dst = pvPtr->next;
|
continue;
|
continue;
|
} else if (c == '\\') {
|
} else if (c == '\\') {
|
int numRead;
|
int numRead;
|
|
|
src--;
|
src--;
|
*dst = Tcl_Backslash(src, &numRead);
|
*dst = Tcl_Backslash(src, &numRead);
|
dst++;
|
dst++;
|
src += numRead;
|
src += numRead;
|
continue;
|
continue;
|
} else if (c == '\0') {
|
} else if (c == '\0') {
|
char buf[30];
|
char buf[30];
|
|
|
Tcl_ResetResult(interp);
|
Tcl_ResetResult(interp);
|
sprintf(buf, "missing %c", termChar);
|
sprintf(buf, "missing %c", termChar);
|
Tcl_SetResult(interp, buf, TCL_VOLATILE);
|
Tcl_SetResult(interp, buf, TCL_VOLATILE);
|
*termPtr = string-1;
|
*termPtr = string-1;
|
return TCL_ERROR;
|
return TCL_ERROR;
|
} else {
|
} else {
|
goto copy;
|
goto copy;
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
*--------------------------------------------------------------
|
*--------------------------------------------------------------
|
*
|
*
|
* TclParseNestedCmd --
|
* TclParseNestedCmd --
|
*
|
*
|
* This procedure parses a nested Tcl command between
|
* This procedure parses a nested Tcl command between
|
* brackets, returning the result of the command.
|
* brackets, returning the result of the command.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is a standard Tcl result, which is
|
* The return value is a standard Tcl result, which is
|
* TCL_OK unless there was an error while executing the
|
* TCL_OK unless there was an error while executing the
|
* nested command. If an error occurs then interp->result
|
* nested command. If an error occurs then interp->result
|
* contains a standard error message. *TermPtr is filled
|
* contains a standard error message. *TermPtr is filled
|
* in with the address of the character just after the
|
* in with the address of the character just after the
|
* last one processed; this is usually the character just
|
* last one processed; this is usually the character just
|
* after the matching close-bracket, or the null character
|
* after the matching close-bracket, or the null character
|
* at the end of the string if the close-bracket was missing
|
* at the end of the string if the close-bracket was missing
|
* (a missing close bracket is an error). The result returned
|
* (a missing close bracket is an error). The result returned
|
* by the command is stored in standard fashion in *pvPtr,
|
* by the command is stored in standard fashion in *pvPtr,
|
* null-terminated, with pvPtr->next pointing to the null
|
* null-terminated, with pvPtr->next pointing to the null
|
* character.
|
* character.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The storage space at *pvPtr may be expanded.
|
* The storage space at *pvPtr may be expanded.
|
*
|
*
|
*--------------------------------------------------------------
|
*--------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
|
TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
|
Tcl_Interp *interp; /* Interpreter to use for nested command
|
Tcl_Interp *interp; /* Interpreter to use for nested command
|
* evaluations and error messages. */
|
* evaluations and error messages. */
|
char *string; /* Character just after opening bracket. */
|
char *string; /* Character just after opening bracket. */
|
int flags; /* Flags to pass to nested Tcl_Eval. */
|
int flags; /* Flags to pass to nested Tcl_Eval. */
|
char **termPtr; /* Store address of terminating character
|
char **termPtr; /* Store address of terminating character
|
* here. */
|
* here. */
|
register ParseValue *pvPtr; /* Information about where to place
|
register ParseValue *pvPtr; /* Information about where to place
|
* result of command. */
|
* result of command. */
|
{
|
{
|
int result, length, shortfall;
|
int result, length, shortfall;
|
Interp *iPtr = (Interp *) interp;
|
Interp *iPtr = (Interp *) interp;
|
|
|
iPtr->evalFlags = flags | TCL_BRACKET_TERM;
|
iPtr->evalFlags = flags | TCL_BRACKET_TERM;
|
result = Tcl_Eval(interp, string);
|
result = Tcl_Eval(interp, string);
|
*termPtr = (string + iPtr->termOffset);
|
*termPtr = (string + iPtr->termOffset);
|
if (result != TCL_OK) {
|
if (result != TCL_OK) {
|
/*
|
/*
|
* The increment below results in slightly cleaner message in
|
* The increment below results in slightly cleaner message in
|
* the errorInfo variable (the close-bracket will appear).
|
* the errorInfo variable (the close-bracket will appear).
|
*/
|
*/
|
|
|
if (**termPtr == ']') {
|
if (**termPtr == ']') {
|
*termPtr += 1;
|
*termPtr += 1;
|
}
|
}
|
return result;
|
return result;
|
}
|
}
|
(*termPtr) += 1;
|
(*termPtr) += 1;
|
length = strlen(iPtr->result);
|
length = strlen(iPtr->result);
|
shortfall = length + 1 - (pvPtr->end - pvPtr->next);
|
shortfall = length + 1 - (pvPtr->end - pvPtr->next);
|
if (shortfall > 0) {
|
if (shortfall > 0) {
|
(*pvPtr->expandProc)(pvPtr, shortfall);
|
(*pvPtr->expandProc)(pvPtr, shortfall);
|
}
|
}
|
strcpy(pvPtr->next, iPtr->result);
|
strcpy(pvPtr->next, iPtr->result);
|
pvPtr->next += length;
|
pvPtr->next += length;
|
|
|
Tcl_FreeResult(interp);
|
Tcl_FreeResult(interp);
|
iPtr->result = iPtr->resultSpace;
|
iPtr->result = iPtr->resultSpace;
|
iPtr->resultSpace[0] = '\0';
|
iPtr->resultSpace[0] = '\0';
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
/*
|
/*
|
*--------------------------------------------------------------
|
*--------------------------------------------------------------
|
*
|
*
|
* TclParseBraces --
|
* TclParseBraces --
|
*
|
*
|
* This procedure scans the information between matching
|
* This procedure scans the information between matching
|
* curly braces.
|
* curly braces.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is a standard Tcl result, which is
|
* The return value is a standard Tcl result, which is
|
* TCL_OK unless there was an error while parsing string.
|
* TCL_OK unless there was an error while parsing string.
|
* If an error occurs then interp->result contains a
|
* If an error occurs then interp->result contains a
|
* standard error message. *TermPtr is filled
|
* standard error message. *TermPtr is filled
|
* in with the address of the character just after the
|
* in with the address of the character just after the
|
* last one successfully processed; this is usually the
|
* last one successfully processed; this is usually the
|
* character just after the matching close-brace. The
|
* character just after the matching close-brace. The
|
* information between curly braces is stored in standard
|
* information between curly braces is stored in standard
|
* fashion in *pvPtr, null-terminated with pvPtr->next
|
* fashion in *pvPtr, null-terminated with pvPtr->next
|
* pointing to the terminating null character.
|
* pointing to the terminating null character.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The storage space at *pvPtr may be expanded.
|
* The storage space at *pvPtr may be expanded.
|
*
|
*
|
*--------------------------------------------------------------
|
*--------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
TclParseBraces(interp, string, termPtr, pvPtr)
|
TclParseBraces(interp, string, termPtr, pvPtr)
|
Tcl_Interp *interp; /* Interpreter to use for nested command
|
Tcl_Interp *interp; /* Interpreter to use for nested command
|
* evaluations and error messages. */
|
* evaluations and error messages. */
|
char *string; /* Character just after opening bracket. */
|
char *string; /* Character just after opening bracket. */
|
char **termPtr; /* Store address of terminating character
|
char **termPtr; /* Store address of terminating character
|
* here. */
|
* here. */
|
register ParseValue *pvPtr; /* Information about where to place
|
register ParseValue *pvPtr; /* Information about where to place
|
* result of command. */
|
* result of command. */
|
{
|
{
|
int level;
|
int level;
|
register char *src, *dst, *end;
|
register char *src, *dst, *end;
|
register char c;
|
register char c;
|
char *lastChar = string + strlen(string);
|
char *lastChar = string + strlen(string);
|
|
|
src = string;
|
src = string;
|
dst = pvPtr->next;
|
dst = pvPtr->next;
|
end = pvPtr->end;
|
end = pvPtr->end;
|
level = 1;
|
level = 1;
|
|
|
/*
|
/*
|
* Copy the characters one at a time to the result area, stopping
|
* Copy the characters one at a time to the result area, stopping
|
* when the matching close-brace is found.
|
* when the matching close-brace is found.
|
*/
|
*/
|
|
|
while (1) {
|
while (1) {
|
c = *src;
|
c = *src;
|
src++;
|
src++;
|
if (dst == end) {
|
if (dst == end) {
|
pvPtr->next = dst;
|
pvPtr->next = dst;
|
(*pvPtr->expandProc)(pvPtr, 20);
|
(*pvPtr->expandProc)(pvPtr, 20);
|
dst = pvPtr->next;
|
dst = pvPtr->next;
|
end = pvPtr->end;
|
end = pvPtr->end;
|
}
|
}
|
*dst = c;
|
*dst = c;
|
dst++;
|
dst++;
|
if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
|
if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
|
continue;
|
continue;
|
} else if (c == '{') {
|
} else if (c == '{') {
|
level++;
|
level++;
|
} else if (c == '}') {
|
} else if (c == '}') {
|
level--;
|
level--;
|
if (level == 0) {
|
if (level == 0) {
|
dst--; /* Don't copy the last close brace. */
|
dst--; /* Don't copy the last close brace. */
|
break;
|
break;
|
}
|
}
|
} else if (c == '\\') {
|
} else if (c == '\\') {
|
int count;
|
int count;
|
|
|
/*
|
/*
|
* Must always squish out backslash-newlines, even when in
|
* Must always squish out backslash-newlines, even when in
|
* braces. This is needed so that this sequence can appear
|
* braces. This is needed so that this sequence can appear
|
* anywhere in a command, such as the middle of an expression.
|
* anywhere in a command, such as the middle of an expression.
|
*/
|
*/
|
|
|
if (*src == '\n') {
|
if (*src == '\n') {
|
dst[-1] = Tcl_Backslash(src-1, &count);
|
dst[-1] = Tcl_Backslash(src-1, &count);
|
src += count - 1;
|
src += count - 1;
|
} else {
|
} else {
|
(void) Tcl_Backslash(src-1, &count);
|
(void) Tcl_Backslash(src-1, &count);
|
while (count > 1) {
|
while (count > 1) {
|
if (dst == end) {
|
if (dst == end) {
|
pvPtr->next = dst;
|
pvPtr->next = dst;
|
(*pvPtr->expandProc)(pvPtr, 20);
|
(*pvPtr->expandProc)(pvPtr, 20);
|
dst = pvPtr->next;
|
dst = pvPtr->next;
|
end = pvPtr->end;
|
end = pvPtr->end;
|
}
|
}
|
*dst = *src;
|
*dst = *src;
|
dst++;
|
dst++;
|
src++;
|
src++;
|
count--;
|
count--;
|
}
|
}
|
}
|
}
|
} else if (c == '\0') {
|
} else if (c == '\0') {
|
Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
|
Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
|
*termPtr = string-1;
|
*termPtr = string-1;
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
}
|
}
|
|
|
*dst = '\0';
|
*dst = '\0';
|
pvPtr->next = dst;
|
pvPtr->next = dst;
|
*termPtr = src;
|
*termPtr = src;
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
/*
|
/*
|
*--------------------------------------------------------------
|
*--------------------------------------------------------------
|
*
|
*
|
* TclExpandParseValue --
|
* TclExpandParseValue --
|
*
|
*
|
* This procedure is commonly used as the value of the
|
* This procedure is commonly used as the value of the
|
* expandProc in a ParseValue. It uses malloc to allocate
|
* expandProc in a ParseValue. It uses malloc to allocate
|
* more space for the result of a parse.
|
* more space for the result of a parse.
|
*
|
*
|
* Results:
|
* Results:
|
* The buffer space in *pvPtr is reallocated to something
|
* The buffer space in *pvPtr is reallocated to something
|
* larger, and if pvPtr->clientData is non-zero the old
|
* larger, and if pvPtr->clientData is non-zero the old
|
* buffer is freed. Information is copied from the old
|
* buffer is freed. Information is copied from the old
|
* buffer to the new one.
|
* buffer to the new one.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*--------------------------------------------------------------
|
*--------------------------------------------------------------
|
*/
|
*/
|
|
|
void
|
void
|
TclExpandParseValue(pvPtr, needed)
|
TclExpandParseValue(pvPtr, needed)
|
register ParseValue *pvPtr; /* Information about buffer that
|
register ParseValue *pvPtr; /* Information about buffer that
|
* must be expanded. If the clientData
|
* must be expanded. If the clientData
|
* in the structure is non-zero, it
|
* in the structure is non-zero, it
|
* means that the current buffer is
|
* means that the current buffer is
|
* dynamically allocated. */
|
* dynamically allocated. */
|
int needed; /* Minimum amount of additional space
|
int needed; /* Minimum amount of additional space
|
* to allocate. */
|
* to allocate. */
|
{
|
{
|
int newSpace;
|
int newSpace;
|
char *new;
|
char *new;
|
|
|
/*
|
/*
|
* Either double the size of the buffer or add enough new space
|
* Either double the size of the buffer or add enough new space
|
* to meet the demand, whichever produces a larger new buffer.
|
* to meet the demand, whichever produces a larger new buffer.
|
*/
|
*/
|
|
|
newSpace = (pvPtr->end - pvPtr->buffer) + 1;
|
newSpace = (pvPtr->end - pvPtr->buffer) + 1;
|
if (newSpace < needed) {
|
if (newSpace < needed) {
|
newSpace += needed;
|
newSpace += needed;
|
} else {
|
} else {
|
newSpace += newSpace;
|
newSpace += newSpace;
|
}
|
}
|
new = (char *) ckalloc((unsigned) newSpace);
|
new = (char *) ckalloc((unsigned) newSpace);
|
|
|
/*
|
/*
|
* Copy from old buffer to new, free old buffer if needed, and
|
* Copy from old buffer to new, free old buffer if needed, and
|
* mark new buffer as malloc-ed.
|
* mark new buffer as malloc-ed.
|
*/
|
*/
|
|
|
memcpy((VOID *) new, (VOID *) pvPtr->buffer,
|
memcpy((VOID *) new, (VOID *) pvPtr->buffer,
|
(size_t) (pvPtr->next - pvPtr->buffer));
|
(size_t) (pvPtr->next - pvPtr->buffer));
|
pvPtr->next = new + (pvPtr->next - pvPtr->buffer);
|
pvPtr->next = new + (pvPtr->next - pvPtr->buffer);
|
if (pvPtr->clientData != 0) {
|
if (pvPtr->clientData != 0) {
|
ckfree(pvPtr->buffer);
|
ckfree(pvPtr->buffer);
|
}
|
}
|
pvPtr->buffer = new;
|
pvPtr->buffer = new;
|
pvPtr->end = new + newSpace - 1;
|
pvPtr->end = new + newSpace - 1;
|
pvPtr->clientData = (ClientData) 1;
|
pvPtr->clientData = (ClientData) 1;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* TclWordEnd --
|
* TclWordEnd --
|
*
|
*
|
* Given a pointer into a Tcl command, find the end of the next
|
* Given a pointer into a Tcl command, find the end of the next
|
* word of the command.
|
* word of the command.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is a pointer to the last character that's part
|
* The return value is a pointer to the last character that's part
|
* of the word pointed to by "start". If the word doesn't end
|
* of the word pointed to by "start". If the word doesn't end
|
* properly within the string then the return value is the address
|
* properly within the string then the return value is the address
|
* of the null character at the end of the string.
|
* of the null character at the end of the string.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
char *
|
char *
|
TclWordEnd(start, lastChar, nested, semiPtr)
|
TclWordEnd(start, lastChar, nested, semiPtr)
|
char *start; /* Beginning of a word of a Tcl command. */
|
char *start; /* Beginning of a word of a Tcl command. */
|
char *lastChar; /* Terminating character in string. */
|
char *lastChar; /* Terminating character in string. */
|
int nested; /* Zero means this is a top-level command.
|
int nested; /* Zero means this is a top-level command.
|
* One means this is a nested command (close
|
* One means this is a nested command (close
|
* bracket is a word terminator). */
|
* bracket is a word terminator). */
|
int *semiPtr; /* Set to 1 if word ends with a command-
|
int *semiPtr; /* Set to 1 if word ends with a command-
|
* terminating semi-colon, zero otherwise.
|
* terminating semi-colon, zero otherwise.
|
* If NULL then ignored. */
|
* If NULL then ignored. */
|
{
|
{
|
register char *p;
|
register char *p;
|
int count;
|
int count;
|
|
|
if (semiPtr != NULL) {
|
if (semiPtr != NULL) {
|
*semiPtr = 0;
|
*semiPtr = 0;
|
}
|
}
|
|
|
/*
|
/*
|
* Skip leading white space (backslash-newline must be treated like
|
* Skip leading white space (backslash-newline must be treated like
|
* white-space, except that it better not be the last thing in the
|
* white-space, except that it better not be the last thing in the
|
* command).
|
* command).
|
*/
|
*/
|
|
|
for (p = start; ; p++) {
|
for (p = start; ; p++) {
|
if (isspace(UCHAR(*p))) {
|
if (isspace(UCHAR(*p))) {
|
continue;
|
continue;
|
}
|
}
|
if ((p[0] == '\\') && (p[1] == '\n')) {
|
if ((p[0] == '\\') && (p[1] == '\n')) {
|
if (p+2 == lastChar) {
|
if (p+2 == lastChar) {
|
return p+2;
|
return p+2;
|
}
|
}
|
continue;
|
continue;
|
}
|
}
|
break;
|
break;
|
}
|
}
|
|
|
/*
|
/*
|
* Handle words beginning with a double-quote or a brace.
|
* Handle words beginning with a double-quote or a brace.
|
*/
|
*/
|
|
|
if (*p == '"') {
|
if (*p == '"') {
|
p = QuoteEnd(p+1, lastChar, '"');
|
p = QuoteEnd(p+1, lastChar, '"');
|
if (p == lastChar) {
|
if (p == lastChar) {
|
return p;
|
return p;
|
}
|
}
|
p++;
|
p++;
|
} else if (*p == '{') {
|
} else if (*p == '{') {
|
int braces = 1;
|
int braces = 1;
|
while (braces != 0) {
|
while (braces != 0) {
|
p++;
|
p++;
|
while (*p == '\\') {
|
while (*p == '\\') {
|
(void) Tcl_Backslash(p, &count);
|
(void) Tcl_Backslash(p, &count);
|
p += count;
|
p += count;
|
}
|
}
|
if (*p == '}') {
|
if (*p == '}') {
|
braces--;
|
braces--;
|
} else if (*p == '{') {
|
} else if (*p == '{') {
|
braces++;
|
braces++;
|
} else if (p == lastChar) {
|
} else if (p == lastChar) {
|
return p;
|
return p;
|
}
|
}
|
}
|
}
|
p++;
|
p++;
|
}
|
}
|
|
|
/*
|
/*
|
* Handle words that don't start with a brace or double-quote.
|
* 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
|
* This code is also invoked if the word starts with a brace or
|
* double-quote and there is garbage after the closing 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
|
* quote. This is an error as far as Tcl_Eval is concerned, but
|
* for here the garbage is treated as part of the word.
|
* for here the garbage is treated as part of the word.
|
*/
|
*/
|
|
|
while (1) {
|
while (1) {
|
if (*p == '[') {
|
if (*p == '[') {
|
p = ScriptEnd(p+1, lastChar, 1);
|
p = ScriptEnd(p+1, lastChar, 1);
|
if (p == lastChar) {
|
if (p == lastChar) {
|
return p;
|
return p;
|
}
|
}
|
p++;
|
p++;
|
} else if (*p == '\\') {
|
} else if (*p == '\\') {
|
if (p[1] == '\n') {
|
if (p[1] == '\n') {
|
/*
|
/*
|
* Backslash-newline: it maps to a space character
|
* Backslash-newline: it maps to a space character
|
* that is a word separator, so the word ends just before
|
* that is a word separator, so the word ends just before
|
* the backslash.
|
* the backslash.
|
*/
|
*/
|
|
|
return p-1;
|
return p-1;
|
}
|
}
|
(void) Tcl_Backslash(p, &count);
|
(void) Tcl_Backslash(p, &count);
|
p += count;
|
p += count;
|
} else if (*p == '$') {
|
} else if (*p == '$') {
|
p = VarNameEnd(p, lastChar);
|
p = VarNameEnd(p, lastChar);
|
if (p == lastChar) {
|
if (p == lastChar) {
|
return p;
|
return p;
|
}
|
}
|
p++;
|
p++;
|
} else if (*p == ';') {
|
} else if (*p == ';') {
|
/*
|
/*
|
* Include the semi-colon in the word that is returned.
|
* Include the semi-colon in the word that is returned.
|
*/
|
*/
|
|
|
if (semiPtr != NULL) {
|
if (semiPtr != NULL) {
|
*semiPtr = 1;
|
*semiPtr = 1;
|
}
|
}
|
return p;
|
return p;
|
} else if (isspace(UCHAR(*p))) {
|
} else if (isspace(UCHAR(*p))) {
|
return p-1;
|
return p-1;
|
} else if ((*p == ']') && nested) {
|
} else if ((*p == ']') && nested) {
|
return p-1;
|
return p-1;
|
} else if (p == lastChar) {
|
} else if (p == lastChar) {
|
if (nested) {
|
if (nested) {
|
/*
|
/*
|
* Nested commands can't end because of the end of the
|
* Nested commands can't end because of the end of the
|
* string.
|
* string.
|
*/
|
*/
|
return p;
|
return p;
|
}
|
}
|
return p-1;
|
return p-1;
|
} else {
|
} else {
|
p++;
|
p++;
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* QuoteEnd --
|
* QuoteEnd --
|
*
|
*
|
* Given a pointer to a string that obeys the parsing conventions
|
* Given a pointer to a string that obeys the parsing conventions
|
* for quoted things in Tcl, find the end of that quoted thing.
|
* for quoted things in Tcl, find the end of that quoted thing.
|
* The actual thing may be a quoted argument or a parenthesized
|
* The actual thing may be a quoted argument or a parenthesized
|
* index name.
|
* index name.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is a pointer to the last character that is
|
* 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
|
* part of the quoted string (i.e the character that's equal to
|
* term). If the quoted string doesn't terminate properly then
|
* term). If the quoted string doesn't terminate properly then
|
* the return value is a pointer to the null character at the
|
* the return value is a pointer to the null character at the
|
* end of the string.
|
* end of the string.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static char *
|
static char *
|
QuoteEnd(string, lastChar, term)
|
QuoteEnd(string, lastChar, term)
|
char *string; /* Pointer to character just after opening
|
char *string; /* Pointer to character just after opening
|
* "quote". */
|
* "quote". */
|
char *lastChar; /* Terminating character in string. */
|
char *lastChar; /* Terminating character in string. */
|
int term; /* This character will terminate the
|
int term; /* This character will terminate the
|
* quoted string (e.g. '"' or ')'). */
|
* quoted string (e.g. '"' or ')'). */
|
{
|
{
|
register char *p = string;
|
register char *p = string;
|
int count;
|
int count;
|
|
|
while (*p != term) {
|
while (*p != term) {
|
if (*p == '\\') {
|
if (*p == '\\') {
|
(void) Tcl_Backslash(p, &count);
|
(void) Tcl_Backslash(p, &count);
|
p += count;
|
p += count;
|
} else if (*p == '[') {
|
} else if (*p == '[') {
|
for (p++; *p != ']'; p++) {
|
for (p++; *p != ']'; p++) {
|
p = TclWordEnd(p, lastChar, 1, (int *) NULL);
|
p = TclWordEnd(p, lastChar, 1, (int *) NULL);
|
if (*p == 0) {
|
if (*p == 0) {
|
return p;
|
return p;
|
}
|
}
|
}
|
}
|
p++;
|
p++;
|
} else if (*p == '$') {
|
} else if (*p == '$') {
|
p = VarNameEnd(p, lastChar);
|
p = VarNameEnd(p, lastChar);
|
if (*p == 0) {
|
if (*p == 0) {
|
return p;
|
return p;
|
}
|
}
|
p++;
|
p++;
|
} else if (p == lastChar) {
|
} else if (p == lastChar) {
|
return p;
|
return p;
|
} else {
|
} else {
|
p++;
|
p++;
|
}
|
}
|
}
|
}
|
return p-1;
|
return p-1;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* VarNameEnd --
|
* VarNameEnd --
|
*
|
*
|
* Given a pointer to a variable reference using $-notation, find
|
* Given a pointer to a variable reference using $-notation, find
|
* the end of the variable name spec.
|
* the end of the variable name spec.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is a pointer to the last character that
|
* The return value is a pointer to the last character that
|
* is part of the variable name. If the variable name doesn't
|
* is part of the variable name. If the variable name doesn't
|
* terminate properly then the return value is a pointer to the
|
* terminate properly then the return value is a pointer to the
|
* null character at the end of the string.
|
* null character at the end of the string.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static char *
|
static char *
|
VarNameEnd(string, lastChar)
|
VarNameEnd(string, lastChar)
|
char *string; /* Pointer to dollar-sign character. */
|
char *string; /* Pointer to dollar-sign character. */
|
char *lastChar; /* Terminating character in string. */
|
char *lastChar; /* Terminating character in string. */
|
{
|
{
|
register char *p = string+1;
|
register char *p = string+1;
|
|
|
if (*p == '{') {
|
if (*p == '{') {
|
for (p++; (*p != '}') && (p != lastChar); p++) {
|
for (p++; (*p != '}') && (p != lastChar); p++) {
|
/* Empty loop body. */
|
/* Empty loop body. */
|
}
|
}
|
return p;
|
return p;
|
}
|
}
|
while (isalnum(UCHAR(*p)) || (*p == '_')) {
|
while (isalnum(UCHAR(*p)) || (*p == '_')) {
|
p++;
|
p++;
|
}
|
}
|
if ((*p == '(') && (p != string+1)) {
|
if ((*p == '(') && (p != string+1)) {
|
return QuoteEnd(p+1, lastChar, ')');
|
return QuoteEnd(p+1, lastChar, ')');
|
}
|
}
|
return p-1;
|
return p-1;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* ScriptEnd --
|
* ScriptEnd --
|
*
|
*
|
* Given a pointer to the beginning of a Tcl script, find the end of
|
* Given a pointer to the beginning of a Tcl script, find the end of
|
* the script.
|
* the script.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is a pointer to the last character that's part
|
* 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
|
* of the script pointed to by "p". If the command doesn't end
|
* properly within the string then the return value is the address
|
* properly within the string then the return value is the address
|
* of the null character at the end of the string.
|
* of the null character at the end of the string.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static char *
|
static char *
|
ScriptEnd(p, lastChar, nested)
|
ScriptEnd(p, lastChar, nested)
|
char *p; /* Script to check. */
|
char *p; /* Script to check. */
|
char *lastChar; /* Terminating character in string. */
|
char *lastChar; /* Terminating character in string. */
|
int nested; /* Zero means this is a top-level command.
|
int nested; /* Zero means this is a top-level command.
|
* One means this is a nested command (the
|
* One means this is a nested command (the
|
* last character of the script must be
|
* last character of the script must be
|
* an unquoted ]). */
|
* an unquoted ]). */
|
{
|
{
|
int commentOK = 1;
|
int commentOK = 1;
|
int length;
|
int length;
|
|
|
while (1) {
|
while (1) {
|
while (isspace(UCHAR(*p))) {
|
while (isspace(UCHAR(*p))) {
|
if (*p == '\n') {
|
if (*p == '\n') {
|
commentOK = 1;
|
commentOK = 1;
|
}
|
}
|
p++;
|
p++;
|
}
|
}
|
if ((*p == '#') && commentOK) {
|
if ((*p == '#') && commentOK) {
|
do {
|
do {
|
if (*p == '\\') {
|
if (*p == '\\') {
|
/*
|
/*
|
* If the script ends with backslash-newline, then
|
* If the script ends with backslash-newline, then
|
* this command isn't complete.
|
* this command isn't complete.
|
*/
|
*/
|
|
|
if ((p[1] == '\n') && (p+2 == lastChar)) {
|
if ((p[1] == '\n') && (p+2 == lastChar)) {
|
return p+2;
|
return p+2;
|
}
|
}
|
Tcl_Backslash(p, &length);
|
Tcl_Backslash(p, &length);
|
p += length;
|
p += length;
|
} else {
|
} else {
|
p++;
|
p++;
|
}
|
}
|
} while ((p != lastChar) && (*p != '\n'));
|
} while ((p != lastChar) && (*p != '\n'));
|
continue;
|
continue;
|
}
|
}
|
p = TclWordEnd(p, lastChar, nested, &commentOK);
|
p = TclWordEnd(p, lastChar, nested, &commentOK);
|
if (p == lastChar) {
|
if (p == lastChar) {
|
return p;
|
return p;
|
}
|
}
|
p++;
|
p++;
|
if (nested) {
|
if (nested) {
|
if (*p == ']') {
|
if (*p == ']') {
|
return p;
|
return p;
|
}
|
}
|
} else {
|
} else {
|
if (p == lastChar) {
|
if (p == lastChar) {
|
return p-1;
|
return p-1;
|
}
|
}
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_ParseVar --
|
* Tcl_ParseVar --
|
*
|
*
|
* Given a string starting with a $ sign, parse off a variable
|
* Given a string starting with a $ sign, parse off a variable
|
* name and return its value.
|
* name and return its value.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is the contents of the variable given by
|
* The return value is the contents of the variable given by
|
* the leading characters of string. If termPtr isn't NULL,
|
* the leading characters of string. If termPtr isn't NULL,
|
* *termPtr gets filled in with the address of the character
|
* *termPtr gets filled in with the address of the character
|
* just after the last one in the variable specifier. If the
|
* just after the last one in the variable specifier. If the
|
* variable doesn't exist, then the return value is NULL and
|
* variable doesn't exist, then the return value is NULL and
|
* an error message will be left in interp->result.
|
* an error message will be left in interp->result.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
char *
|
char *
|
Tcl_ParseVar(interp, string, termPtr)
|
Tcl_ParseVar(interp, string, termPtr)
|
Tcl_Interp *interp; /* Context for looking up variable. */
|
Tcl_Interp *interp; /* Context for looking up variable. */
|
register char *string; /* String containing variable name.
|
register char *string; /* String containing variable name.
|
* First character must be "$". */
|
* First character must be "$". */
|
char **termPtr; /* If non-NULL, points to word to fill
|
char **termPtr; /* If non-NULL, points to word to fill
|
* in with character just after last
|
* in with character just after last
|
* one in the variable specifier. */
|
* one in the variable specifier. */
|
|
|
{
|
{
|
char *name1, *name1End, c, *result;
|
char *name1, *name1End, c, *result;
|
register char *name2;
|
register char *name2;
|
#define NUM_CHARS 200
|
#define NUM_CHARS 200
|
char copyStorage[NUM_CHARS];
|
char copyStorage[NUM_CHARS];
|
ParseValue pv;
|
ParseValue pv;
|
|
|
/*
|
/*
|
* There are three cases:
|
* There are three cases:
|
* 1. The $ sign is followed by an open curly brace. Then the variable
|
* 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
|
* name is everything up to the next close curly brace, and the
|
* variable is a scalar variable.
|
* variable is a scalar variable.
|
* 2. The $ sign is not followed by an open curly brace. Then the
|
* 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
|
* variable name is everything up to the next character that isn't
|
* a letter, digit, or underscore, or a "::" namespace separator.
|
* a letter, digit, or underscore, or a "::" namespace separator.
|
* If the following character is an open parenthesis, then the
|
* If the following character is an open parenthesis, then the
|
* information between parentheses is the array element name, which
|
* information between parentheses is the array element name, which
|
* can include any of the substitutions permissible between quotes.
|
* can include any of the substitutions permissible between quotes.
|
* 3. The $ sign is followed by something that isn't a letter, digit,
|
* 3. The $ sign is followed by something that isn't a letter, digit,
|
* underscore, or a "::" namespace separator: in this case,
|
* underscore, or a "::" namespace separator: in this case,
|
* there is no variable name, and "$" is returned.
|
* there is no variable name, and "$" is returned.
|
*/
|
*/
|
|
|
name2 = NULL;
|
name2 = NULL;
|
string++;
|
string++;
|
if (*string == '{') {
|
if (*string == '{') {
|
string++;
|
string++;
|
name1 = string;
|
name1 = string;
|
while (*string != '}') {
|
while (*string != '}') {
|
if (*string == 0) {
|
if (*string == 0) {
|
Tcl_SetResult(interp, "missing close-brace for variable name",
|
Tcl_SetResult(interp, "missing close-brace for variable name",
|
TCL_STATIC);
|
TCL_STATIC);
|
if (termPtr != 0) {
|
if (termPtr != 0) {
|
*termPtr = string;
|
*termPtr = string;
|
}
|
}
|
return NULL;
|
return NULL;
|
}
|
}
|
string++;
|
string++;
|
}
|
}
|
name1End = string;
|
name1End = string;
|
string++;
|
string++;
|
} else {
|
} else {
|
name1 = string;
|
name1 = string;
|
while (isalnum(UCHAR(*string)) || (*string == '_')
|
while (isalnum(UCHAR(*string)) || (*string == '_')
|
|| (*string == ':')) {
|
|| (*string == ':')) {
|
if (*string == ':') {
|
if (*string == ':') {
|
if (*(string+1) == ':') {
|
if (*(string+1) == ':') {
|
string += 2; /* skip over the initial :: */
|
string += 2; /* skip over the initial :: */
|
while (*string == ':') {
|
while (*string == ':') {
|
string++; /* skip over a subsequent : */
|
string++; /* skip over a subsequent : */
|
}
|
}
|
} else {
|
} else {
|
break; /* : by itself */
|
break; /* : by itself */
|
}
|
}
|
} else {
|
} else {
|
string++;
|
string++;
|
}
|
}
|
}
|
}
|
if (string == name1) {
|
if (string == name1) {
|
if (termPtr != 0) {
|
if (termPtr != 0) {
|
*termPtr = string;
|
*termPtr = string;
|
}
|
}
|
return "$";
|
return "$";
|
}
|
}
|
name1End = string;
|
name1End = string;
|
if (*string == '(') {
|
if (*string == '(') {
|
char *end;
|
char *end;
|
|
|
/*
|
/*
|
* Perform substitutions on the array element name, just as
|
* Perform substitutions on the array element name, just as
|
* is done for quotes.
|
* is done for quotes.
|
*/
|
*/
|
|
|
pv.buffer = pv.next = copyStorage;
|
pv.buffer = pv.next = copyStorage;
|
pv.end = copyStorage + NUM_CHARS - 1;
|
pv.end = copyStorage + NUM_CHARS - 1;
|
pv.expandProc = TclExpandParseValue;
|
pv.expandProc = TclExpandParseValue;
|
pv.clientData = (ClientData) NULL;
|
pv.clientData = (ClientData) NULL;
|
if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
|
if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
|
!= TCL_OK) {
|
!= TCL_OK) {
|
char msg[200];
|
char msg[200];
|
int length;
|
int length;
|
|
|
length = string-name1;
|
length = string-name1;
|
if (length > 100) {
|
if (length > 100) {
|
length = 100;
|
length = 100;
|
}
|
}
|
sprintf(msg, "\n (parsing index for array \"%.*s\")",
|
sprintf(msg, "\n (parsing index for array \"%.*s\")",
|
length, name1);
|
length, name1);
|
Tcl_AddErrorInfo(interp, msg);
|
Tcl_AddErrorInfo(interp, msg);
|
result = NULL;
|
result = NULL;
|
name2 = pv.buffer;
|
name2 = pv.buffer;
|
if (termPtr != 0) {
|
if (termPtr != 0) {
|
*termPtr = end;
|
*termPtr = end;
|
}
|
}
|
goto done;
|
goto done;
|
}
|
}
|
Tcl_ResetResult(interp);
|
Tcl_ResetResult(interp);
|
string = end;
|
string = end;
|
name2 = pv.buffer;
|
name2 = pv.buffer;
|
}
|
}
|
}
|
}
|
if (termPtr != 0) {
|
if (termPtr != 0) {
|
*termPtr = string;
|
*termPtr = string;
|
}
|
}
|
|
|
c = *name1End;
|
c = *name1End;
|
*name1End = 0;
|
*name1End = 0;
|
result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
|
result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
|
*name1End = c;
|
*name1End = c;
|
|
|
done:
|
done:
|
if ((name2 != NULL) && (pv.buffer != copyStorage)) {
|
if ((name2 != NULL) && (pv.buffer != copyStorage)) {
|
ckfree(pv.buffer);
|
ckfree(pv.buffer);
|
}
|
}
|
return result;
|
return result;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_CommandComplete --
|
* Tcl_CommandComplete --
|
*
|
*
|
* Given a partial or complete Tcl command, this procedure
|
* Given a partial or complete Tcl command, this procedure
|
* determines whether the command is complete in the sense
|
* determines whether the command is complete in the sense
|
* of having matched braces and quotes and brackets.
|
* of having matched braces and quotes and brackets.
|
*
|
*
|
* Results:
|
* Results:
|
* 1 is returned if the command is complete, 0 otherwise.
|
* 1 is returned if the command is complete, 0 otherwise.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
Tcl_CommandComplete(cmd)
|
Tcl_CommandComplete(cmd)
|
char *cmd; /* Command to check. */
|
char *cmd; /* Command to check. */
|
{
|
{
|
char *p;
|
char *p;
|
|
|
if (*cmd == 0) {
|
if (*cmd == 0) {
|
return 1;
|
return 1;
|
}
|
}
|
p = ScriptEnd(cmd, cmd+strlen(cmd), 0);
|
p = ScriptEnd(cmd, cmd+strlen(cmd), 0);
|
return (*p != 0);
|
return (*p != 0);
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* TclObjCommandComplete --
|
* TclObjCommandComplete --
|
*
|
*
|
* Given a partial or complete Tcl command in a Tcl object, this
|
* Given a partial or complete Tcl command in a Tcl object, this
|
* procedure determines whether the command is complete in the sense of
|
* procedure determines whether the command is complete in the sense of
|
* having matched braces and quotes and brackets.
|
* having matched braces and quotes and brackets.
|
*
|
*
|
* Results:
|
* Results:
|
* 1 is returned if the command is complete, 0 otherwise.
|
* 1 is returned if the command is complete, 0 otherwise.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
TclObjCommandComplete(cmdPtr)
|
TclObjCommandComplete(cmdPtr)
|
Tcl_Obj *cmdPtr; /* Points to object holding command
|
Tcl_Obj *cmdPtr; /* Points to object holding command
|
* to check. */
|
* to check. */
|
{
|
{
|
char *cmd, *p;
|
char *cmd, *p;
|
int length;
|
int length;
|
|
|
cmd = Tcl_GetStringFromObj(cmdPtr, &length);
|
cmd = Tcl_GetStringFromObj(cmdPtr, &length);
|
if (length == 0) {
|
if (length == 0) {
|
return 1;
|
return 1;
|
}
|
}
|
p = ScriptEnd(cmd, cmd+length, /*nested*/ 0);
|
p = ScriptEnd(cmd, cmd+length, /*nested*/ 0);
|
return (*p != 0);
|
return (*p != 0);
|
}
|
}
|
|
|
