bool
TclObject::getBool () const
{
int value;
Tcl_GetBooleanFromObj(0, m_pObj, &value);
return value != 0;
}
/*
** Test for access permissions. Return true if the requested permission
** is available, or false otherwise.
*/
static int tvfsAccess(
sqlite3_vfs *pVfs,
const char *zPath,
int flags,
int *pResOut
){
Testvfs *p = (Testvfs *)pVfs->pAppData;
if( p->pScript && p->mask&TESTVFS_ACCESS_MASK ){
int rc;
char *zArg = 0;
if( flags==SQLITE_ACCESS_EXISTS ) zArg = "SQLITE_ACCESS_EXISTS";
if( flags==SQLITE_ACCESS_READWRITE ) zArg = "SQLITE_ACCESS_READWRITE";
if( flags==SQLITE_ACCESS_READ ) zArg = "SQLITE_ACCESS_READ";
tvfsExecTcl(p, "xAccess",
Tcl_NewStringObj(zPath, -1), Tcl_NewStringObj(zArg, -1), 0, 0
);
if( tvfsResultCode(p, &rc) ){
if( rc!=SQLITE_OK ) return rc;
}else{
Tcl_Interp *interp = p->interp;
if( TCL_OK==Tcl_GetBooleanFromObj(0, Tcl_GetObjResult(interp), pResOut) ){
return SQLITE_OK;
}
}
}
return sqlite3OsAccess(PARENTVFS(pVfs), zPath, flags, pResOut);
}
static int itemShow( Tcl_Interp *interp, int objc, Tcl_Obj * const objv[],
CanvasParams *param, GPtrArray *items )
{
guint k;
int on = 1;
if( objc > 4 )
{
Tcl_WrongNumArgs( interp, 3, objv, "?on?" );
return TCL_ERROR;
}
if( objc == 4 )
{
if( Tcl_GetBooleanFromObj( interp, objv[3], &on ) != TCL_OK )
return TCL_ERROR;
}
if( items != NULL )
{
for( k = 0; k < items->len; ++k )
{
Gnocl_CanvasItemInfo *info = GET_INFO( items, k );
if( on )
gnome_canvas_item_show( info->item );
else
gnome_canvas_item_hide( info->item );
}
}
return TCL_OK;
}
void tclSendThread(Tcl_ThreadId thread, Tcl_Interp *interpreter, CONST char *script)
{
ThreadEvent *event;
Tcl_Channel errorChannel;
Tcl_Obj *object;
int boolean;
object = Tcl_GetVar2Ex(interpreter, "::tcl_platform", "threaded", 0);
if ((object == 0) || (Tcl_GetBooleanFromObj(interpreter, object, &boolean) != TCL_OK) || !boolean) {
errorChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errorChannel == NULL) return;
Tcl_WriteChars(
errorChannel, "error: Python thread requested script evaluation on Tcl core not compiled for multithreading.\n", -1
);
return;
}
event = (ThreadEvent *)Tcl_Alloc(sizeof(ThreadEvent));
event->event.proc = ThreadEventProc;
event->interpreter = interpreter;
event->script = strcpy(Tcl_Alloc(strlen(script) + 1), script);
Tcl_MutexLock(&threadMutex);
Tcl_ThreadQueueEvent(thread, (Tcl_Event *)event, TCL_QUEUE_TAIL);
Tcl_ThreadAlert(thread);
Tcl_MutexUnlock(&threadMutex);
}
int xEof(sqlite3_vtab_cursor *cursorP)
{
VTableInfo *vtabP = (VTableInfo *) cursorP->pVtab;
Tcl_Obj *curobjP;
Tcl_Obj *resultObj;
int ateof;
Tcl_Interp *interp;
if (vtabP->vtdbP == NULL || (interp = vtabP->vtdbP->vticP->interp) == NULL) {
/* Should not really happen */
SetVTableError(vtabP, gNullInterpError);
return 1; /* EOF */
}
curobjP = ObjFromPtr(cursorP, "sqlite3_vtab_cursor*");
if (VTableInvokeCmd(interp, vtabP, "xEof", 1, &curobjP) != TCL_OK) {
SetVTableErrorFromInterp(vtabP, interp);
return 1; /* eof */
}
resultObj = Tcl_GetObjResult(interp);
if (Tcl_GetBooleanFromObj(interp, resultObj, &ateof) == TCL_OK)
return ateof;
else
return 1; /* eof on error */
}
static int _get_value(Tcl_Interp *interp, jackctl_parameter_t *parameter, Tcl_Obj *value, union jackctl_parameter_value *result) {
switch (jackctl_parameter_get_type(parameter)) {
case JackParamInt: return Tcl_GetIntFromObj(interp, value, &result->i);
case JackParamUInt: return Tcl_GetIntFromObj(interp, value, &result->ui);
case JackParamChar: {
int length;
result->c = *Tcl_GetStringFromObj(value, &length);
if (length == 1)
return TCL_OK;
return fw_error_str(interp, "character parameter is not one character long");
}
case JackParamString: {
int length;
strncpy(result->str, Tcl_GetStringFromObj(value, &length), JACK_PARAM_STRING_MAX);
if (length <= JACK_PARAM_STRING_MAX)
return TCL_OK;
return fw_error_str(interp, "string parameter is too long");
}
case JackParamBool: {
int b;
if (Tcl_GetBooleanFromObj(interp, value, &b) != TCL_OK)
return TCL_ERROR;
result->b = b;
return TCL_OK;
}
}
return fw_error_obj(interp, Tcl_ObjPrintf("unknown type %d returned by jackctl_parameter_get_type", jackctl_parameter_get_type(parameter)));
}
static int
SetWinFileAttributes(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
char *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
DWORD fileAttributes = GetFileAttributes(fileName);
int yesNo;
int result;
if (fileAttributes == 0xFFFFFFFF) {
AttributesPosixError(interp, objIndex, fileName, 1);
return TCL_ERROR;
}
result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
if (result != TCL_OK) {
return result;
}
if (yesNo) {
fileAttributes |= (attributeArray[objIndex]);
} else {
fileAttributes &= ~(attributeArray[objIndex]);
}
if (!SetFileAttributes(fileName, fileAttributes)) {
AttributesPosixError(interp, objIndex, fileName, 1);
return TCL_ERROR;
}
return TCL_OK;
}
bool TclUtils::getBool(Tcl_Interp *interp, Tcl_Obj *objPtr) {
int ret;
if (TCL_OK != Tcl_GetBooleanFromObj(interp, objPtr, &ret))
throw wrong_args_value_exception(error_message::bad_int_argument);
return ret ? true : false;
}
static int
SetFileReadOnly(
Tcl_Interp *interp, /* The interp to report errors with. */
int objIndex, /* The index of the attribute. */
char *fileName, /* The name of the file. */
Tcl_Obj *readOnlyPtr) /* The command line object. */
{
OSErr err;
FSSpec fileSpec;
HParamBlockRec paramBlock;
int hidden;
err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
if (err == noErr) {
if (Tcl_GetBooleanFromObj(interp, readOnlyPtr, &hidden) != TCL_OK) {
return TCL_ERROR;
}
paramBlock.fileParam.ioCompletion = NULL;
paramBlock.fileParam.ioNamePtr = fileSpec.name;
paramBlock.fileParam.ioVRefNum = fileSpec.vRefNum;
paramBlock.fileParam.ioDirID = fileSpec.parID;
if (hidden) {
err = PBHSetFLock(¶mBlock, 0);
} else {
err = PBHRstFLock(¶mBlock, 0);
}
}
if (err == fnfErr) {
long dirID;
Boolean isDirectory = 0;
err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
if ((err == noErr) && isDirectory) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"cannot set a directory to read-only when File Sharing is turned off",
(char *) NULL);
return TCL_ERROR;
} else {
err = fnfErr;
}
}
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"couldn't set attributes for file \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
void ObjToSqliteContextValue(Tcl_Obj *objP, sqlite3_context *sqlctxP)
{
unsigned char *data;
int len;
if (objP->typePtr) {
/*
* Note there is no return code checking here. Once the typePtr
* is checked, the corresponding Tcl_Get* function should
* always succeed.
*/
if (objP->typePtr == gTclStringTypeP) {
/*
* Do nothing, fall thru below to handle as default type.
* This check is here just so the most common case of text
* columns does not needlessly go through other type checks.
*/
} else if (objP->typePtr == gTclIntTypeP) {
int ival;
Tcl_GetIntFromObj(NULL, objP, &ival);
sqlite3_result_int(sqlctxP, ival);
return;
} else if (objP->typePtr == gTclWideIntTypeP) {
Tcl_WideInt i64val;
Tcl_GetWideIntFromObj(NULL, objP, &i64val);
sqlite3_result_int64(sqlctxP, i64val);
return;
} else if (objP->typePtr == gTclDoubleTypeP) {
double dval;
Tcl_GetDoubleFromObj(NULL, objP, &dval);
sqlite3_result_double(sqlctxP, dval);
return;
} else if (objP->typePtr == gTclBooleanTypeP ||
objP->typePtr == gTclBooleanStringTypeP) {
int bval;
Tcl_GetBooleanFromObj(NULL, objP, &bval);
sqlite3_result_int(sqlctxP, bval);
return;
} else if (objP->typePtr == gTclByteArrayTypeP) {
/* TBD */
data = Tcl_GetByteArrayFromObj(objP, &len);
sqlite3_result_blob(sqlctxP, data, len, SQLITE_TRANSIENT);
return;
}
}
/* Handle everything else as text by default */
data = (unsigned char *)Tcl_GetStringFromObj(objP, &len);
sqlite3_result_text(sqlctxP, data, len, SQLITE_TRANSIENT);
}
static int
Python_Eval_Cmd(ClientData cdata, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[])
{
TCL_ARGS(4);
int rc;
int persist;
rc = Tcl_GetBooleanFromObj(interp, objv[1], &persist);
TCL_CHECK_MSG(rc, "first arg should be integer!");
char* code = Tcl_GetString(objv[2]);
char* expression = Tcl_GetString(objv[3]);
Tcl_Obj* result = NULL;
rc = python_eval(persist, code, expression, &result);
TCL_CHECK(rc);
Tcl_SetObjResult(interp, result);
return TCL_OK;
}
static int TextSetup(TextElement *text, Tk_Window tkwin)
{
const char *string = Tcl_GetString(text->textObj);
Tk_Justify justify = TK_JUSTIFY_LEFT;
int wrapLength = 0;
text->tkfont = Tk_GetFontFromObj(tkwin, text->fontObj);
Tk_GetJustifyFromObj(NULL, text->justifyObj, &justify);
Tk_GetPixelsFromObj(NULL, tkwin, text->wrapLengthObj, &wrapLength);
Tcl_GetBooleanFromObj(NULL, text->embossedObj, &text->embossed);
text->textLayout = Tk_ComputeTextLayout(
text->tkfont, string, -1/*numChars*/, wrapLength, justify,
0/*flags*/, &text->width, &text->height);
return 1;
}
static int
SetWinFileAttributes(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
CONST char *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
DWORD fileAttributes;
int yesNo;
int result;
Tcl_DString ds;
TCHAR *nativeName;
nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName);
if (fileAttributes == 0xffffffff) {
StatError(interp, fileName);
result = TCL_ERROR;
goto end;
}
result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
if (result != TCL_OK) {
goto end;
}
if (yesNo) {
fileAttributes |= (attributeArray[objIndex]);
} else {
fileAttributes &= ~(attributeArray[objIndex]);
}
if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) {
StatError(interp, fileName);
result = TCL_ERROR;
goto end;
}
end:
Tcl_DStringFree(&ds);
return result;
}
static int testConfigureSetFactory(
Tcl_Interp *interp,
lsm_db *db,
Tcl_Obj *pArg
){
lsm_compress_factory aFactory[2] = {
{ 0, 0, 0 },
{ 0, testCompressFactory, 0 },
};
int bArg = 0;
int rc;
rc = Tcl_GetBooleanFromObj(interp, pArg, &bArg);
if( rc!=TCL_OK ) return rc;
assert( bArg==1 || bArg==0 );
rc = lsm_config(db, LSM_CONFIG_SET_COMPRESSION_FACTORY, &aFactory[bArg]);
return rc;
}
static int check_sandboxing(Tcl_Interp *interp, char **sandbox_exec_path, char **profilestr)
{
Tcl_Obj *tcl_result;
int active;
int len;
tcl_result = Tcl_GetVar2Ex(interp, "portsandbox_active", NULL, TCL_GLOBAL_ONLY);
if (!tcl_result || Tcl_GetBooleanFromObj(interp, tcl_result, &active) != TCL_OK || !active) {
return 0;
}
tcl_result = Tcl_GetVar2Ex(interp, "portutil::autoconf::sandbox_exec_path", NULL, TCL_GLOBAL_ONLY);
if (!tcl_result || !(*sandbox_exec_path = Tcl_GetString(tcl_result))) {
return 0;
}
tcl_result = Tcl_GetVar2Ex(interp, "portsandbox_profile", NULL, TCL_GLOBAL_ONLY);
if (!tcl_result || !(*profilestr = Tcl_GetStringFromObj(tcl_result, &len))
|| len == 0) {
return 0;
}
return 1;
}
static void LabelframeStyleOptions(Labelframe *lf, LabelframeStyle *style)
{
Ttk_Layout layout = lf->core.layout;
Tcl_Obj *objPtr;
style->borderWidth = DEFAULT_BORDERWIDTH;
style->padding = Ttk_UniformPadding(0);
style->labelAnchor = TTK_PACK_TOP | TTK_STICK_W;
style->labelOutside = 0;
if ((objPtr = Ttk_QueryOption(layout, "-borderwidth", 0)) != NULL) {
Tk_GetPixelsFromObj(NULL, lf->core.tkwin, objPtr, &style->borderWidth);
}
if ((objPtr = Ttk_QueryOption(layout, "-padding", 0)) != NULL) {
Ttk_GetPaddingFromObj(NULL, lf->core.tkwin, objPtr, &style->padding);
}
if ((objPtr = Ttk_QueryOption(layout,"-labelanchor", 0)) != NULL) {
TtkGetLabelAnchorFromObj(NULL, objPtr, &style->labelAnchor);
}
if ((objPtr = Ttk_QueryOption(layout,"-labelmargins", 0)) != NULL) {
Ttk_GetBorderFromObj(NULL, objPtr, &style->labelMargins);
} else {
if (style->labelAnchor & (TTK_PACK_TOP|TTK_PACK_BOTTOM)) {
style->labelMargins =
Ttk_MakePadding(DEFAULT_LABELINSET,0,DEFAULT_LABELINSET,0);
} else {
style->labelMargins =
Ttk_MakePadding(0,DEFAULT_LABELINSET,0,DEFAULT_LABELINSET);
}
}
if ((objPtr = Ttk_QueryOption(layout,"-labeloutside", 0)) != NULL) {
Tcl_GetBooleanFromObj(NULL, objPtr, &style->labelOutside);
}
return;
}
void
TclObject::toVariant (VARIANT *pDest,
const Type &type,
Tcl_Interp *interp,
bool addRef)
{
VariantClear(pDest);
VARTYPE vt = type.vartype();
Reference *pReference = Extension::referenceHandles.find(interp, m_pObj);
if (pReference != 0) {
// Convert interface pointer handle to interface pointer.
if (addRef) {
// Must increment reference count of interface pointers returned
// from methods.
pReference->unknown()->AddRef();
}
IDispatch *pDispatch = pReference->dispatch();
if (pDispatch != 0) {
V_VT(pDest) = VT_DISPATCH;
V_DISPATCH(pDest) = pDispatch;
} else {
V_VT(pDest) = VT_UNKNOWN;
V_UNKNOWN(pDest) = pReference->unknown();
}
} else if (m_pObj->typePtr == &Extension::unknownPointerType) {
// Convert to interface pointer.
IUnknown *pUnknown = static_cast<IUnknown *>(
m_pObj->internalRep.otherValuePtr);
if (addRef && pUnknown != 0) {
// Must increment reference count of interface pointers returned
// from methods.
pUnknown->AddRef();
}
V_VT(pDest) = VT_UNKNOWN;
V_UNKNOWN(pDest) = pUnknown;
} else if (vt == VT_SAFEARRAY) {
const Type &elementType = type.elementType();
V_VT(pDest) = VT_ARRAY | elementType.vartype();
V_ARRAY(pDest) = getSafeArray(elementType, interp);
} else if (m_pObj->typePtr == TclTypes::listType()) {
// Convert Tcl list to array of VARIANT.
int numElements;
Tcl_Obj **pElements;
if (Tcl_ListObjGetElements(interp, m_pObj, &numElements, &pElements)
!= TCL_OK) {
_com_issue_error(E_INVALIDARG);
}
SAFEARRAYBOUND bounds[2];
bounds[0].cElements = numElements;
bounds[0].lLbound = 0;
unsigned numDimensions;
// Check if the first element of the list is a list.
if (numElements > 0 && pElements[0]->typePtr == TclTypes::listType()) {
int colSize;
Tcl_Obj **pCol;
if (Tcl_ListObjGetElements(interp, pElements[0], &colSize, &pCol)
!= TCL_OK) {
_com_issue_error(E_INVALIDARG);
}
bounds[1].cElements = colSize;
bounds[1].lLbound = 0;
numDimensions = 2;
} else {
numDimensions = 1;
}
SAFEARRAY *psa = SafeArrayCreate(VT_VARIANT, numDimensions, bounds);
std::vector<long> indices(numDimensions);
fillSafeArray(m_pObj, psa, 1, &indices[0], interp, addRef);
V_VT(pDest) = VT_ARRAY | VT_VARIANT;
V_ARRAY(pDest) = psa;
#if TCL_MINOR_VERSION >= 1
} else if (m_pObj->typePtr == TclTypes::byteArrayType()) {
// Convert Tcl byte array to SAFEARRAY of bytes.
V_VT(pDest) = VT_ARRAY | VT_UI1;
V_ARRAY(pDest) = newSafeArray(m_pObj, VT_UI1);
#endif
} else if (m_pObj->typePtr == &Extension::naType) {
// This variant indicates a missing optional argument.
VariantCopy(pDest, &vtMissing);
} else if (m_pObj->typePtr == &Extension::nullType) {
V_VT(pDest) = VT_NULL;
} else if (m_pObj->typePtr == &Extension::variantType) {
VariantCopy(
pDest,
static_cast<_variant_t *>(m_pObj->internalRep.otherValuePtr));
} else if (m_pObj->typePtr == TclTypes::intType()) {
long value;
if (Tcl_GetLongFromObj(interp, m_pObj, &value) != TCL_OK) {
value = 0;
}
V_VT(pDest) = VT_I4;
V_I4(pDest) = value;
if (vt != VT_VARIANT && vt != VT_USERDEFINED) {
VariantChangeType(pDest, pDest, 0, vt);
}
} else if (m_pObj->typePtr == TclTypes::doubleType()) {
double value;
if (Tcl_GetDoubleFromObj(interp, m_pObj, &value) != TCL_OK) {
value = 0.0;
}
V_VT(pDest) = VT_R8;
V_R8(pDest) = value;
if (vt != VT_VARIANT && vt != VT_USERDEFINED) {
VariantChangeType(pDest, pDest, 0, vt);
}
} else if (m_pObj->typePtr == TclTypes::booleanType()) {
int value;
if (Tcl_GetBooleanFromObj(interp, m_pObj, &value) != TCL_OK) {
value = 0;
}
V_VT(pDest) = VT_BOOL;
V_BOOL(pDest) = (value != 0) ? VARIANT_TRUE : VARIANT_FALSE;
if (vt != VT_VARIANT && vt != VT_USERDEFINED) {
VariantChangeType(pDest, pDest, 0, vt);
}
} else if (vt == VT_BOOL) {
V_VT(pDest) = VT_BOOL;
V_BOOL(pDest) = getBool() ? VARIANT_TRUE : VARIANT_FALSE;
} else {
V_VT(pDest) = VT_BSTR;
V_BSTR(pDest) = getBSTR();
// If trying to convert from a string to a date,
// we need to convert to a double (VT_R8) first.
if (vt == VT_DATE) {
VariantChangeType(pDest, pDest, 0, VT_R8);
}
// Try to convert from a string representation.
if (vt != VT_VARIANT && vt != VT_USERDEFINED && vt != VT_LPWSTR) {
VariantChangeType(pDest, pDest, 0, vt);
}
}
}
static int
SetFileFinderAttributes(
Tcl_Interp *interp, /* The interp to report errors with. */
int objIndex, /* The index of the attribute. */
char *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The command line object. */
{
OSErr err;
FSSpec fileSpec;
FInfo finfo;
err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
if (err == noErr) {
err = FSpGetFInfo(&fileSpec, &finfo);
}
if (err == noErr) {
switch (objIndex) {
case MAC_CREATOR_ATTRIBUTE:
if (Tcl_GetOSTypeFromObj(interp, attributePtr,
&finfo.fdCreator) != TCL_OK) {
return TCL_ERROR;
}
break;
case MAC_HIDDEN_ATTRIBUTE: {
int hidden;
if (Tcl_GetBooleanFromObj(interp, attributePtr, &hidden)
!= TCL_OK) {
return TCL_ERROR;
}
if (hidden) {
finfo.fdFlags |= kIsInvisible;
} else {
finfo.fdFlags &= ~kIsInvisible;
}
break;
}
case MAC_TYPE_ATTRIBUTE:
if (Tcl_GetOSTypeFromObj(interp, attributePtr,
&finfo.fdType) != TCL_OK) {
return TCL_ERROR;
}
break;
}
err = FSpSetFInfo(&fileSpec, &finfo);
} else if (err == fnfErr) {
long dirID;
Boolean isDirectory = 0;
err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
if ((err == noErr) && isDirectory) {
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
Tcl_AppendStringsToObj(resultPtr, "cannot set ",
tclpFileAttrStrings[objIndex], ": \"",
fileName, "\" is a directory", (char *) NULL);
return TCL_ERROR;
}
}
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"couldn't set attributes for file \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
static char *
LinkTraceProc(
ClientData clientData, /* Contains information about the link. */
Tcl_Interp *interp, /* Interpreter containing Tcl variable. */
CONST char *name1, /* First part of variable name. */
CONST char *name2, /* Second part of variable name. */
int flags) /* Miscellaneous additional information. */
{
Link *linkPtr = (Link *) clientData;
int changed, valueLength;
CONST char *value;
char **pp;
Tcl_Obj *valueObj;
int valueInt;
Tcl_WideInt valueWide;
double valueDouble;
/*
* If the variable is being unset, then just re-create it (with a trace)
* unless the whole interpreter is going away.
*/
if (flags & TCL_TRACE_UNSETS) {
if (Tcl_InterpDeleted(interp)) {
Tcl_DecrRefCount(linkPtr->varName);
ckfree((char *) linkPtr);
} else if (flags & TCL_TRACE_DESTROYED) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
|TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr);
}
return NULL;
}
/*
* If we were invoked because of a call to Tcl_UpdateLinkedVar, then don't
* do anything at all. In particular, we don't want to get upset that the
* variable is being modified, even if it is supposed to be read-only.
*/
if (linkPtr->flags & LINK_BEING_UPDATED) {
return NULL;
}
/*
* For read accesses, update the Tcl variable if the C variable has
* changed since the last time we updated the Tcl variable.
*/
if (flags & TCL_TRACE_READS) {
switch (linkPtr->type) {
case TCL_LINK_INT:
case TCL_LINK_BOOLEAN:
changed = (LinkedVar(int) != linkPtr->lastValue.i);
break;
case TCL_LINK_DOUBLE:
changed = (LinkedVar(double) != linkPtr->lastValue.d);
break;
case TCL_LINK_WIDE_INT:
changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w);
break;
case TCL_LINK_WIDE_UINT:
changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw);
break;
case TCL_LINK_CHAR:
changed = (LinkedVar(char) != linkPtr->lastValue.c);
break;
case TCL_LINK_UCHAR:
changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc);
break;
case TCL_LINK_SHORT:
changed = (LinkedVar(short) != linkPtr->lastValue.s);
break;
case TCL_LINK_USHORT:
changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us);
break;
case TCL_LINK_UINT:
changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
break;
case TCL_LINK_LONG:
changed = (LinkedVar(long) != linkPtr->lastValue.l);
break;
case TCL_LINK_ULONG:
changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
break;
case TCL_LINK_FLOAT:
changed = (LinkedVar(float) != linkPtr->lastValue.f);
break;
case TCL_LINK_STRING:
changed = 1;
break;
default:
return "internal error: bad linked variable type";
}
if (changed) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
}
return NULL;
}
/*
* For writes, first make sure that the variable is writable. Then convert
* the Tcl value to C if possible. If the variable isn't writable or can't
* be converted, then restore the varaible's old value and return an
* error. Another tricky thing: we have to save and restore the interp's
* result, since the variable access could occur when the result has been
* partially set.
*/
if (linkPtr->flags & LINK_READ_ONLY) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "linked variable is read-only";
}
valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
if (valueObj == NULL) {
/*
* This shouldn't ever happen.
*/
return "internal error: linked variable couldn't be read";
}
switch (linkPtr->type) {
case TCL_LINK_INT:
if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have integer value";
}
LinkedVar(int) = linkPtr->lastValue.i;
break;
case TCL_LINK_WIDE_INT:
if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have integer value";
}
LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
break;
case TCL_LINK_DOUBLE:
if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d)
!= TCL_OK) {
#ifdef ACCEPT_NAN
if (valueObj->typePtr != &tclDoubleType) {
#endif
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
return "variable must have real value";
#ifdef ACCEPT_NAN
}
linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
#endif
}
LinkedVar(double) = linkPtr->lastValue.d;
break;
case TCL_LINK_BOOLEAN:
if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have boolean value";
}
LinkedVar(int) = linkPtr->lastValue.i;
break;
case TCL_LINK_CHAR:
if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have char value";
}
linkPtr->lastValue.c = (char)valueInt;
LinkedVar(char) = linkPtr->lastValue.c;
break;
case TCL_LINK_UCHAR:
if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
|| valueInt < 0 || valueInt > UCHAR_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned char value";
}
linkPtr->lastValue.uc = (unsigned char) valueInt;
LinkedVar(unsigned char) = linkPtr->lastValue.uc;
break;
case TCL_LINK_SHORT:
if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have short value";
}
linkPtr->lastValue.s = (short)valueInt;
LinkedVar(short) = linkPtr->lastValue.s;
break;
case TCL_LINK_USHORT:
if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
|| valueInt < 0 || valueInt > USHRT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned short value";
}
linkPtr->lastValue.us = (unsigned short)valueInt;
LinkedVar(unsigned short) = linkPtr->lastValue.us;
break;
case TCL_LINK_UINT:
if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
|| valueWide < 0 || valueWide > UINT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned int value";
}
linkPtr->lastValue.ui = (unsigned int)valueWide;
LinkedVar(unsigned int) = linkPtr->lastValue.ui;
break;
case TCL_LINK_LONG:
if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have long value";
}
linkPtr->lastValue.l = (long)valueWide;
LinkedVar(long) = linkPtr->lastValue.l;
break;
case TCL_LINK_ULONG:
if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
|| valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned long value";
}
linkPtr->lastValue.ul = (unsigned long)valueWide;
LinkedVar(unsigned long) = linkPtr->lastValue.ul;
break;
case TCL_LINK_WIDE_UINT:
/*
* FIXME: represent as a bignum.
*/
if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned wide int value";
}
linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw;
break;
case TCL_LINK_FLOAT:
if (Tcl_GetDoubleFromObj(interp, valueObj, &valueDouble) != TCL_OK
|| valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have float value";
}
linkPtr->lastValue.f = (float)valueDouble;
LinkedVar(float) = linkPtr->lastValue.f;
break;
case TCL_LINK_STRING:
value = Tcl_GetStringFromObj(valueObj, &valueLength);
valueLength++;
pp = (char **) linkPtr->addr;
*pp = ckrealloc(*pp, valueLength);
memcpy(*pp, value, (unsigned) valueLength);
break;
default:
return "internal error: bad linked variable type";
}
return NULL;
}
/*-----------------------------------------------------------------------------
* ProcessSignalListEntry --
*
* Parse a keyed list entry used to describe a signal state and set the
* signal to that state. If the signal action is specified as "unknown",
* it is ignored.
*
* Parameters::
* o interp - Error messages are returned here.
* o signalName - Signal name.
* o stateObjPtr - Signal state information from keyed list.
* Returns:
* TCL_OK or TCL_ERROR;
*-----------------------------------------------------------------------------
*/
static int
ProcessSignalListEntry (Tcl_Interp *interp,
char *signalName,
Tcl_Obj *stateObjPtr)
{
Tcl_Obj **stateObjv;
int stateObjc;
char *actionStr, *cmdStr;
int signalNum, blocked;
signalProcPtr_t actionFunc = NULL;
int restart = FALSE;
unsigned char signals [MAXSIG];
/*
* Get state list.
*/
if (Tcl_ListObjGetElements (interp, stateObjPtr,
&stateObjc, &stateObjv) != TCL_OK)
return TCL_ERROR;
if (stateObjc < 2 || stateObjc > 4)
goto invalidEntry;
/*
* Parse the signal name and action.
*/
if (SigNameToNum (interp, signalName, &signalNum) != TCL_OK)
return TCL_ERROR;
actionStr = Tcl_GetStringFromObj (stateObjv [0], NULL);
cmdStr = NULL;
if (stateObjc > 2) {
cmdStr = Tcl_GetStringFromObj (stateObjv [2], NULL);
if (cmdStr[0] == '\0') {
cmdStr = NULL;
}
}
if (STREQU (actionStr, SIGACT_DEFAULT)) {
actionFunc = SIG_DFL;
if (cmdStr != NULL)
goto invalidEntry;
} else if (STREQU (actionStr, SIGACT_IGNORE)) {
actionFunc = SIG_IGN;
if (cmdStr != NULL)
goto invalidEntry;
} else if (STREQU (actionStr, SIGACT_ERROR)) {
actionFunc = SignalTrap;
if (cmdStr != NULL)
goto invalidEntry;
} else if (STREQU (actionStr, SIGACT_TRAP)) {
actionFunc = SignalTrap;
if (cmdStr == NULL) /* Must have command */
goto invalidEntry;
} else if (STREQU (actionStr, SIGACT_UNKNOWN)) {
if (cmdStr != NULL)
goto invalidEntry;
return TCL_OK; /* Ignore non-Tcl signals */
}
if (Tcl_GetBooleanFromObj (interp, stateObjv [1], &blocked) != TCL_OK)
return TCL_ERROR;
if (stateObjc > 3) {
if (Tcl_GetBooleanFromObj (interp, stateObjv [3], &restart) != TCL_OK)
return TCL_ERROR;
}
memset (signals, FALSE, sizeof (unsigned char) * MAXSIG);
signals [signalNum] = TRUE;
/*
* Set signal actions and handle blocking if its supported on this
* system. If the signal is to be blocked, we do it before setting up
* the handler. If its to be unblocked, we do it after.
*/
#ifndef NO_SIGACTION
if (blocked) {
if (BlockSignals (interp, SIG_BLOCK, signals) != TCL_OK)
return TCL_ERROR;
}
#endif
if (SetSignalActions (interp, signals, actionFunc, restart,
cmdStr) != TCL_OK)
return TCL_ERROR;
#ifndef NO_SIGACTION
if (!blocked) {
if (BlockSignals (interp, SIG_UNBLOCK, signals) != TCL_OK)
return TCL_ERROR;
}
#endif
return TCL_OK;
invalidEntry:
TclX_AppendObjResult (interp, "invalid signal keyed list entry for ",
signalName, (char *) NULL);
return TCL_ERROR;
}
int xBestIndex(sqlite3_vtab *sqltabP, sqlite3_index_info *infoP)
{
VTableInfo *vtabP = (VTableInfo *) sqltabP;
Tcl_Obj *objv[3];
Tcl_Interp *interp;
Tcl_Obj *constraints;
Tcl_Obj *order;
int i;
char *s;
Tcl_Obj **response;
int nobjs;
Tcl_Obj **usage;
int nusage;
if (vtabP->vtdbP == NULL || (interp = vtabP->vtdbP->vticP->interp) == NULL) {
/* Should not really happen */
SetVTableError(vtabP, gNullInterpError);
return SQLITE_ERROR;
}
constraints = Tcl_NewListObj(0, NULL);
for (i = 0; i < infoP->nConstraint; ++i) {
objv[0] = Tcl_NewIntObj(infoP->aConstraint[i].iColumn);
switch (infoP->aConstraint[i].op) {
case 2: s = "eq" ; break;
case 4: s = "gt" ; break;
case 8: s = "le" ; break;
case 16: s = "lt" ; break;
case 32: s = "ge" ; break;
case 64: s = "match"; break;
default:
SetVTableError(vtabP, "Unknown or unsupported constraint operator.");
return SQLITE_ERROR;
}
objv[1] = Tcl_NewStringObj(s, -1);
objv[2] = Tcl_NewBooleanObj(infoP->aConstraint[i].usable);
Tcl_ListObjAppendElement(interp, constraints, Tcl_NewListObj(3, objv));
}
order = Tcl_NewListObj(0, NULL);
for (i = 0; i < infoP->nOrderBy; ++i) {
objv[0] = Tcl_NewIntObj(infoP->aOrderBy[i].iColumn);
objv[1] = Tcl_NewBooleanObj(infoP->aOrderBy[i].desc);
Tcl_ListObjAppendElement(interp, order, Tcl_NewListObj(2, objv));
}
objv[0] = constraints;
objv[1] = order;
if (VTableInvokeCmd(interp, vtabP, "xBestIndex", 2, objv) != TCL_OK) {
SetVTableErrorFromInterp(vtabP, interp);
return SQLITE_ERROR;
}
/* Parse and return the response */
if (Tcl_ListObjGetElements(interp, Tcl_GetObjResult(interp),
&nobjs, &response) != TCL_OK)
goto bad_response;
if (nobjs == 0)
return SQLITE_OK;
if (nobjs != 5) {
/* If non-empty, list must have exactly five elements */
goto bad_response;
}
if (Tcl_ListObjGetElements(interp, response[0],
&nusage, &usage) != TCL_OK
|| nusage > infoP->nConstraint) {
/*
* Length of constraints used must not be greater than original
* number of constraints
* TBD - should it be exactly equal ?
*/
goto bad_response;
}
for (i = 0; i < nusage; ++i) {
Tcl_Obj **usage_constraint;
int nusage_constraint;
int argindex;
int omit;
if (Tcl_ListObjGetElements(interp, usage[i],
&nusage_constraint, &usage_constraint) != TCL_OK
|| nusage_constraint != 2
|| Tcl_GetIntFromObj(interp, usage_constraint[0], &argindex) != TCL_OK
|| Tcl_GetBooleanFromObj(interp, usage_constraint[1], &omit) != TCL_OK
) {
goto bad_response;
}
infoP->aConstraintUsage[i].argvIndex = argindex;
infoP->aConstraintUsage[i].omit = omit;
}
if (Tcl_GetIntFromObj(interp, response[1], &infoP->idxNum) != TCL_OK)
goto bad_response;
s = Tcl_GetStringFromObj(response[2], &i);
if (i) {
infoP->idxStr = sqlite3_mprintf("%s", s);
infoP->needToFreeIdxStr = 1;
}
if (Tcl_GetIntFromObj(interp, response[3], &infoP->orderByConsumed) != TCL_OK)
goto bad_response;
if (Tcl_GetDoubleFromObj(interp, response[4], &infoP->estimatedCost) != TCL_OK)
goto bad_response;
return SQLITE_OK;
bad_response:
SetVTableError(vtabP, "Malformed response from virtual table script.");
return SQLITE_ERROR;
}
Ttk_LayoutTemplate Ttk_ParseLayoutTemplate(Tcl_Interp *interp, Tcl_Obj *objPtr)
{
enum { OP_SIDE, OP_STICKY, OP_EXPAND, OP_BORDER, OP_UNIT, OP_CHILDREN };
static const char *optStrings[] = {
"-side", "-sticky", "-expand", "-border", "-unit", "-children", 0 };
int i = 0, objc;
Tcl_Obj **objv;
Ttk_TemplateNode *head = 0, *tail = 0;
if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK)
return 0;
while (i < objc) {
char *elementName = Tcl_GetString(objv[i]);
unsigned flags = 0x0, sticky = TTK_FILL_BOTH;
Tcl_Obj *childSpec = 0;
/*
* Parse options:
*/
++i;
while (i < objc) {
const char *optName = Tcl_GetString(objv[i]);
int option, value;
if (optName[0] != '-')
break;
if (Tcl_GetIndexFromObj(
interp, objv[i], optStrings, "option", 0, &option)
!= TCL_OK)
{
goto error;
}
if (++i >= objc) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp,
"Missing value for option ",Tcl_GetString(objv[i-1]),
NULL);
goto error;
}
switch (option) {
case OP_SIDE: /* <<NOTE-PACKSIDE>> */
if (Tcl_GetIndexFromObj(interp, objv[i], packSideStrings,
"side", 0, &value) != TCL_OK)
{
goto error;
}
flags |= (TTK_PACK_LEFT << value);
break;
case OP_STICKY:
if (Ttk_GetStickyFromObj(interp,objv[i],&sticky) != TCL_OK)
goto error;
break;
case OP_EXPAND:
if (Tcl_GetBooleanFromObj(interp,objv[i],&value) != TCL_OK)
goto error;
if (value)
flags |= TTK_EXPAND;
break;
case OP_BORDER:
if (Tcl_GetBooleanFromObj(interp,objv[i],&value) != TCL_OK)
goto error;
if (value)
flags |= TTK_BORDER;
break;
case OP_UNIT:
if (Tcl_GetBooleanFromObj(interp,objv[i],&value) != TCL_OK)
goto error;
if (value)
flags |= TTK_UNIT;
break;
case OP_CHILDREN:
childSpec = objv[i];
break;
}
++i;
}
/*
* Build new node:
*/
if (tail) {
tail->next = Ttk_NewTemplateNode(elementName, flags | sticky);
tail = tail->next;
} else {
head = tail = Ttk_NewTemplateNode(elementName, flags | sticky);
}
if (childSpec) {
tail->child = Ttk_ParseLayoutTemplate(interp, childSpec);
if (!tail->child) {
goto error;
}
}
}
return head;
error:
Ttk_FreeLayoutTemplate(head);
return 0;
}
static int
TestbooleanobjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int varIndex, boolValue;
const char *index, *subCmd;
if (objc < 3) {
wrongNumArgs:
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
}
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "set") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
if (Tcl_GetBooleanFromObj(interp, objv[3], &boolValue) != TCL_OK) {
return TCL_ERROR;
}
/*
* If the object currently bound to the variable with index varIndex
* has ref count 1 (i.e. the object is unshared) we can modify that
* object directly. Otherwise, if RC>1 (i.e. the object is shared),
* we must create a new object to modify/set and decrement the old
* formerly-shared object's ref count. This is "copy on write".
*/
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
} else {
SetVarToObj(varIndex, Tcl_NewBooleanObj(boolValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "get") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "not") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
&boolValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
} else {
SetVarToObj(varIndex, Tcl_NewBooleanObj(!boolValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"bad option \"", Tcl_GetString(objv[1]),
"\": must be set, get, or not", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
static int
TestindexobjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int allowAbbrev, index, index2, setError, i, result;
const char **argv;
static const char *const tablePtr[] = {"a", "b", "check", NULL};
/*
* Keep this structure declaration in sync with tclIndexObj.c
*/
struct IndexRep {
void *tablePtr; /* Pointer to the table of strings. */
int offset; /* Offset between table entries. */
int index; /* Selected index into table. */
};
struct IndexRep *indexRep;
if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
"check") == 0)) {
/*
* This code checks to be sure that the results of Tcl_GetIndexFromObj
* are properly cached in the object and returned on subsequent
* lookups.
*/
if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
return TCL_ERROR;
}
Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
indexRep = (struct IndexRep *) objv[1]->internalRep.otherValuePtr;
indexRep->index = index2;
result = Tcl_GetIndexFromObj(NULL, objv[1],
tablePtr, "token", 0, &index);
if (result == TCL_OK) {
Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
}
return result;
}
if (objc < 5) {
Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args", -1);
return TCL_ERROR;
}
if (Tcl_GetBooleanFromObj(interp, objv[1], &setError) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetBooleanFromObj(interp, objv[2], &allowAbbrev) != TCL_OK) {
return TCL_ERROR;
}
argv = (const char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
for (i = 4; i < objc; i++) {
argv[i-4] = Tcl_GetString(objv[i]);
}
argv[objc-4] = NULL;
/*
* Tcl_GetIndexFromObj assumes that the table is statically-allocated so
* that its address is different for each index object. If we accidently
* allocate a table at the same address as that cached in the index
* object, clear out the object's cached state.
*/
if (objv[3]->typePtr != NULL
&& !strcmp("index", objv[3]->typePtr->name)) {
indexRep = (struct IndexRep *) objv[3]->internalRep.otherValuePtr;
if (indexRep->tablePtr == (void *) argv) {
objv[3]->typePtr->freeIntRepProc(objv[3]);
objv[3]->typePtr = NULL;
}
}
result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index);
ckfree((char *) argv);
if (result == TCL_OK) {
Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
}
return result;
}
