diff options
Diffstat (limited to 'generic/tclIndexObj.c')
| -rw-r--r-- | generic/tclIndexObj.c | 535 |
1 files changed, 184 insertions, 351 deletions
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 944fb8e..cc50fd3 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -1,33 +1,36 @@ -/* +/* * tclIndexObj.c -- * - * This file implements objects of type "index". This object type is used - * to lookup a keyword in a table of valid values and cache the index of - * the matching entry. + * This file implements objects of type "index". This object type + * is used to lookup a keyword in a table of valid values and cache + * the index of the matching entry. * * Copyright (c) 1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" +#include "tclPort.h" /* - * Prototypes for functions defined later in this file: + * Prototypes for procedures defined later in this file: */ -static int SetIndexFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); -static void UpdateStringOfIndex(Tcl_Obj *objPtr); -static void DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr); -static void FreeIndex(Tcl_Obj *objPtr); +static int SetIndexFromAny _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); +static void UpdateStringOfIndex _ANSI_ARGS_((Tcl_Obj *objPtr)); +static void DupIndex _ANSI_ARGS_((Tcl_Obj *srcPtr, + Tcl_Obj *dupPtr)); +static void FreeIndex _ANSI_ARGS_((Tcl_Obj *objPtr)); /* - * The structure below defines the index Tcl object type by means of functions - * that can be invoked by generic object code. + * The structure below defines the index Tcl object type by means of + * procedures that can be invoked by generic object code. */ -static Tcl_ObjType indexType = { +Tcl_ObjType tclIndexType = { "index", /* name */ FreeIndex, /* freeIntRepProc */ DupIndex, /* dupIntRepProc */ @@ -36,15 +39,15 @@ static Tcl_ObjType indexType = { }; /* - * The definition of the internal representation of the "index" object; The - * internalRep.otherValuePtr field of an object of "index" type will be a - * pointer to one of these structures. + * The definition of the internal representation of the "index" + * object; The internalRep.otherValuePtr field of an object of "index" + * type will be a pointer to one of these structures. * * Keep this structure declaration in sync with tclTestObj.c */ typedef struct { - void *tablePtr; /* Pointer to the table of strings */ + VOID *tablePtr; /* Pointer to the table of strings */ int offset; /* Offset between table entries */ int index; /* Selected index into table. */ } IndexRep; @@ -52,68 +55,68 @@ typedef struct { /* * The following macros greatly simplify moving through a table... */ - #define STRING_AT(table, offset, index) \ - (*((const char *const *)(((char *)(table)) + ((offset) * (index))))) + (*((CONST char * CONST *)(((char *)(table)) + ((offset) * (index))))) #define NEXT_ENTRY(table, offset) \ (&(STRING_AT(table, offset, 1))) #define EXPAND_OF(indexRep) \ STRING_AT((indexRep)->tablePtr, (indexRep)->offset, (indexRep)->index) + /* *---------------------------------------------------------------------- * * Tcl_GetIndexFromObj -- * - * This function looks up an object's value in a table of strings and - * returns the index of the matching string, if any. + * This procedure looks up an object's value in a table of strings + * and returns the index of the matching string, if any. * * Results: - * If the value of objPtr is identical to or a unique abbreviation for - * one of the entries in objPtr, then the return value is TCL_OK and the - * index of the matching entry is stored at *indexPtr. If there isn't a - * proper match, then TCL_ERROR is returned and an error message is left - * in interp's result (unless interp is NULL). The msg argument is used - * in the error message; for example, if msg has the value "option" then - * the error message will say something flag 'bad option "foo": must be + * + * If the value of objPtr is identical to or a unique abbreviation + * for one of the entries in objPtr, then the return value is + * TCL_OK and the index of the matching entry is stored at + * *indexPtr. If there isn't a proper match, then TCL_ERROR is + * returned and an error message is left in interp's result (unless + * interp is NULL). The msg argument is used in the error + * message; for example, if msg has the value "option" then the + * error message will say something flag 'bad option "foo": must be * ...' * * Side effects: - * The result of the lookup is cached as the internal rep of objPtr, so - * that repeated lookups can be done quickly. + * The result of the lookup is cached as the internal rep of + * objPtr, so that repeated lookups can be done quickly. * *---------------------------------------------------------------------- */ int -Tcl_GetIndexFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* Object containing the string to lookup. */ - const char **tablePtr, /* Array of strings to compare against the +Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr; /* Object containing the string to lookup. */ + CONST char **tablePtr; /* Array of strings to compare against the * value of objPtr; last entry must be NULL * and there must not be duplicate entries. */ - const char *msg, /* Identifying word to use in error - * messages. */ - int flags, /* 0 or TCL_EXACT */ - int *indexPtr) /* Place to store resulting integer index. */ + CONST char *msg; /* Identifying word to use in error messages. */ + int flags; /* 0 or TCL_EXACT */ + int *indexPtr; /* Place to store resulting integer index. */ { /* - * See if there is a valid cached result from a previous lookup (doing the - * check here saves the overhead of calling Tcl_GetIndexFromObjStruct in - * the common case where the result is cached). + * See if there is a valid cached result from a previous lookup + * (doing the check here saves the overhead of calling + * Tcl_GetIndexFromObjStruct in the common case where the result + * is cached). */ - if (objPtr->typePtr == &indexType) { - IndexRep *indexRep = objPtr->internalRep.otherValuePtr; - + if (objPtr->typePtr == &tclIndexType) { + IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr; /* - * Here's hoping we don't get hit by unfortunate packing constraints - * on odd platforms like a Cray PVP... + * Here's hoping we don't get hit by unfortunate packing + * constraints on odd platforms like a Cray PVP... */ - - if (indexRep->tablePtr == (void *) tablePtr - && indexRep->offset == sizeof(char *)) { + if (indexRep->tablePtr == (VOID *)tablePtr && + indexRep->offset == sizeof(char *)) { *indexPtr = indexRep->index; return TCL_OK; } @@ -127,46 +130,49 @@ Tcl_GetIndexFromObj( * * Tcl_GetIndexFromObjStruct -- * - * This function looks up an object's value given a starting string and - * an offset for the amount of space between strings. This is useful when - * the strings are embedded in some other kind of array. + * This procedure looks up an object's value given a starting + * string and an offset for the amount of space between strings. + * This is useful when the strings are embedded in some other + * kind of array. * * Results: - * If the value of objPtr is identical to or a unique abbreviation for - * one of the entries in objPtr, then the return value is TCL_OK and the - * index of the matching entry is stored at *indexPtr. If there isn't a - * proper match, then TCL_ERROR is returned and an error message is left - * in interp's result (unless interp is NULL). The msg argument is used - * in the error message; for example, if msg has the value "option" then - * the error message will say something flag 'bad option "foo": must be + * + * If the value of objPtr is identical to or a unique abbreviation + * for one of the entries in objPtr, then the return value is + * TCL_OK and the index of the matching entry is stored at + * *indexPtr. If there isn't a proper match, then TCL_ERROR is + * returned and an error message is left in interp's result (unless + * interp is NULL). The msg argument is used in the error + * message; for example, if msg has the value "option" then the + * error message will say something flag 'bad option "foo": must be * ...' * * Side effects: - * The result of the lookup is cached as the internal rep of objPtr, so - * that repeated lookups can be done quickly. + * The result of the lookup is cached as the internal rep of + * objPtr, so that repeated lookups can be done quickly. * *---------------------------------------------------------------------- */ int -Tcl_GetIndexFromObjStruct( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* Object containing the string to lookup. */ - const void *tablePtr, /* The first string in the table. The second +Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, + indexPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr; /* Object containing the string to lookup. */ + CONST VOID *tablePtr; /* The first string in the table. The second * string will be at this address plus the * offset, the third plus the offset again, - * etc. The last entry must be NULL and there - * must not be duplicate entries. */ - int offset, /* The number of bytes between entries */ - const char *msg, /* Identifying word to use in error - * messages. */ - int flags, /* 0 or TCL_EXACT */ - int *indexPtr) /* Place to store resulting integer index. */ + * etc. The last entry must be NULL + * and there must not be duplicate entries. */ + int offset; /* The number of bytes between entries */ + CONST char *msg; /* Identifying word to use in error messages. */ + int flags; /* 0 or TCL_EXACT */ + int *indexPtr; /* Place to store resulting integer index. */ { - int index, idx, numAbbrev; + int index, i, numAbbrev; char *key, *p1; - const char *p2; - const char *const *entryPtr; + CONST char *p2; + CONST char * CONST *entryPtr; Tcl_Obj *resultPtr; IndexRep *indexRep; @@ -174,8 +180,8 @@ Tcl_GetIndexFromObjStruct( * See if there is a valid cached result from a previous lookup. */ - if (objPtr->typePtr == &indexType) { - indexRep = objPtr->internalRep.otherValuePtr; + if (objPtr->typePtr == &tclIndexType) { + indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr; if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) { *indexPtr = indexRep->index; return TCL_OK; @@ -183,7 +189,7 @@ Tcl_GetIndexFromObjStruct( } /* - * Lookup the value of the object in the table. Accept unique + * Lookup the value of the object in the table. Accept unique * abbreviations unless TCL_EXACT is set in flags. */ @@ -197,65 +203,63 @@ Tcl_GetIndexFromObjStruct( * - A single abbreviation (allowed depending on flags) * - Several abbreviations (never allowed, but overridden by exact match) */ - - for (entryPtr = tablePtr, idx = 0; *entryPtr != NULL; - entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) { + for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; + entryPtr = NEXT_ENTRY(entryPtr, offset), i++) { for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) { if (*p1 == '\0') { - index = idx; + index = i; goto done; } } if (*p1 == '\0') { /* - * The value is an abbreviation for this entry. Continue checking - * other entries to make sure it's unique. If we get more than one - * unique abbreviation, keep searching to see if there is an exact - * match, but remember the number of unique abbreviations and - * don't allow either. + * The value is an abbreviation for this entry. Continue + * checking other entries to make sure it's unique. If we + * get more than one unique abbreviation, keep searching to + * see if there is an exact match, but remember the number + * of unique abbreviations and don't allow either. */ numAbbrev++; - index = idx; + index = i; } } - /* - * Check if we were instructed to disallow abbreviations. + * Check if we were instructed to disallow abbreviations. */ - if ((flags & TCL_EXACT) || (key[0] == '\0') || (numAbbrev != 1)) { goto error; } - done: + done: /* - * Cache the found representation. Note that we want to avoid allocating a - * new internal-rep if at all possible since that is potentially a slow - * operation. + * Cache the found representation. Note that we want to avoid + * allocating a new internal-rep if at all possible since that is + * potentially a slow operation. */ - - if (objPtr->typePtr == &indexType) { - indexRep = objPtr->internalRep.otherValuePtr; + if (objPtr->typePtr == &tclIndexType) { + indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr; } else { - TclFreeIntRep(objPtr); + if ((objPtr->typePtr != NULL) + && (objPtr->typePtr->freeIntRepProc != NULL)) { + objPtr->typePtr->freeIntRepProc(objPtr); + } indexRep = (IndexRep *) ckalloc(sizeof(IndexRep)); - objPtr->internalRep.otherValuePtr = indexRep; - objPtr->typePtr = &indexType; + objPtr->internalRep.otherValuePtr = (VOID *) indexRep; + objPtr->typePtr = &tclIndexType; } - indexRep->tablePtr = (void *) tablePtr; + indexRep->tablePtr = (VOID*) tablePtr; indexRep->offset = offset; indexRep->index = index; *indexPtr = index; return TCL_OK; - error: + error: if (interp != NULL) { /* * Produce a fancy error message. */ - int count = 0; TclNewObj(resultPtr); @@ -265,20 +269,21 @@ Tcl_GetIndexFromObjStruct( entryPtr = NEXT_ENTRY(entryPtr, offset); } Tcl_AppendStringsToObj(resultPtr, (numAbbrev > 1) && - !(flags & TCL_EXACT) ? "ambiguous " : "bad ", msg, " \"", key, - "\": must be ", *entryPtr, NULL); + !(flags & TCL_EXACT) ? "ambiguous " : "bad ", msg, " \"", + key, "\": must be ", *entryPtr, (char*)NULL); entryPtr = NEXT_ENTRY(entryPtr, offset); while (*entryPtr != NULL) { if (*NEXT_ENTRY(entryPtr, offset) == NULL) { - Tcl_AppendStringsToObj(resultPtr, ((count > 0) ? "," : ""), - " or ", *entryPtr, NULL); + Tcl_AppendStringsToObj(resultPtr, + (count > 0) ? ", or " : " or ", *entryPtr, + (char *) NULL); } else if (**entryPtr) { - Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL); + Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, + (char *) NULL); count++; } entryPtr = NEXT_ENTRY(entryPtr, offset); } - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL); } return TCL_ERROR; } @@ -288,14 +293,14 @@ Tcl_GetIndexFromObjStruct( * * SetIndexFromAny -- * - * This function is called to convert a Tcl object to index internal - * form. However, this doesn't make sense (need to have a table of - * keywords in order to do the conversion) so the function always - * generates an error. + * This procedure is called to convert a Tcl object to index + * internal form. However, this doesn't make sense (need to have a + * table of keywords in order to do the conversion) so the + * procedure always generates an error. * * Results: - * The return value is always TCL_ERROR, and an error message is left in - * interp's result if interp isn't NULL. + * The return value is always TCL_ERROR, and an error message is + * left in interp's result if interp isn't NULL. * * Side effects: * None. @@ -304,14 +309,14 @@ Tcl_GetIndexFromObjStruct( */ static int -SetIndexFromAny( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ +SetIndexFromAny(interp, objPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + register Tcl_Obj *objPtr; /* The object to convert. */ { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_AppendToObj(Tcl_GetObjResult(interp), "can't convert value to index except via Tcl_GetIndexFromObj API", - -1)); + -1); } return TCL_ERROR; } @@ -321,8 +326,9 @@ SetIndexFromAny( * * UpdateStringOfIndex -- * - * This function is called to convert a Tcl object from index internal - * form to its string form. No abbreviation is ever generated. + * This procedure is called to convert a Tcl object from index + * internal form to its string form. No abbreviation is ever + * generated. * * Results: * None. @@ -334,13 +340,13 @@ SetIndexFromAny( */ static void -UpdateStringOfIndex( - Tcl_Obj *objPtr) +UpdateStringOfIndex(objPtr) + Tcl_Obj *objPtr; { - IndexRep *indexRep = objPtr->internalRep.otherValuePtr; + IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr; register char *buf; register unsigned len; - register const char *indexStr = EXPAND_OF(indexRep); + register CONST char *indexStr = EXPAND_OF(indexRep); len = strlen(indexStr); buf = (char *) ckalloc(len + 1); @@ -354,30 +360,29 @@ UpdateStringOfIndex( * * DupIndex -- * - * This function is called to copy the internal rep of an index Tcl - * object from to another object. + * This procedure is called to copy the internal rep of an index + * Tcl object from to another object. * * Results: * None. * * Side effects: - * The internal representation of the target object is updated and the - * type is set. + * The internal representation of the target object is updated + * and the type is set. * *---------------------------------------------------------------------- */ static void -DupIndex( - Tcl_Obj *srcPtr, - Tcl_Obj *dupPtr) +DupIndex(srcPtr, dupPtr) + Tcl_Obj *srcPtr, *dupPtr; { - IndexRep *srcIndexRep = srcPtr->internalRep.otherValuePtr; + IndexRep *srcIndexRep = (IndexRep *) srcPtr->internalRep.otherValuePtr; IndexRep *dupIndexRep = (IndexRep *) ckalloc(sizeof(IndexRep)); memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep)); - dupPtr->internalRep.otherValuePtr = dupIndexRep; - dupPtr->typePtr = &indexType; + dupPtr->internalRep.otherValuePtr = (VOID *) dupIndexRep; + dupPtr->typePtr = &tclIndexType; } /* @@ -385,8 +390,8 @@ DupIndex( * * FreeIndex -- * - * This function is called to delete the internal rep of an index Tcl - * object. + * This procedure is called to delete the internal rep of an index + * Tcl object. * * Results: * None. @@ -398,11 +403,10 @@ DupIndex( */ static void -FreeIndex( - Tcl_Obj *objPtr) +FreeIndex(objPtr) + Tcl_Obj *objPtr; { ckfree((char *) objPtr->internalRep.otherValuePtr); - objPtr->typePtr = NULL; } /* @@ -410,241 +414,70 @@ FreeIndex( * * Tcl_WrongNumArgs -- * - * This function generates a "wrong # args" error message in an - * interpreter. It is used as a utility function by many command - * functions, including the function that implements procedures. + * This procedure generates a "wrong # args" error message in an + * interpreter. It is used as a utility function by many command + * procedures. * * Results: * None. * * Side effects: - * An error message is generated in interp's result object to indicate - * that a command was invoked with the wrong number of arguments. The - * message has the form + * An error message is generated in interp's result object to + * indicate that a command was invoked with the wrong number of + * arguments. The message has the form * wrong # args: should be "foo bar additional stuff" - * where "foo" and "bar" are the initial objects in objv (objc determines - * how many of these are printed) and "additional stuff" is the contents - * of the message argument. - * - * The message printed is modified somewhat if the command is wrapped - * inside an ensemble. In that case, the error message generated is - * rewritten in such a way that it appears to be generated from the - * user-visible command and not how that command is actually implemented, - * giving a better overall user experience. - * - * Internally, the Tcl core may set the flag INTERP_ALTERNATE_WRONG_ARGS - * in the interpreter to generate complex multi-part messages by calling - * this function repeatedly. This allows the code that knows how to - * handle ensemble-related error messages to be kept here while still - * generating suitable error messages for commands like [read] and - * [socket]. Ideally, this would be done through an extra flags argument, - * but that wouldn't be source-compatible with the existing API and it's - * a fairly rare requirement anyway. + * where "foo" and "bar" are the initial objects in objv (objc + * determines how many of these are printed) and "additional stuff" + * is the contents of the message argument. * *---------------------------------------------------------------------- */ void -Tcl_WrongNumArgs( - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments to print from objv. */ - Tcl_Obj *const objv[], /* Initial argument objects, which should be - * included in the error message. */ - const char *message) /* Error message to print after the leading - * objects in objv. The message may be - * NULL. */ +Tcl_WrongNumArgs(interp, objc, objv, message) + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments to print + * from objv. */ + Tcl_Obj *CONST objv[]; /* Initial argument objects, which + * should be included in the error + * message. */ + CONST char *message; /* Error message to print after the + * leading objects in objv. The + * message may be NULL. */ { Tcl_Obj *objPtr; - int i, len, elemLen, flags; - Interp *iPtr = (Interp *) interp; - const char *elementStr; - - /* - * [incr Tcl] does something fairly horrific when generating error - * messages for its ensembles; it passes the whole set of ensemble - * arguments as a list in the first argument. This means that this code - * causes a problem in iTcl if it attempts to correctly quote all - * arguments, which would be the correct thing to do. We work around this - * nasty behaviour for now, and hope that we can remove it all in the - * future... - */ - -#ifndef AVOID_HACKS_FOR_ITCL - int isFirst = 1; /* Special flag used to inhibit the treating - * of the first word as a list element so the - * hacky way Itcl generates error messages for - * its ensembles will still work. [Bug - * 1066837] */ -# define MAY_QUOTE_WORD (!isFirst) -# define AFTER_FIRST_WORD (isFirst = 0) -#else /* !AVOID_HACKS_FOR_ITCL */ -# define MAY_QUOTE_WORD 1 -# define AFTER_FIRST_WORD (void) 0 -#endif /* AVOID_HACKS_FOR_ITCL */ + int i; + register IndexRep *indexRep; TclNewObj(objPtr); - if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) { - Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp)); - Tcl_AppendToObj(objPtr, " or \"", -1); - } else { - Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1); - } - - /* - * Check to see if we are processing an ensemble implementation, and if so - * rewrite the results in terms of how the ensemble was invoked. - */ - - if (iPtr->ensembleRewrite.sourceObjs != NULL) { - int toSkip = iPtr->ensembleRewrite.numInsertedObjs; - int toPrint = iPtr->ensembleRewrite.numRemovedObjs; - Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs; - - /* - * We only know how to do rewriting if all the replaced objects are - * actually arguments (in objv) to this function. Otherwise it just - * gets too complicated and we'd be better off just giving a slightly - * confusing error message... - */ - - if (objc < toSkip) { - goto addNormalArgumentsToMessage; - } - - /* - * Strip out the actual arguments that the ensemble inserted. - */ - - objv += toSkip; - objc -= toSkip; - - /* - * We assume no object is of index type. - */ - - for (i=0 ; i<toPrint ; i++) { - /* - * Add the element, quoting it if necessary. - */ - - if (origObjv[i]->typePtr == &indexType) { - register IndexRep *indexRep = - origObjv[i]->internalRep.otherValuePtr; - - elementStr = EXPAND_OF(indexRep); - elemLen = strlen(elementStr); - } else if (origObjv[i]->typePtr == &tclEnsembleCmdType) { - register EnsembleCmdRep *ecrPtr = - origObjv[i]->internalRep.otherValuePtr; - - elementStr = ecrPtr->fullSubcmdName; - elemLen = strlen(elementStr); - } else { - elementStr = TclGetStringFromObj(origObjv[i], &elemLen); - } - flags = 0; - len = TclScanElement(elementStr, elemLen, &flags); - - if (MAY_QUOTE_WORD && len != elemLen) { - char *quotedElementStr = TclStackAlloc(interp, - (unsigned)len + 1); - - len = TclConvertElement(elementStr, elemLen, - quotedElementStr, flags); - Tcl_AppendToObj(objPtr, quotedElementStr, len); - TclStackFree(interp, quotedElementStr); - } else { - Tcl_AppendToObj(objPtr, elementStr, elemLen); - } - - AFTER_FIRST_WORD; - - /* - * Add a space if the word is not the last one (which has a - * moderately complex condition here). - */ - - if (i<toPrint-1 || objc!=0 || message!=NULL) { - Tcl_AppendStringsToObj(objPtr, " ", NULL); - } - } - } - - /* - * Now add the arguments (other than those rewritten) that the caller took - * from its calling context. - */ - - addNormalArgumentsToMessage: + Tcl_SetObjResult(interp, objPtr); + Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1); for (i = 0; i < objc; i++) { /* - * If the object is an index type use the index table which allows for - * the correct error message even if the subcommand was abbreviated. - * Otherwise, just use the string rep. + * If the object is an index type use the index table which allows + * for the correct error message even if the subcommand was + * abbreviated. Otherwise, just use the string rep. */ - - if (objv[i]->typePtr == &indexType) { - register IndexRep *indexRep = objv[i]->internalRep.otherValuePtr; - - Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); - } else if (objv[i]->typePtr == &tclEnsembleCmdType) { - register EnsembleCmdRep *ecrPtr = - objv[i]->internalRep.otherValuePtr; - - Tcl_AppendStringsToObj(objPtr, ecrPtr->fullSubcmdName, NULL); + + if (objv[i]->typePtr == &tclIndexType) { + indexRep = (IndexRep *) objv[i]->internalRep.otherValuePtr; + Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), (char *) NULL); } else { - /* - * Quote the argument if it contains spaces (Bug 942757). - */ - - elementStr = TclGetStringFromObj(objv[i], &elemLen); - flags = 0; - len = TclScanElement(elementStr, elemLen, &flags); - - if (MAY_QUOTE_WORD && len != elemLen) { - char *quotedElementStr = TclStackAlloc(interp, - (unsigned) len + 1); - - len = TclConvertElement(elementStr, elemLen, - quotedElementStr, flags); - Tcl_AppendToObj(objPtr, quotedElementStr, len); - TclStackFree(interp, quotedElementStr); - } else { - Tcl_AppendToObj(objPtr, elementStr, elemLen); - } + Tcl_AppendStringsToObj(objPtr, Tcl_GetString(objv[i]), + (char *) NULL); } - AFTER_FIRST_WORD; - /* * Append a space character (" ") if there is more text to follow * (either another element from objv, or the message string). */ - - if (i<objc-1 || message!=NULL) { - Tcl_AppendStringsToObj(objPtr, " ", NULL); + if ((i < (objc - 1)) || message) { + Tcl_AppendStringsToObj(objPtr, " ", (char *) NULL); } } - /* - * Add any trailing message bits and set the resulting string as the - * interpreter result. Caller is responsible for reporting this as an - * actual error. - */ - - if (message != NULL) { - Tcl_AppendStringsToObj(objPtr, message, NULL); + if (message) { + Tcl_AppendStringsToObj(objPtr, message, (char *) NULL); } - Tcl_AppendStringsToObj(objPtr, "\"", NULL); - Tcl_SetObjResult(interp, objPtr); -#undef MAY_QUOTE_WORD -#undef AFTER_FIRST_WORD + Tcl_AppendStringsToObj(objPtr, "\"", (char *) NULL); } - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ |