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; }