static int GetFileFinderAttributes( Tcl_Interp *interp, /* The interp to report errors with. */ int objIndex, /* The index of the attribute option. */ char *fileName, /* The name of the file. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { 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: *attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdCreator); break; case MAC_HIDDEN_ATTRIBUTE: *attributePtrPtr = Tcl_NewBooleanObj(finfo.fdFlags & kIsInvisible); break; case MAC_TYPE_ATTRIBUTE: *attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdType); break; } } else if (err == fnfErr) { long dirID; Boolean isDirectory = 0; err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory); if ((err == noErr) && isDirectory) { if (objIndex == MAC_HIDDEN_ATTRIBUTE) { *attributePtrPtr = Tcl_NewBooleanObj(0); } else { *attributePtrPtr = Tcl_NewOSTypeObj('Fldr'); } } } if (err != noErr) { errno = TclMacOSErrorToPosixError(err); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't get attributes for file \"", fileName, "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } return TCL_OK; }
/*----------------------------------------------------------------------------- * SignalBlocked -- * * Determine if a signal is blocked. On non-Posix systems, always returns * FALSE. * * Parameters:: * o signalNum - The signal to determine the state for. * Returns: * NULL if an error occured (with error in errno), otherwise a pointer to a * boolean object. *----------------------------------------------------------------------------- */ static Tcl_Obj * SignalBlocked (int signalNum) { #ifndef NO_SIGACTION sigset_t sigBlockSet; if (sigprocmask (SIG_BLOCK, NULL, &sigBlockSet)) { return NULL; } return Tcl_NewBooleanObj (sigismember (&sigBlockSet, signalNum)); #else return Tcl_NewBooleanObj (FALSE); #endif }
/* ** Usage: btree_ismemdb ID ** ** Return true if the B-Tree is currently stored entirely in memory. */ static int btree_ismemdb( void *NotUsed, Tcl_Interp *interp, /* The TCL interpreter that invoked this command */ int argc, /* Number of arguments */ const char **argv /* Text of each argument */ ){ Btree *pBt; int res; sqlite3_file *pFile; if( argc!=2 ){ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ID\"", 0); return TCL_ERROR; } pBt = sqlite3TestTextToPtr(argv[1]); sqlite3_mutex_enter(pBt->db->mutex); sqlite3BtreeEnter(pBt); pFile = sqlite3PagerFile(sqlite3BtreePager(pBt)); res = (pFile->pMethods==0); sqlite3BtreeLeave(pBt); sqlite3_mutex_leave(pBt->db->mutex); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(res)); return SQLITE_OK; }
static int Turbine_Cache_Check_Cmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { TCL_ARGS(2); turbine_datum_id td; const char *subscript; size_t subscript_len; int error = ADLB_EXTRACT_HANDLE(objv[1], &td, &subscript, &subscript_len); TCL_CHECK(error); bool found; if (subscript_len == 0) { found = turbine_cache_check(td); } else { // TODO: handle caching subscripts - currently just ignore found = false; } Tcl_Obj* result = Tcl_NewBooleanObj(found); Tcl_SetObjResult(interp, result); return TCL_OK; }
/* ARGSUSED */ int Tcl_FblockedObjCmd( ClientData unused, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; int mode; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channelId"); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[1], &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if ((mode & TCL_READABLE) == 0) { Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]), "\" wasn't opened for reading", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_InputBlocked(chan))); return TCL_OK; }
/*----------------------------------------------------------------------------- * ReturnStatList -- * * Return file stat infomation as a keyed list. * * Parameters: * o interp (I) - The list is returned in result. * o ttyDev (O) - A boolean indicating if the device is associated with a * tty. * o statBufPtr (I) - Pointer to a buffer initialized by stat or fstat. *----------------------------------------------------------------------------- */ static void ReturnStatList (Tcl_Interp *interp, int ttyDev, struct stat *statBufPtr) { Tcl_Obj *keylPtr = TclX_NewKeyedListObj (); TclX_KeyedListSet (interp, keylPtr, "atime", Tcl_NewLongObj ((long) statBufPtr->st_atime)); TclX_KeyedListSet (interp, keylPtr, "ctime", Tcl_NewLongObj ((long) statBufPtr->st_ctime)); TclX_KeyedListSet (interp, keylPtr, "dev", Tcl_NewIntObj ((int) statBufPtr->st_dev)); TclX_KeyedListSet (interp, keylPtr, "gid", Tcl_NewIntObj ((int) statBufPtr->st_gid)); TclX_KeyedListSet (interp, keylPtr, "ino", Tcl_NewIntObj ((int) statBufPtr->st_ino)); TclX_KeyedListSet (interp, keylPtr, "mode", Tcl_NewIntObj ((int) statBufPtr->st_mode)); TclX_KeyedListSet (interp, keylPtr, "mtime", Tcl_NewLongObj ((long) statBufPtr->st_mtime)); TclX_KeyedListSet (interp, keylPtr, "nlink", Tcl_NewIntObj ((int) statBufPtr->st_nlink)); TclX_KeyedListSet (interp, keylPtr, "size", Tcl_NewLongObj ((long) statBufPtr->st_size)); TclX_KeyedListSet (interp, keylPtr, "uid", Tcl_NewIntObj ((int) statBufPtr->st_uid)); TclX_KeyedListSet (interp, keylPtr, "tty", Tcl_NewBooleanObj (ttyDev)); TclX_KeyedListSet (interp, keylPtr, "type", Tcl_NewStringObj (StrFileType (statBufPtr), -1)); Tcl_SetObjResult (interp, keylPtr); }
int NS(ReadItemExists) (NS_ARGS) { SETUP_mqctx CHECK_NOARGS Tcl_SetObjResult(interp, Tcl_NewBooleanObj(MqReadItemExists(mqctx))); RETURN_TCL }
static Tcl_Obj* getObject(const QVariant& v) { Tcl_Obj* value; QString text; switch (v.type()) { case QVariant::Int: case QVariant::UInt: value = Tcl_NewLongObj(v.toInt()); break; case QVariant::Bool: value = Tcl_NewBooleanObj(v.toBool()); break; case QVariant::Double: value = Tcl_NewDoubleObj(v.toDouble()); break; case QVariant::Date: text = v.toDate().toString(Qt::ISODate); value = Tcl_NewStringObj(text.utf8(), text.utf8().length()); break; default: text = v.toString(); value = Tcl_NewStringObj(text.utf8(), text.utf8().length()); break; } Tcl_IncrRefCount(value); return value; }
/* * Tcl callback to allow reading of game configuration variables from Tcl. */ static int get_param_cb ( ClientData cd, Tcl_Interp *ip, int argc, const char *argv[]) { int i; int num_params; struct param *parm; if ( argc != 2 ) { Tcl_AppendResult(ip, argv[0], ": invalid number of arguments\n", "Usage: ", argv[0], " <parameter name>", (char *)0 ); return TCL_ERROR; } /* Search for parameter */ parm = NULL; num_params = sizeof(Params)/sizeof(struct param); for (i=0; i<num_params; i++) { parm = (struct param*)&Params + i; if ( strcmp( parm->name, argv[1] ) == 0 ) { break; } } /* If can't find parameter, report error */ if ( parm == NULL || i == num_params ) { Tcl_AppendResult(ip, argv[0], ": invalid parameter `", argv[1], "'", (char *)0 ); return TCL_ERROR; } /* Get value of parameter */ switch ( parm->type ) { case PARAM_STRING: fetch_param_string( parm ); Tcl_SetObjResult( ip, Tcl_NewStringObj( parm->val.string_val, -1 ) ); break; case PARAM_CHAR: fetch_param_char( parm ); Tcl_SetObjResult( ip, Tcl_NewStringObj( &parm->val.char_val, 1 ) ); break; case PARAM_INT: fetch_param_int( parm ); Tcl_SetObjResult( ip, Tcl_NewIntObj( parm->val.int_val ) ); break; case PARAM_BOOL: fetch_param_bool( parm ); Tcl_SetObjResult( ip, Tcl_NewBooleanObj( parm->val.bool_val ) ); break; default: code_not_reached(); } return TCL_OK; }
/** \brief create the <B>msgque support</B> subcommand * * \tclmsgque_man * * \param[in] interp current Tcl interpreter * \param[in] objc number of objects in \e objv * \param[in] objv array of \e Tcl_Obj objects * \return Tcl error-code */ static int NS(Support) ( Tcl_Interp * interp, int objc, struct Tcl_Obj *const *objv ) { int index; Tcl_Obj *Obj = NULL; static const char *constant[] = { "thread", "fork", NULL }; enum constants { THREAD, FORK, }; // read the index if (objc != 3) { Tcl_WrongNumArgs (interp, 2, objv, "configuration"); return TCL_ERROR; } // get the Index TclErrorCheck (Tcl_GetIndexFromObj (interp, objv[2], constant, "configuration", 0, &index)); // do the work switch ((enum constants) index) { case THREAD: #if defined(MQ_HAS_THREAD) Obj = Tcl_NewBooleanObj (1); #else Obj = Tcl_NewBooleanObj (0); #endif break; case FORK: #if defined(HAVE_FORK) Obj = Tcl_NewBooleanObj (1); #else Obj = Tcl_NewBooleanObj (0); #endif break; } Tcl_SetObjResult (interp, Obj); return TCL_OK; }
/* assign a var from a boolean */ Tcl_Obj* TSP_Util_lang_assign_var_boolean(Tcl_Obj* targetVarName, int sourceVarName) { if (targetVarName != NULL) { Tcl_DecrRefCount(targetVarName); } targetVarName = Tcl_NewBooleanObj(sourceVarName); Tcl_IncrRefCount(targetVarName); return targetVarName; }
int NS(ReadO) (NS_ARGS) { SETUP_mqctx MQ_BOL val; CHECK_NOARGS ErrorMqToTclWithCheck(MqReadO(mqctx, &val)); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(val)); RETURN_TCL }
static Tcl_Obj *_make_value(jackctl_parameter_t *parameter, union jackctl_parameter_value value) { switch (jackctl_parameter_get_type(parameter)) { case JackParamInt: return Tcl_NewIntObj(value.i); case JackParamUInt: return Tcl_NewIntObj(value.ui); case JackParamChar: return Tcl_NewStringObj(&value.c, 1); case JackParamString: return Tcl_NewStringObj(value.str, -1); case JackParamBool: return Tcl_NewBooleanObj(value.b); default: return Tcl_ObjPrintf("unknown type %d returned by jackctl_parameter_get_type", jackctl_parameter_get_type(parameter)); } }
/*----------------------------------------------------------------------------- * ReturnStatItem -- * * Return a single file status item. * * Parameters: * o interp (I) - Item or error returned in result. * o channel (I) - Channel the file is assoicated with. * o ttyDev (O) - A boolean indicating if the device is associated with a * tty. * o statBufPtr (I) - Pointer to a buffer initialized by stat or fstat. * o itemName (I) - The name of the desired item. * Returns: * TCL_OK or TCL_ERROR. *----------------------------------------------------------------------------- */ static int ReturnStatItem (Tcl_Interp *interp, Tcl_Channel channel, int ttyDev, struct stat *statBufPtr, char *itemName) { Tcl_Obj *objPtr; if (STREQU (itemName, "dev")) objPtr = Tcl_NewIntObj ((int) statBufPtr->st_dev); else if (STREQU (itemName, "ino")) objPtr = Tcl_NewIntObj ((int) statBufPtr->st_ino); else if (STREQU (itemName, "mode")) objPtr = Tcl_NewIntObj ((int) statBufPtr->st_mode); else if (STREQU (itemName, "nlink")) objPtr = Tcl_NewIntObj ((int) statBufPtr->st_nlink); else if (STREQU (itemName, "uid")) objPtr = Tcl_NewIntObj ((int) statBufPtr->st_uid); else if (STREQU (itemName, "gid")) objPtr = Tcl_NewIntObj ((int) statBufPtr->st_gid); else if (STREQU (itemName, "size")) objPtr = Tcl_NewLongObj ((long) statBufPtr->st_size); else if (STREQU (itemName, "atime")) objPtr = Tcl_NewLongObj ((long) statBufPtr->st_atime); else if (STREQU (itemName, "mtime")) objPtr = Tcl_NewLongObj ((long) statBufPtr->st_mtime); else if (STREQU (itemName, "ctime")) objPtr = Tcl_NewLongObj ((long) statBufPtr->st_ctime); else if (STREQU (itemName, "type")) objPtr = Tcl_NewStringObj (StrFileType (statBufPtr), -1); else if (STREQU (itemName, "tty")) objPtr = Tcl_NewBooleanObj (ttyDev); else if (STREQU (itemName, "remotehost")) { objPtr = TclXGetHostInfo (interp, channel, TRUE); if (objPtr == NULL) return TCL_ERROR; } else if (STREQU (itemName, "localhost")) { objPtr = TclXGetHostInfo (interp, channel, FALSE); if (objPtr == NULL) return TCL_ERROR; } else { TclX_AppendObjResult (interp, "Got \"", itemName, "\", expected one of ", "\"atime\", \"ctime\", \"dev\", \"gid\", ", "\"ino\", \"mode\", \"mtime\", \"nlink\", ", "\"size\", \"tty\", \"type\", \"uid\", ", "\"remotehost\", or \"localhost\"", (char *) NULL); return TCL_ERROR; } Tcl_SetObjResult (interp, objPtr); return TCL_OK; }
static int isMapped( Tcl_Interp *interp, GtkWidget *widget, int objc, Tcl_Obj * const objv[] ) { if( objc != 2 ) { Tcl_WrongNumArgs( interp, 1, objv, NULL ); return TCL_ERROR; } Tcl_SetObjResult( interp, Tcl_NewBooleanObj( GTK_WIDGET_MAPPED( widget ) ) ); return TCL_OK; }
static int stateHandlerInvoke(Tcl_Event* p, int flags) { /* called from Tcl event loop, when the connection status changes */ connectionEvent *cev =(connectionEvent *) p; pvInfo *info = cev->info; Tcl_Obj *script = Tcl_DuplicateObj(info->connectprefix); Tcl_IncrRefCount(script); /* append cmd of PV and up/down */ Tcl_Obj *cmdname = Tcl_NewObj(); Tcl_GetCommandFullName(info->interp, info->cmd, cmdname); int code = Tcl_ListObjAppendElement(info->interp, script, cmdname); if (code != TCL_OK) { goto bgerr; } if (cev->op == CA_OP_CONN_UP) { info->connected = 1; /* Retrieve information about type and number of elements */ info->nElem = ca_element_count(info->id); info->type = ca_field_type(info->id); } else { info->connected = 0; } code = Tcl_ListObjAppendElement(info->interp, script, Tcl_NewBooleanObj(info->connected)); if (code != TCL_OK) { goto bgerr; } Tcl_Preserve(info->interp); code = Tcl_EvalObjEx(info->interp, script, TCL_EVAL_GLOBAL); if (code != TCL_OK) { goto bgerr; } Tcl_Release(info->interp); Tcl_DecrRefCount(script); /* this event was successfully handled */ return 1; bgerr: /* put error in background */ Tcl_AddErrorInfo(info->interp, "\n (epics connection callback script)"); Tcl_BackgroundException(info->interp, code); /* this event was successfully handled */ return 1; }
/* Object command for a PV object */ static int InstanceCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]) { pvInfo *info = (pvInfo *) clientData; if (objc<2) { Tcl_WrongNumArgs(interp, 1, objv, "subcommand"); return TCL_ERROR; } Tcl_Obj *subcommand=objv[1]; int cmdindex; if (Tcl_GetIndexFromObj(interp, subcommand, pvcmdtable, "subcommand", 0, &cmdindex) != TCL_OK) { return TCL_ERROR; } switch (cmdindex) { case PUT: return PutCmd(interp, info, objc, objv); case GET: return GetCmd(interp, info, objc, objv); case MONITOR: return MonitorCmd(interp, info, objc, objv); case NAME: Tcl_SetObjResult(interp, Tcl_NewStringObj(info->name, -1)); return TCL_OK; case CONNECTED: Tcl_SetObjResult(interp, Tcl_NewBooleanObj(info->connected)); return TCL_OK; case NELEM: Tcl_SetObjResult(interp, Tcl_NewWideIntObj(info->nElem)); return TCL_OK; case CHID: Tcl_SetObjResult(interp, Tcl_NewWideIntObj((intptr_t)info->id)); return TCL_OK; case TYPE: Tcl_SetObjResult(interp, Tcl_NewStringObj(dbr_type_to_text(info->type), -1)); return TCL_OK; case DESTROY: { Tcl_Command self = Tcl_GetCommandFromObj(interp, objv[0]); if (self != NULL) { Tcl_DeleteCommandFromToken(interp, self); } return TCL_OK; } default: Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown error", -1)); return TCL_ERROR; } }
static int GetWinFileAttributes( 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 **attributePtrPtr) /* A pointer to return the object with. */ { DWORD result = GetFileAttributes(fileName); if (result == 0xFFFFFFFF) { AttributesPosixError(interp, objIndex, fileName, 0); return TCL_ERROR; } *attributePtrPtr = Tcl_NewBooleanObj(result & attributeArray[objIndex]); return TCL_OK; }
static int GetFileReadOnly( 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 **readOnlyPtrPtr) /* A pointer to return the object with. */ { OSErr err; FSSpec fileSpec; CInfoPBRec paramBlock; err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec); if (err == noErr) { if (err == noErr) { paramBlock.hFileInfo.ioCompletion = NULL; paramBlock.hFileInfo.ioNamePtr = fileSpec.name; paramBlock.hFileInfo.ioVRefNum = fileSpec.vRefNum; paramBlock.hFileInfo.ioFDirIndex = 0; paramBlock.hFileInfo.ioDirID = fileSpec.parID; err = PBGetCatInfo(¶mBlock, 0); if (err == noErr) { /* * For some unknown reason, the Mac does not give * symbols for the bits in the ioFlAttrib field. * 1 -> locked. */ *readOnlyPtrPtr = Tcl_NewBooleanObj( paramBlock.hFileInfo.ioFlAttrib & 1); } } } if (err != noErr) { errno = TclMacOSErrorToPosixError(err); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't get attributes for file \"", fileName, "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } return TCL_OK; }
/* ARGSUSED */ int Tcl_EofObjCmd( ClientData unused, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channelId"); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_Eof(chan))); return TCL_OK; }
Tcl_Obj * Tcljson_TclObjFromJsonObj(struct json_object *joPtr) { Tcl_Obj *objPtr; enum json_type type; char *def = NULL; if (joPtr == NULL) { objPtr = Tcl_NewStringObj(&def, -1); return objPtr; } type = json_object_get_type(joPtr); switch (type) { case json_type_string: objPtr = Tcl_NewStringObj(json_object_get_string(joPtr), -1); break; case json_type_int: objPtr = Tcl_NewIntObj(json_object_get_int(joPtr)); break; case json_type_double: objPtr = Tcl_NewLongObj(json_object_get_double(joPtr)); break; case json_type_boolean: objPtr = Tcl_NewBooleanObj(json_object_get_boolean(joPtr)); break; case json_type_object: Tcljson_JsonObjToTclObj(joPtr, &objPtr); break; case json_type_array: Tcljson_JsonObjToTclObj(joPtr, &objPtr); break; default: objPtr = Tcl_NewStringObj(json_object_to_json_string(joPtr), -1); break; } return objPtr; }
int MkView::OperatorCmd() { c4_String op = (const char*)Tcl_GetStringFromObj(objv[1], 0); c4_View nview = View(interp, objv[2]); bool rc; if (op == "==") rc = (view == nview); else if (op == "!=") rc = (view != nview); else if (op == "<") rc = (view < nview); else if (op == ">") rc = (view > nview); else if (op == ">=") rc = (view >= nview); else if (op == "<=") rc = (view <= nview); else return Fail("bad operator: must be one of ==, !=, <, >, <=, >="); return tcl_SetObjResult(Tcl_NewBooleanObj(rc ? 1 : 0)); }
static int GetWinFileAttributes( 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 **attributePtrPtr) /* A pointer to return the object with. */ { DWORD result; Tcl_DString ds; TCHAR *nativeName; nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); result = (*tclWinProcs->getFileAttributesProc)(nativeName); Tcl_DStringFree(&ds); if (result == 0xffffffff) { StatError(interp, fileName); return TCL_ERROR; } *attributePtrPtr = Tcl_NewBooleanObj(result & attributeArray[objIndex]); return TCL_OK; }
static int cget ( Tcl_Interp *interp, ComboParams *para, GnoclOption options[], int idx ) { Tcl_Obj *obj = NULL; GtkEntry *entry = GTK_ENTRY ( para->combo->entry ); if ( idx == variableIdx ) obj = Tcl_NewStringObj ( para->variable, -1 ); else if ( idx == onChangedIdx ) obj = Tcl_NewStringObj ( para->onChanged ? para->onChanged : "", -1 ); else if ( idx == itemsIdx ) { obj = Tcl_NewListObj ( 0, NULL ); gtk_container_foreach ( GTK_CONTAINER ( para->combo->list ), getAllItems, obj ); } else if ( idx == valueIdx ) obj = Tcl_NewStringObj ( gtk_entry_get_text ( entry ), -1 ); else if ( idx == tooltipIdx ) gnoclOptTooltip ( interp, &options[tooltipIdx], G_OBJECT ( entry ), &obj ); else if ( idx == editableIdx ) { gboolean on; g_object_get ( G_OBJECT ( entry ), "editable", &on, NULL ); obj = Tcl_NewBooleanObj ( on ); } if ( obj != NULL ) { Tcl_SetObjResult ( interp, obj ); return TCL_OK; } return gnoclCgetNotImplemented ( interp, options + idx ); }
int Tk_ImageObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { static const char *const imageOptions[] = { "create", "delete", "height", "inuse", "names", "type", "types", "width", NULL }; enum options { IMAGE_CREATE, IMAGE_DELETE, IMAGE_HEIGHT, IMAGE_INUSE, IMAGE_NAMES, IMAGE_TYPE, IMAGE_TYPES, IMAGE_WIDTH }; TkWindow *winPtr = clientData; int i, isNew, firstOption, index; Tk_ImageType *typePtr; ImageMaster *masterPtr; Image *imagePtr; Tcl_HashEntry *hPtr; Tcl_HashSearch search; char idString[16 + TCL_INTEGER_SPACE]; TkDisplay *dispPtr = winPtr->dispPtr; const char *arg, *name; Tcl_Obj *resultObj; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?args?"); return TCL_ERROR; } if (Tcl_GetIndexFromObjStruct(interp, objv[1], imageOptions, sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { case IMAGE_CREATE: { Tcl_Obj **args; int oldimage = 0; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "type ?name? ?-option value ...?"); return TCL_ERROR; } /* * Look up the image type. */ arg = Tcl_GetString(objv[2]); for (typePtr = tsdPtr->imageTypeList; typePtr != NULL; typePtr = typePtr->nextPtr) { if ((*arg == typePtr->name[0]) && (strcmp(arg, typePtr->name) == 0)) { break; } } if (typePtr == NULL) { oldimage = 1; for (typePtr = tsdPtr->oldImageTypeList; typePtr != NULL; typePtr = typePtr->nextPtr) { if ((*arg == typePtr->name[0]) && (strcmp(arg, typePtr->name) == 0)) { break; } } } if (typePtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "image type \"%s\" doesn't exist", arg)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE_TYPE", arg, NULL); return TCL_ERROR; } /* * Figure out a name to use for the new image. */ if ((objc == 3) || (*(arg = Tcl_GetString(objv[3])) == '-')) { do { dispPtr->imageId++; sprintf(idString, "image%d", dispPtr->imageId); name = idString; } while (Tcl_FindCommand(interp, name, NULL, 0) != NULL); firstOption = 3; } else { TkWindow *topWin; name = arg; firstOption = 4; /* * Need to check if the _command_ that we are about to create is * the name of the current master widget command (normally "." but * could have been renamed) and fail in that case before a really * nasty and hard to stop crash happens. */ topWin = (TkWindow *) TkToplevelWindowForCommand(interp, name); if (topWin != NULL && winPtr->mainPtr->winPtr == topWin) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "images may not be named the same as the main window", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "SMASH_MAIN", NULL); return TCL_ERROR; } } /* * Create the data structure for the new image. */ hPtr = Tcl_CreateHashEntry(&winPtr->mainPtr->imageTable, name, &isNew); if (isNew) { masterPtr = ckalloc(sizeof(ImageMaster)); masterPtr->typePtr = NULL; masterPtr->masterData = NULL; masterPtr->width = masterPtr->height = 1; masterPtr->tablePtr = &winPtr->mainPtr->imageTable; masterPtr->hPtr = hPtr; masterPtr->instancePtr = NULL; masterPtr->deleted = 0; masterPtr->winPtr = winPtr->mainPtr->winPtr; Tcl_Preserve(masterPtr->winPtr); Tcl_SetHashValue(hPtr, masterPtr); } else { /* * An image already exists by this name. Disconnect the instances * from the master. */ masterPtr = Tcl_GetHashValue(hPtr); if (masterPtr->typePtr != NULL) { for (imagePtr = masterPtr->instancePtr; imagePtr != NULL; imagePtr = imagePtr->nextPtr) { masterPtr->typePtr->freeProc(imagePtr->instanceData, imagePtr->display); imagePtr->changeProc(imagePtr->widgetClientData, 0, 0, masterPtr->width, masterPtr->height, masterPtr->width, masterPtr->height); } masterPtr->typePtr->deleteProc(masterPtr->masterData); masterPtr->typePtr = NULL; } masterPtr->deleted = 0; } /* * Call the image type manager so that it can perform its own * initialization, then re-"get" for any existing instances of the * image. */ objv += firstOption; objc -= firstOption; args = (Tcl_Obj **) objv; if (oldimage) { int i; args = ckalloc((objc+1) * sizeof(char *)); for (i = 0; i < objc; i++) { args[i] = (Tcl_Obj *) Tcl_GetString(objv[i]); } args[objc] = NULL; } Tcl_Preserve(masterPtr); if (typePtr->createProc(interp, name, objc, args, typePtr, (Tk_ImageMaster)masterPtr, &masterPtr->masterData) != TCL_OK){ EventuallyDeleteImage(masterPtr, 0); Tcl_Release(masterPtr); if (oldimage) { ckfree(args); } return TCL_ERROR; } Tcl_Release(masterPtr); if (oldimage) { ckfree(args); } masterPtr->typePtr = typePtr; for (imagePtr = masterPtr->instancePtr; imagePtr != NULL; imagePtr = imagePtr->nextPtr) { imagePtr->instanceData = typePtr->getProc(imagePtr->tkwin, masterPtr->masterData); } Tcl_SetObjResult(interp, Tcl_NewStringObj( Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), -1)); break; } case IMAGE_DELETE: for (i = 2; i < objc; i++) { arg = Tcl_GetString(objv[i]); hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg); if (hPtr == NULL) { goto alreadyDeleted; } masterPtr = Tcl_GetHashValue(hPtr); if (masterPtr->deleted) { goto alreadyDeleted; } DeleteImage(masterPtr); } break; case IMAGE_NAMES: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search); resultObj = Tcl_NewObj(); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { masterPtr = Tcl_GetHashValue(hPtr); if (masterPtr->deleted) { continue; } Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), -1)); } Tcl_SetObjResult(interp, resultObj); break; case IMAGE_TYPES: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } resultObj = Tcl_NewObj(); for (typePtr = tsdPtr->imageTypeList; typePtr != NULL; typePtr = typePtr->nextPtr) { Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( typePtr->name, -1)); } for (typePtr = tsdPtr->oldImageTypeList; typePtr != NULL; typePtr = typePtr->nextPtr) { Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( typePtr->name, -1)); } Tcl_SetObjResult(interp, resultObj); break; case IMAGE_HEIGHT: case IMAGE_INUSE: case IMAGE_TYPE: case IMAGE_WIDTH: /* * These operations all parse virtually identically. First check to * see if three args are given. Then get a non-deleted master from the * third arg. */ if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "name"); return TCL_ERROR; } arg = Tcl_GetString(objv[2]); hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg); if (hPtr == NULL) { goto alreadyDeleted; } masterPtr = Tcl_GetHashValue(hPtr); if (masterPtr->deleted) { goto alreadyDeleted; } /* * Now we read off the specific piece of data we were asked for. */ switch ((enum options) index) { case IMAGE_HEIGHT: Tcl_SetObjResult(interp, Tcl_NewWideIntObj(masterPtr->height)); break; case IMAGE_INUSE: Tcl_SetObjResult(interp, Tcl_NewBooleanObj( masterPtr->typePtr && masterPtr->instancePtr)); break; case IMAGE_TYPE: if (masterPtr->typePtr != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(masterPtr->typePtr->name, -1)); } break; case IMAGE_WIDTH: Tcl_SetObjResult(interp, Tcl_NewWideIntObj(masterPtr->width)); break; default: Tcl_Panic("can't happen"); } break; } return TCL_OK; alreadyDeleted: Tcl_SetObjResult(interp, Tcl_ObjPrintf("image \"%s\" doesn't exist",arg)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE", arg, NULL); return TCL_ERROR; }
static Tcl_Obj * ObjValue( Link *linkPtr) /* Structure describing linked variable. */ { char *p; Tcl_Obj *resultObj; switch (linkPtr->type) { case TCL_LINK_INT: linkPtr->lastValue.i = LinkedVar(int); return Tcl_NewIntObj(linkPtr->lastValue.i); case TCL_LINK_WIDE_INT: linkPtr->lastValue.w = LinkedVar(Tcl_WideInt); return Tcl_NewWideIntObj(linkPtr->lastValue.w); case TCL_LINK_DOUBLE: linkPtr->lastValue.d = LinkedVar(double); return Tcl_NewDoubleObj(linkPtr->lastValue.d); case TCL_LINK_BOOLEAN: linkPtr->lastValue.i = LinkedVar(int); return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0); case TCL_LINK_CHAR: linkPtr->lastValue.c = LinkedVar(char); return Tcl_NewIntObj(linkPtr->lastValue.c); case TCL_LINK_UCHAR: linkPtr->lastValue.uc = LinkedVar(unsigned char); return Tcl_NewIntObj(linkPtr->lastValue.uc); case TCL_LINK_SHORT: linkPtr->lastValue.s = LinkedVar(short); return Tcl_NewIntObj(linkPtr->lastValue.s); case TCL_LINK_USHORT: linkPtr->lastValue.us = LinkedVar(unsigned short); return Tcl_NewIntObj(linkPtr->lastValue.us); case TCL_LINK_UINT: linkPtr->lastValue.ui = LinkedVar(unsigned int); return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui); case TCL_LINK_LONG: linkPtr->lastValue.l = LinkedVar(long); return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l); case TCL_LINK_ULONG: linkPtr->lastValue.ul = LinkedVar(unsigned long); return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul); case TCL_LINK_FLOAT: linkPtr->lastValue.f = LinkedVar(float); return Tcl_NewDoubleObj(linkPtr->lastValue.f); case TCL_LINK_WIDE_UINT: linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt); /* * FIXME: represent as a bignum. */ return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw); case TCL_LINK_STRING: p = LinkedVar(char *); if (p == NULL) { TclNewLiteralStringObj(resultObj, "NULL"); return resultObj; } return Tcl_NewStringObj(p, -1); /* * This code only gets executed if the link type is unknown (shouldn't * ever happen). */ default: TclNewLiteralStringObj(resultObj, "??"); return resultObj; } }
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; }
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; }
int NS(LinkIsParent) (NS_ARGS) { CHECK_NOARGS Tcl_SetObjResult(interp, Tcl_NewBooleanObj (MqLinkIsParentI(MQCTX))); RETURN_TCL }
int NS(LinkIsConnected) (NS_ARGS) { CHECK_NOARGS Tcl_SetObjResult(interp, Tcl_NewBooleanObj (MqLinkIsConnected(MQCTX))); RETURN_TCL }