static int listObjToParameters (Tcl_Interp *interp, Tcl_Obj *pParameters, Method &method) { int paramCount; if (Tcl_ListObjLength(interp, pParameters, ¶mCount) != TCL_OK) { return TCL_ERROR; } for (int i = 0; i < paramCount; ++i) { Tcl_Obj *pParameter; if (Tcl_ListObjIndex(interp, pParameters, i, &pParameter) != TCL_OK) { return TCL_ERROR; } int paramObjc; Tcl_Obj **paramObjv; if (Tcl_ListObjGetElements(interp, pParameter, ¶mObjc, ¶mObjv) != TCL_OK) { return TCL_ERROR; } Parameter parameter( Tcl_GetStringFromObj(paramObjv[0], 0), Tcl_GetStringFromObj(paramObjv[1], 0), Tcl_GetStringFromObj(paramObjv[2], 0)); method.addParameter(parameter); } return TCL_OK; }
Dialog* Dialog::createDialogByScript( const char* dialogName ) { char tempBuf[256]; Tcl_Interp* interp = GetScriptManager().getInterp(); StringCchPrintfA( tempBuf, 256, "%s::region", dialogName ); TileRegion region; GetScriptManager().readRect( tempBuf, region ); StringCchPrintfA( tempBuf, 256, "%s::dialog", dialogName ); Tcl_Obj* dialogObj = GetScriptManager().getObject( tempBuf ); int dialogTokenCount; Tcl_ListObjLength( interp, dialogObj, &dialogTokenCount ); UINT speakCount = dialogTokenCount / 2; Dialog::Speak* speakArray = new Dialog::Speak[ speakCount ]; UINT i; for ( i = 0; i < speakCount; ++i ) { Tcl_Obj* elem; int length; Tcl_ListObjIndex( interp, dialogObj, i*2 + 0, &elem ); speakArray[ i ].name = Tcl_GetStringFromObj( elem, &length ); Tcl_ListObjIndex( interp, dialogObj, i*2 + 1, &elem ); speakArray[ i ].content = Tcl_GetStringFromObj( elem, &length ); } StringCchPrintfA( tempBuf, 256, "%s::oneTime", dialogName ); int oneTime = GetScriptManager().readInt( tempBuf ); return new Dialog( speakArray, speakCount, ®ion, oneTime?true:false, dialogName ); }
/* ** Returns 1 if data is ready, or 0 if not. */ static int next2(Tcl_Interp *interp, tclvar_cursor *pCur, Tcl_Obj *pObj){ Tcl_Obj *p; if( pObj ){ if( !pCur->pList2 ){ p = Tcl_NewStringObj("array names", -1); Tcl_IncrRefCount(p); Tcl_ListObjAppendElement(0, p, pObj); Tcl_EvalObjEx(interp, p, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(p); pCur->pList2 = Tcl_GetObjResult(interp); Tcl_IncrRefCount(pCur->pList2); assert( pCur->i2==0 ); }else{ int n = 0; pCur->i2++; Tcl_ListObjLength(0, pCur->pList2, &n); if( pCur->i2>=n ){ Tcl_DecrRefCount(pCur->pList2); pCur->pList2 = 0; pCur->i2 = 0; return 0; } } } return 1; }
static int cmd_rechan(ClientData cd_, Tcl_Interp* ip_, int objc_, Tcl_Obj*const* objv_) { ReflectingChannel *rc; int mode; char buffer [20]; if (objc_ != 3) { Tcl_WrongNumArgs(ip_, 1, objv_, "command mode"); return TCL_ERROR; } if (Tcl_ListObjLength(ip_, objv_[1], &mode) == TCL_ERROR || Tcl_GetIntFromObj(ip_, objv_[2], &mode) == TCL_ERROR) return TCL_ERROR; Tcl_MutexLock(&rechanMutex); sprintf(buffer, "rechan%d", ++mkChanSeq); Tcl_MutexUnlock(&rechanMutex); rc = rcCreate (ip_, objv_[1], mode, buffer); rc->_chan = Tcl_CreateChannel(&reChannelType, buffer, (ClientData) rc, mode); Tcl_RegisterChannel(ip_, rc->_chan); Tcl_SetChannelOption(ip_, rc->_chan, "-buffering", "none"); Tcl_SetChannelOption(ip_, rc->_chan, "-blocking", "0"); Tcl_SetResult(ip_, buffer, TCL_VOLATILE); return TCL_OK; }
int NS(ProcCheck) ( Tcl_Interp * interp, struct Tcl_Obj * cmdObj, char const * const wrongNrStr ) { int ret,len; Tcl_DString cmd; if (!Tcl_GetCommandFromObj (interp, cmdObj)) { Tcl_WrongNumArgs (interp, 0, NULL, wrongNrStr); return TCL_ERROR; } Tcl_DStringInit(&cmd); Tcl_DStringAppendElement(&cmd,"info"); Tcl_DStringAppendElement(&cmd,"args"); Tcl_DStringAppendElement(&cmd,Tcl_GetString(cmdObj)); ret = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd), TCL_EVAL_GLOBAL); Tcl_DStringFree(&cmd); TclErrorCheck(ret); TclErrorCheck(Tcl_ListObjLength(interp, Tcl_GetObjResult(interp), &len)); if (len != 1) { Tcl_DString msg; Tcl_DStringInit(&msg); Tcl_DStringAppend(&msg,"wrong # args: ", -1); if (len > 1) Tcl_DStringAppend(&msg,"only ", -1); Tcl_DStringAppend(&msg,"one argument for procedure \"", -1); Tcl_DStringAppend(&msg,Tcl_GetString(cmdObj), -1); Tcl_DStringAppend(&msg,"\" is required", -1); Tcl_DStringResult(interp, &msg); Tcl_DStringFree(&msg); return TCL_ERROR; } return TCL_OK; }
static int shell_cmd_watch(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { const char *help = "watch - Trace changes to a signal\n" "\n" "Usage: watch SIGNALS...\n" "\n" "Prints a message every time an update occurs to a signal listed." "\n" "Examples:\n" " watch [signals {clk}] Trace updates to all signals named clk\n"; if (show_help(objc, objv, help)) return TCL_OK; if (objc == 1) { warnf("nothing to watch (try -help for usage)"); return TCL_OK; } hash_t *decl_hash = (hash_t *)cd; for (int i = 1; i < objc; i++) { int length; if (Tcl_ListObjLength(interp, objv[i], &length) != TCL_OK) return TCL_ERROR; for (int j = 0; j < length; j++) { Tcl_Obj *obj; if (Tcl_ListObjIndex(interp, objv[i], j, &obj) != TCL_OK) return TCL_ERROR; const char *str = Tcl_GetString(obj); tree_t t = hash_get(decl_hash, ident_new(str)); if (t == NULL) return tcl_error(interp, "object not found: %s", str); if (t == NULL) return tcl_error(interp, "object not found: %s", str); else if (tree_kind(t) != T_SIGNAL_DECL) return tcl_error(interp, "not a signal: %s", str); else if (type_is_array(tree_type(t))) return tcl_error(interp, "only scalar signals may be watched"); // TODO: make this work for arrays slave_watch_msg_t msg = { .index = tree_index(t) }; slave_post_msg(SLAVE_WATCH, &msg, sizeof(msg)); } } return TCL_OK; }
static int configure( Tcl_Interp *interp, CanvasParams *para, GnoclOption options[] ) { if( options[scrollRegionIdx].status == GNOCL_STATUS_CHANGED ) { Tcl_Obj *obj = options[scrollRegionIdx].val.obj; int k, no; double val[4]; /* x, y, w, h */ if( Tcl_ListObjLength( interp, obj, &no ) != TCL_OK || no != 4 ) { Tcl_SetResult( interp, "scrollRegion must be proper list with four members", TCL_STATIC ); return TCL_ERROR; } for( k = 0; k < no; ++k ) { Tcl_Obj *tp; if( Tcl_ListObjIndex( interp, obj, k, &tp ) != TCL_OK ) return TCL_ERROR; if( Tcl_GetDoubleFromObj( interp, tp, &val[k] ) ) return TCL_ERROR; } gnome_canvas_set_scroll_region( para->canvas, val[0], val[1], val[0] + val[2], val[1] + val[3] ); } if( options[pixelPerUnitIdx].status == GNOCL_STATUS_CHANGED ) { gnome_canvas_set_pixels_per_unit( para->canvas, options[pixelPerUnitIdx].val.d ); } if( options[centerScrollIdx].status == GNOCL_STATUS_CHANGED ) { gnome_canvas_set_center_scroll_region( para->canvas, options[centerScrollIdx].val.b ); } #if 0 if( popt->scrollbar.changed ) { GtkPolicyType hor, vert; if( gnoclGetScrollbarPolicy( interp, popt->scrollbar.val, &hor, &vert ) != TCL_OK ) return TCL_ERROR; gtk_scrolled_window_set_policy( para->scrollWin, hor, vert ); } #endif return TCL_OK; }
static int windowToCanvas( Tcl_Interp *interp, int objc, Tcl_Obj * const objv[], CanvasParams *params, int reverse ) { Tcl_Obj *resList; int noCoords, n; if( objc != 3 ) { Tcl_WrongNumArgs( interp, 2, objv, /* canvas windowToCanvas */ "list-of-coordinates ?option val ...?" ); return TCL_ERROR; } /* TODO -only [xy]: only x, y coordinates -pairs [true|false]: list of coordinate pairs (lists) */ if( Tcl_ListObjLength( interp, objv[2], &noCoords ) != TCL_OK || ( noCoords % 2 ) ) { Tcl_SetResult( interp, "size of list-of-coordinates must be even", TCL_STATIC ); return TCL_ERROR; } resList = Tcl_NewListObj( 0, NULL ); for( n = 0; n < noCoords; n += 2 ) { Tcl_Obj *tp; double xw, yw, x, y; int ret = Tcl_ListObjIndex( interp, objv[2], n, &tp ); if( ret == TCL_OK ) ret = Tcl_GetDoubleFromObj( interp, tp, &xw ); if( ret == TCL_OK ) ret = Tcl_ListObjIndex( interp, objv[2], n + 1, &tp ); if( ret == TCL_OK ) ret = Tcl_GetDoubleFromObj( interp, tp, &yw ); if( ret != TCL_OK ) { Tcl_DecrRefCount( resList ); /* FIXME: is this correct? */ return TCL_ERROR; } if( reverse ) gnome_canvas_world_to_window( params->canvas, xw, yw, &x, &y ); else gnome_canvas_window_to_world( params->canvas, xw, yw, &x, &y ); Tcl_ListObjAppendElement( interp, resList, Tcl_NewDoubleObj( x ) ); Tcl_ListObjAppendElement( interp, resList, Tcl_NewDoubleObj( y ) ); } Tcl_SetObjResult( interp, resList ); return TCL_OK; }
static int shell_cmd_unwatch(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { const char *help = "unwatch - Stop tracing signals\n" "\n" "Usage: unwatch SIGNALS...\n" "\n" "Clears any watch callback on SIGNALS. Note this will also stop any\n" "VCD or other waveform capture for these signals.\n" "\n" "Examples:\n" " watch [signals {clk}] Stop tracing updates to clk\n"; if (show_help(objc, objv, help)) return TCL_OK; if (objc == 1) { warnf("nothing to unwatch (try -help for usage)"); return TCL_OK; } hash_t *decl_hash = (hash_t *)cd; // TODO: refactor this code to avoid duplication with "watch" and "show" for (int i = 1; i < objc; i++) { int length; if (Tcl_ListObjLength(interp, objv[i], &length) != TCL_OK) return TCL_ERROR; for (int j = 0; j < length; j++) { Tcl_Obj *obj; if (Tcl_ListObjIndex(interp, objv[i], j, &obj) != TCL_OK) return TCL_ERROR; const char *str = Tcl_GetString(obj); tree_t t = hash_get(decl_hash, ident_new(str)); if (t == NULL) return tcl_error(interp, "object not found: %s", str); else if (tree_kind(t) != T_SIGNAL_DECL) return tcl_error(interp, "not a signal: %s", str); slave_unwatch_msg_t msg = { .index = tree_index(t) }; slave_post_msg(SLAVE_UNWATCH, &msg, sizeof(msg)); } } return TCL_OK; }
/* * Utility function to free a Tcl list object's elements. * * We do this by decrementing reference count of all referenced elements. * Note we do not decrement the reference counter of the list object. You * need to do that yourself if necessary. * * TODO: is there an existing Tcl library function to do this more easily? */ static bool __tcl_command_free_tcl_list(Tcl_Interp* interp, Tcl_Obj* list) { if (!list) { return false; } // find how many elements in the list to remove. int count = 0; if (Tcl_ListObjLength(interp, list, &count) != TCL_OK) { return false; } if (Tcl_ListObjReplace(interp, list, 0, count, 0, NULL) != TCL_OK) { return false; } return true; }
static int tclvarNext(sqlite3_vtab_cursor *cur){ Tcl_Obj *pObj; int n = 0; int ok = 0; tclvar_cursor *pCur = (tclvar_cursor *)cur; Tcl_Interp *interp = ((tclvar_vtab *)(cur->pVtab))->interp; Tcl_ListObjLength(0, pCur->pList1, &n); while( !ok && pCur->i1<n ){ Tcl_ListObjIndex(0, pCur->pList1, pCur->i1, &pObj); ok = next2(interp, pCur, pObj); if( !ok ){ pCur->i1++; } } return 0; }
std::vector<double> TclUtils::getDoubleVector(Tcl_Interp *interp, Tcl_Obj *objPtr) { int length; int rc = Tcl_ListObjLength(interp, objPtr, &length); if (TCL_OK != rc) { throw wrong_args_value_exception(error_message::bad_list_argument); } std::vector<double> ret; for (int i = 0; i < length; ++i) { Tcl_Obj* v; rc = Tcl_ListObjIndex(interp, objPtr, i, &v); if (TCL_OK != rc) { throw wrong_args_value_exception(error_message::bad_list_argument); } ret.push_back(getDouble(interp, v)); } return ret; }
std::vector<std::string> TclUtils::getStringVector(Tcl_Interp *interp, Tcl_Obj *objPtr) { int length; int rc = Tcl_ListObjLength(interp, objPtr, &length); if (TCL_OK != rc) { throw wrong_args_value_exception(error_message::bad_list_argument); } std::vector<std::string> ret; for (int i = 0; i < length; ++i) { Tcl_Obj* v; rc = Tcl_ListObjIndex(interp, objPtr, i, &v); if (TCL_OK != rc) { throw wrong_args_value_exception(error_message::bad_list_argument); } ret.push_back(std::string(Tcl_GetStringFromObj(v, NULL))); } return ret; }
Skill* Skill::createSkillByScript( const char* skillNsName ) { char tempBuf[256]; StringCchPrintfA( tempBuf, 256, "%s::name", skillNsName ); const char* skillName = GetScriptManager().readString( tempBuf ); StringCchPrintfA( tempBuf, 256, "%s::description", skillNsName ); const char* skillDescription = GetScriptManager().readString( tempBuf ); StringCchPrintfA( tempBuf, 256, "%s::csEssentials", skillNsName ); int csEssentials = GetScriptManager().readInt( tempBuf ); Skill* ret = new Skill( skillName, skillDescription, csEssentials ); StringCchPrintfA( tempBuf, 256, "%s::registerSkillObjects", skillNsName ); Tcl_Obj* skillObjects = GetScriptManager().execute( tempBuf ); int skillObjectsCount = 0; Tcl_Interp* interp = GetScriptManager().getInterp(); Tcl_ListObjLength( interp, skillObjects, &skillObjectsCount ); int i; for ( i = 0; i < skillObjectsCount; ++i ) { Tcl_Obj* elem; long soPtrVal = 0; SkillObject* so = 0; Tcl_ListObjIndex( interp, skillObjects, i, &elem ); Tcl_GetLongFromObj( interp, elem, &soPtrVal ); so = reinterpret_cast<SkillObject*>( soPtrVal ); if ( so->getType() == UT_SKILLOBJECT ) ret->addSkillObject( so ); else throw std::runtime_error( "Serious error on script file." ); } return ret; }
static int shell_cmd_show(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { const char *help = "show - Display simulation objects\n" "\n" "Usage: show LIST...\n" "\n" "Prints a representation of each simulation object in LIST. Typically\n" "this will be a list of signal names and the output will show their\n" "current value.\n" "\n" "Examples:\n" " show {:top:foo} Print value of signal :top_foo\n" " show [signals] Print value of all signals\n"; if (show_help(objc, objv, help)) return TCL_OK; if (objc == 1) { warnf("nothing to show (try -help for usage)"); return TCL_OK; } hash_t *decl_hash = (hash_t *)cd; for (int i = 1; i < objc; i++) { int length; if (Tcl_ListObjLength(interp, objv[i], &length) != TCL_OK) return TCL_ERROR; for (int j = 0; j < length; j++) { Tcl_Obj *obj; if (Tcl_ListObjIndex(interp, objv[i], j, &obj) != TCL_OK) return TCL_ERROR; const char *str = Tcl_GetString(obj); tree_t t = hash_get(decl_hash, ident_new(str)); if (t == NULL) return tcl_error(interp, "object not found: %s", str); tree_kind_t kind = tree_kind(t); switch (kind) { case T_SIGNAL_DECL: { const size_t len = tree_nets(t); uint64_t *values LOCAL = xmalloc(len * sizeof(uint64_t)); rt_signal_value(t, values, len); const char *type_str = type_pp(tree_type(t)); const char *short_name = strrchr(type_str, '.'); LOCAL_TEXT_BUF values_tb = pprint(t, values, len); printf("%-30s%-20s%s\n", str, (short_name != NULL ? short_name + 1 : type_str), tb_get(values_tb)); } break; default: return tcl_error(interp, "cannot show tree kind %s", tree_kind_str(kind)); } } } return TCL_OK; }
static int VTableCreateOrConnect( sqlite3 *sqliteP, void *clientdata, int argc, const char *const *argv, sqlite3_vtab **vtabPP, char **errstrP, int create) { VTableDB *vtdbP = (VTableDB *)clientdata; VTableInfo *vtabP; int status; int i; Tcl_Obj *objv[4]; Tcl_Interp *interp = vtdbP->vticP->interp; /* * argv[0] - name of our module (i.e. PACKAGE_NAME) * argv[1] - name of database where the virtual table is being created * argv[2] - name of the table * argv[3..argc-1] - arguments passed to CREATE VIRTUAL TABLE. argv[3] * is the script to invoke, remaining are arguments passed * only to the create and connect methods. */ VTABLE_ASSERT(vtdbP->sqliteP == sqliteP); if (argc < 4) { *errstrP = sqlite3_mprintf("Insufficient number of arguments for virtual table"); return SQLITE_ERROR; } vtabP = VTableInfoNew(vtdbP, argv[2]); /* * argv[3] is the command prefix to be invoked for virtual * table operations. */ vtabP->cmdprefixP = Tcl_NewStringObj(argv[3], -1); Tcl_IncrRefCount(vtabP->cmdprefixP); if (Tcl_ListObjLength(interp, vtabP->cmdprefixP, &i) != TCL_OK) { *errstrP = sqlite3_mprintf("Command prefix '%s' does not have a valid list format.", argv[3]); VTableInfoDelete(vtabP); return SQLITE_ERROR; } objv[0] = vtdbP->dbcmd_objP; objv[1] = Tcl_NewStringObj(argv[1], -1); /* DB name */ objv[2] = Tcl_NewStringObj(argv[2], -1); /* virtual table name */ objv[3] = Tcl_NewListObj(0, NULL); for (i = 4; i < argc; ++i) { Tcl_ListObjAppendElement(interp, objv[3], Tcl_NewStringObj(argv[i],-1)); } if (VTableInvokeCmd(interp, vtabP, create ? "xCreate" : "xConnect", 4, objv) != TCL_OK) { *errstrP = sqlite3_mprintf("%s", Tcl_GetStringResult(interp)); VTableInfoDelete(vtabP); return SQLITE_ERROR; } /* Return value is DDL that we have to use to create the table */ status = sqlite3_declare_vtab(sqliteP, Tcl_GetStringResult(interp)); if (status != SQLITE_OK) { VTableDisconnectOrDestroy(vtabP, create); /* Will also delete vtabP */ return status; } *vtabPP = &vtabP->vtab; return SQLITE_OK; }
/** \brief Description yet to be added. **/ static int addChildren ( GtkNotebook *notebook, Tcl_Interp *interp, Tcl_Obj *children, int begin ) { int n, noChilds; if ( Tcl_ListObjLength ( interp, children, &noChilds ) != TCL_OK || noChilds < 1 ) { Tcl_SetResult ( interp, "widget-list must be proper list", TCL_STATIC ); return TCL_ERROR; } for ( n = 0; n < noChilds; ++n ) { Tcl_Obj *subList, *child, *label; Tcl_Obj *menu = NULL; int noMem; if ( Tcl_ListObjIndex ( interp, children, n, &subList ) != TCL_OK ) { return TCL_ERROR; } if ( Tcl_ListObjLength ( interp, subList, &noMem ) != TCL_OK || ( noMem != 2 && noMem != 3 ) ) { /* if it's not a list of lists, test, if it is a single list with content and bookmark */ if ( noMem == 1 && ( noChilds == 2 || noChilds == 3 ) ) { noMem = noChilds; noChilds = 1; subList = children; } else { Tcl_SetResult ( interp, "list must consists of two or three elements: " "\"widget\" \"bookmark\" \"menu\"", TCL_STATIC ); return TCL_ERROR; } } if ( Tcl_ListObjIndex ( interp, subList, 0, &child ) != TCL_OK ) { return TCL_ERROR; } if ( Tcl_ListObjIndex ( interp, subList, 1, &label ) != TCL_OK ) { return TCL_ERROR; } if ( noMem > 2 ) { if ( Tcl_ListObjIndex ( interp, subList, 2, &menu ) != TCL_OK ) { return TCL_ERROR; } } if ( addPage ( notebook, interp, child, label, menu, begin ) < 0 ) { return TCL_ERROR; } } return TCL_OK; }
static int configure( Tcl_Interp *interp, ComboParams *para, GnoclOption options[] ) { int setToFirst = 0; GtkTreeModel *model = gtk_combo_box_get_model( para->comboBox ); gnoclAttacheOptCmdAndVar( &options[onChangedIdx], ¶->onChanged, &options[variableIdx], ¶->variable, "changed", getSigObj( para->comboBox ), G_CALLBACK( changedFunc ), interp, traceFunc, para ); if( options[itemsIdx].status == GNOCL_STATUS_CHANGED ) { int k, no; Tcl_Obj *items = options[itemsIdx].val.obj; if( options[itemValueIdx].status == GNOCL_STATUS_CHANGED ) { Tcl_SetResult( interp, "Either -items or -itemValueList may be given, but not both.", TCL_STATIC ); return TCL_ERROR; } if( Tcl_ListObjLength( interp, items, &no ) != TCL_OK ) { Tcl_SetResult( interp, "items must be proper list", TCL_STATIC ); return TCL_ERROR; } clearModel( para->comboBox, model ); for( k = 0; k < no; ++k ) { Tcl_Obj *tp; if( Tcl_ListObjIndex( interp, items, k, &tp ) != TCL_OK ) return TCL_ERROR; addItem( model, Tcl_GetString( tp ), Tcl_GetString( tp ) ); } setToFirst = 1; } if( options[itemValueIdx].status == GNOCL_STATUS_CHANGED ) { int k, no; Tcl_Obj *items = options[itemValueIdx].val.obj; if( Tcl_ListObjLength( interp, items, &no ) != TCL_OK ) { Tcl_SetResult( interp, "itemValueList must be proper list", TCL_STATIC ); return TCL_ERROR; } clearModel( para->comboBox, model ); for( k = 0; k < no; ++k ) { Tcl_Obj *tp, *txt, *val; if( Tcl_ListObjIndex( interp, items, k, &tp ) != TCL_OK ) return TCL_ERROR; if( Tcl_ListObjIndex( interp, tp, 0, &txt ) != TCL_OK || Tcl_ListObjIndex( interp, tp, 1, &val ) != TCL_OK ) { return TCL_ERROR; } addItem( model, Tcl_GetString( val ) , Tcl_GetString( txt ) ); } setToFirst = 1; } if( options[valueIdx].status == GNOCL_STATUS_CHANGED ) { const char *val = Tcl_GetString( options[valueIdx].val.obj ); int n = setState( para, val ); if( n < 0 ) { Tcl_AppendResult( interp, "Invalid value for option \"-value\" \"", Tcl_GetString( options[valueIdx].val.obj ), "\"", NULL ); return TCL_ERROR; } setVariable( para, val ); setToFirst = 0; } else if( options[variableIdx].status == GNOCL_STATUS_CHANGED && para->variable != NULL ) { const char *val = Tcl_GetVar2( para->interp, para->variable, NULL, TCL_GLOBAL_ONLY ); if( val != NULL ) { setState( para, val ); setToFirst = 0; } else setToFirst = 1; } if( setToFirst ) { GtkTreeIter iter; if( gtk_tree_model_get_iter_first( model, &iter ) ) { const char *val; gtk_tree_model_get( model, &iter, VALUE_COLUMN, &val, -1 ); setState( para, val ); setVariable( para, val ); } } return TCL_OK; }
int add_functions_to_db_and_list(Tcl_Interp * interp, sasfit_plugin_api_t * plugin_api, Tcl_Obj * list, int func_count) { int i = 0, list_len = 0, new_id = 0, res = 0; const sasfit_plugin_func_t * plugin_func = 0; const sasfit_plugin_info_t * plugin_exp = 0; if ( ! interp || ! plugin_api || ! list ) return TCL_ERROR; // unload the plugin/library if no valid plugin api was supplied if ( ! sasfit_plugin_api_is_valid(plugin_api) ) { sasfit_err("Could not get a valid set of api functions!"); return TCL_ERROR; } // init the plugin res = plugin_api->do_init_func(&plugin_exp, &sasfit_common_stubs, &sasfit_plugin_search); if ( !res ) { sasfit_err("Could not initialize the plugin!"); return TCL_ERROR; } else if ( res == SASFIT_PLUGIN_DEP_ERR ) { res = Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(DEP_ERROR_MSG, sizeof(DEP_ERROR_MSG)-1)); ASSERT_APPEND_RESULT(res); return TCL_OK; // preserves the result list } else if ( !plugin_exp ) { sasfit_err("Could not initialize the plugin, nothing exported!"); return TCL_ERROR; } // add the plugin functions to the database for(i=0; i < plugin_exp->num ;i++) { plugin_func = &(plugin_exp->functions[i]); new_id = sasfit_plugin_db_add( plugin_func ); if ( new_id < 0 ) { sasfit_err("Could not add the %d. function!\n", i+1); return TCL_ERROR; } else { // add function basename and ID to tcl result res = Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(plugin_func->name, plugin_func->len)); ASSERT_APPEND_RESULT(res); res = Tcl_ListObjAppendElement(interp, list, Tcl_NewIntObj(new_id)); ASSERT_APPEND_RESULT(res); } } // check if we got the declared number of functions // (determined from header file by tcl code) if ( Tcl_ListObjLength(interp, list, &list_len) != TCL_OK || (list_len/2) != func_count ) { sasfit_err("Number of functions in plugin (%d) " "don't match those in header file (%d)!\n",(list_len/2), func_count); return TCL_ERROR; } return TCL_OK; }
int TclFileAttrsCmd( ClientData clientData, /* Unused */ Tcl_Interp *interp, /* The interpreter for error reporting. */ int objc, /* Number of command line arguments. */ Tcl_Obj *const objv[]) /* The command line objects. */ { int result; const char *const *attributeStrings; const char **attributeStringsAllocated = NULL; Tcl_Obj *objStrings = NULL; int numObjStrings = -1; Tcl_Obj *filePtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "name ?-option value ...?"); return TCL_ERROR; } filePtr = objv[1]; if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) { return TCL_ERROR; } objc -= 2; objv += 2; result = TCL_ERROR; Tcl_SetErrno(0); /* * Get the set of attribute names from the filesystem. */ attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings); if (attributeStrings == NULL) { int index; Tcl_Obj *objPtr; if (objStrings == NULL) { if (Tcl_GetErrno() != 0) { /* * There was an error, probably that the filePtr is not * accepted by any filesystem */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": %s", TclGetString(filePtr), Tcl_PosixError(interp))); } return TCL_ERROR; } /* * We own the object now. */ Tcl_IncrRefCount(objStrings); /* * Use objStrings as a list object. */ if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) { goto end; } attributeStringsAllocated = (const char **) TclStackAlloc(interp, (1+numObjStrings) * sizeof(char *)); for (index = 0; index < numObjStrings; index++) { Tcl_ListObjIndex(interp, objStrings, index, &objPtr); attributeStringsAllocated[index] = TclGetString(objPtr); } attributeStringsAllocated[index] = NULL; attributeStrings = attributeStringsAllocated; } else if (objStrings != NULL) { Tcl_Panic("must not update objPtrRef's variable and return non-NULL"); } /* * Process the attributes to produce a list of all of them, the value of a * particular attribute, or to set one or more attributes (depending on * the number of arguments). */ if (objc == 0) { /* * Get all attributes. */ int index, res = TCL_OK, nbAtts = 0; Tcl_Obj *listPtr; listPtr = Tcl_NewListObj(0, NULL); for (index = 0; attributeStrings[index] != NULL; index++) { Tcl_Obj *objPtrAttr; if (res != TCL_OK) { /* * Clear the error from the last iteration. */ Tcl_ResetResult(interp); } res = Tcl_FSFileAttrsGet(interp, index, filePtr, &objPtrAttr); if (res == TCL_OK) { Tcl_Obj *objPtr = Tcl_NewStringObj(attributeStrings[index], -1); Tcl_ListObjAppendElement(interp, listPtr, objPtr); Tcl_ListObjAppendElement(interp, listPtr, objPtrAttr); nbAtts++; } } if (index > 0 && nbAtts == 0) { /* * Error: no valid attributes found. */ Tcl_DecrRefCount(listPtr); goto end; } Tcl_SetObjResult(interp, listPtr); } else if (objc == 1) { /* * Get one attribute. */ int index; Tcl_Obj *objPtr = NULL; if (numObjStrings == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\", there are no file attributes in this" " filesystem", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL); goto end; } if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings, "option", INDEX_TEMP_TABLE, &index) != TCL_OK) { goto end; } if (Tcl_FSFileAttrsGet(interp, index, filePtr, &objPtr) != TCL_OK) { goto end; } Tcl_SetObjResult(interp, objPtr); } else { /* * Set option/value pairs. */ int i, index; if (numObjStrings == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\", there are no file attributes in this" " filesystem", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL); goto end; } for (i = 0; i < objc ; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings, "option", INDEX_TEMP_TABLE, &index) != TCL_OK) { goto end; } if (i + 1 == objc) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "value for \"%s\" missing", TclGetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR", "NOVALUE", NULL); goto end; } if (Tcl_FSFileAttrsSet(interp, index, filePtr, objv[i + 1]) != TCL_OK) { goto end; } } } result = TCL_OK; /* * Free up the array we allocated and drop our reference to any list of * attribute names issued by the filesystem. */ end: if (attributeStringsAllocated != NULL) { TclStackFree(interp, (void *) attributeStringsAllocated); } if (objStrings != NULL) { Tcl_DecrRefCount(objStrings); } return result; }
void * weechat_tcl_exec (struct t_plugin_script *script, int ret_type, const char *function, const char *format, void **argv) { int argc, i, llength; int *ret_i; char *ret_cv; void *ret_val; Tcl_Obj *cmdlist; Tcl_Interp *interp; struct t_plugin_script *old_tcl_script; old_tcl_script = tcl_current_script; tcl_current_script = script; interp = (Tcl_Interp*)script->interpreter; if (function && function[0]) { cmdlist = Tcl_NewListObj (0, NULL); Tcl_IncrRefCount (cmdlist); /* +1 */ Tcl_ListObjAppendElement (interp, cmdlist, Tcl_NewStringObj (function,-1)); } else { tcl_current_script = old_tcl_script; return NULL; } if (format && format[0]) { argc = strlen (format); for (i = 0; i < argc; i++) { switch (format[i]) { case 's': /* string */ Tcl_ListObjAppendElement (interp, cmdlist, Tcl_NewStringObj (argv[i], -1)); break; case 'i': /* integer */ Tcl_ListObjAppendElement (interp, cmdlist, Tcl_NewIntObj (*((int *)argv[i]))); break; case 'h': /* hash */ Tcl_ListObjAppendElement (interp, cmdlist, weechat_tcl_hashtable_to_dict (interp, argv[i])); break; } } } if (Tcl_ListObjLength (interp, cmdlist, &llength) != TCL_OK) llength = 0; if (Tcl_EvalObjEx (interp, cmdlist, TCL_EVAL_DIRECT) == TCL_OK) { Tcl_ListObjReplace (interp, cmdlist, 0, llength, 0, NULL); /* remove elements, decrement their ref count */ Tcl_DecrRefCount (cmdlist); /* -1 */ ret_val = NULL; if (ret_type == WEECHAT_SCRIPT_EXEC_STRING) { ret_cv = Tcl_GetStringFromObj (Tcl_GetObjResult (interp), &i); if (ret_cv) ret_val = (void *)strdup (ret_cv); else ret_val = NULL; } else if ( ret_type == WEECHAT_SCRIPT_EXEC_INT && Tcl_GetIntFromObj (interp, Tcl_GetObjResult (interp), &i) == TCL_OK) { ret_i = (int *)malloc (sizeof (*ret_i)); if (ret_i) *ret_i = i; ret_val = (void *)ret_i; } else if (ret_type == WEECHAT_SCRIPT_EXEC_HASHTABLE) { ret_val = weechat_tcl_dict_to_hashtable (interp, Tcl_GetObjResult (interp), WEECHAT_SCRIPT_HASHTABLE_DEFAULT_SIZE, WEECHAT_HASHTABLE_STRING, WEECHAT_HASHTABLE_STRING); } tcl_current_script = old_tcl_script; if (ret_val) return ret_val; weechat_printf (NULL, weechat_gettext ("%s%s: function \"%s\" must return a " "valid value"), weechat_prefix ("error"), TCL_PLUGIN_NAME, function); return NULL; } Tcl_ListObjReplace (interp, cmdlist, 0, llength, 0, NULL); /* remove elements, decrement their ref count */ Tcl_DecrRefCount (cmdlist); /* -1 */ weechat_printf (NULL, weechat_gettext ("%s%s: unable to run function \"%s\": %s"), weechat_prefix ("error"), TCL_PLUGIN_NAME, function, Tcl_GetStringFromObj (Tcl_GetObjResult (interp), &i)); tcl_current_script = old_tcl_script; return NULL; }
/************************************************************************* * FUNCTION : RPMTransaction_Set::ProbFlags * * ARGUMENTS : none * * RETURNS : TCL_OK or TCL_ERROR * * EXCEPTIONS : none * * PURPOSE : Set or get problem mask flags * *************************************************************************/ int RPMTransaction_Set::ProbFlags(Tcl_Interp *interp,int objc, Tcl_Obj *const objv[]) { if (objc >= 3) { // Build a list of indexes matching the packages given. Tcl_Obj *args = Tcl_NewListObj(objc-2,objv+2); if (!args) return Error("Cannot concat arglist!"); Tcl_IncrRefCount(args); // Iterate over list and build up the list unsigned mask = prob_flags; int count = 0; if (Tcl_ListObjLength(interp,args,&count) != TCL_OK) { parse_error: Tcl_DecrRefCount(args); return TCL_ERROR; } for (int i = 0; i < count; ++i) { Tcl_Obj *flag = 0; int which = 0; if (Tcl_ListObjIndex(interp,args,i,&flag) != TCL_OK) goto parse_error; if (Tcl_GetIndexFromObjStruct(interp,flag,(char **)&Prob_bits[0].msg,sizeof(Prob_bits[0]), "flag",0,&which ) != TCL_OK) goto parse_error; if (Prob_bits[which].bit == RPMPROB_FILTER_NONE ) mask = RPMPROB_FILTER_NONE; else mask |= Prob_bits[which].bit; } Tcl_DecrRefCount(args); prob_flags = mask; } // Now, build the return list Tcl_Obj *val = Tcl_NewObj(); Tcl_IncrRefCount(val); if (prob_flags == 0) { if (Tcl_ListObjAppendElement(interp,val,Tcl_NewStringObj(Prob_bits[0].msg,-1)) != TCL_OK) { out_err: Tcl_DecrRefCount(val); return TCL_ERROR; } } else if (prob_flags == (unsigned)(-1)) { if (Tcl_ListObjAppendElement(interp,val,Tcl_NewStringObj("all",-1)) != TCL_OK) { goto out_err; } } else { for (int i = 0; Prob_bits[i].msg; ++i) { if (Prob_bits[i].bit == (unsigned)(-1)) continue; if (prob_flags & Prob_bits[i].bit) { if (Tcl_ListObjAppendElement(interp,val,Tcl_NewStringObj(Prob_bits[i].msg,-1)) != TCL_OK) { Tcl_DecrRefCount(val); return TCL_ERROR; } } } } return OK(val); }
static int shell_cmd_show(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { const char *help = "show - Display simulation objects\n" "\n" "Usage: show LIST...\n" "\n" "Prints a representation of each simulation object in LIST. Typically\n" "this will be a list of signal names and the output will show their\n" "current value.\n" "\n" "Examples:\n" " show {:top:foo} Print value of signal :top_foo\n" " show [signals] Print value of all signals\n"; if (show_help(objc, objv, help)) return TCL_OK; if (objc == 1) { warnf("nothing to show (try -help for usage)"); return TCL_OK; } hash_t *decl_hash = (hash_t *)cd; for (int i = 1; i < objc; i++) { int length; if (Tcl_ListObjLength(interp, objv[i], &length) != TCL_OK) return TCL_ERROR; for (int j = 0; j < length; j++) { Tcl_Obj *obj; if (Tcl_ListObjIndex(interp, objv[i], j, &obj) != TCL_OK) return TCL_ERROR; const char *str = Tcl_GetString(obj); tree_t t = hash_get(decl_hash, ident_new(str)); if (t == NULL) return tcl_error(interp, "object not found: %s", str); tree_kind_t kind = tree_kind(t); switch (kind) { case T_SIGNAL_DECL: { size_t len = 1; type_t type = tree_type(t); while (type_is_array(type)) { int64_t low = 0, high = 0; range_bounds(type_dim(type, 0), &low, &high); len *= (high - low + 1); type = type_elem(type); } slave_read_signal_msg_t msg = { .index = tree_index(t), .len = len }; slave_post_msg(SLAVE_READ_SIGNAL, &msg, sizeof(msg)); const size_t rsz = sizeof(reply_read_signal_msg_t) + (msg.len * sizeof(uint64_t)); reply_read_signal_msg_t *reply = xmalloc(rsz); slave_get_reply(REPLY_READ_SIGNAL, reply, rsz); const char *type_str = type_pp(type); const char *short_name = strrchr(type_str, '.'); printf("%-30s%-20s%s\n", str, (short_name != NULL ? short_name + 1 : type_str), pprint(t, reply->values, msg.len)); free(reply); } break; default: return tcl_error(interp, "cannot show tree kind %s", tree_kind_str(kind)); } } } return TCL_OK; }
static int PrefixMatchObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int flags = 0, result, index; int dummyLength, i, errorLength; Tcl_Obj *errorPtr = NULL; const char *message = "option"; Tcl_Obj *tablePtr, *objPtr, *resultPtr; static const char *const matchOptions[] = { "-error", "-exact", "-message", NULL }; enum matchOptions { PRFMATCH_ERROR, PRFMATCH_EXACT, PRFMATCH_MESSAGE }; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? table string"); return TCL_ERROR; } for (i = 1; i < (objc - 2); i++) { if (Tcl_GetIndexFromObj(interp, objv[i], matchOptions, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum matchOptions) index) { case PRFMATCH_EXACT: flags |= TCL_EXACT; break; case PRFMATCH_MESSAGE: if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing value for -message", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } i++; message = Tcl_GetString(objv[i]); break; case PRFMATCH_ERROR: if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing value for -error", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } i++; result = Tcl_ListObjLength(interp, objv[i], &errorLength); if (result != TCL_OK) { return TCL_ERROR; } if ((errorLength % 2) != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "error options must have an even number of elements", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL); return TCL_ERROR; } errorPtr = objv[i]; break; } } tablePtr = objv[objc - 2]; objPtr = objv[objc - 1]; /* * Check that table is a valid list first, since we want to handle that * error case regardless of level. */ result = Tcl_ListObjLength(interp, tablePtr, &dummyLength); if (result != TCL_OK) { return result; } result = GetIndexFromObjList(interp, objPtr, tablePtr, message, flags, &index); if (result != TCL_OK) { if (errorPtr != NULL && errorLength == 0) { Tcl_ResetResult(interp); return TCL_OK; } else if (errorPtr == NULL) { return TCL_ERROR; } if (Tcl_IsShared(errorPtr)) { errorPtr = Tcl_DuplicateObj(errorPtr); } Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewStringObj("-code", 5)); Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewIntObj(result)); return Tcl_SetReturnOptions(interp, errorPtr); } result = Tcl_ListObjIndex(interp, tablePtr, index, &resultPtr); if (result != TCL_OK) { return result; } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; }
int compare_values(int type, Tcl_Obj *val1, Tcl_Obj *val2) { int len1, len2; int i; int str_eq; float a, b; Tcl_Obj *obj1, *obj2; str_eq = BU_STR_EQUAL(Tcl_GetStringFromObj(val1, NULL), Tcl_GetStringFromObj(val2, NULL)); if (str_eq || type == ATTRS) { return 0; } if (Tcl_ListObjLength(INTERP, val1, &len1) == TCL_ERROR) { fprintf(stderr, "Error getting length of TCL object!!!\n"); fprintf(stderr, "%s\n", Tcl_GetStringResult(INTERP)); bu_exit (1, NULL); } if (Tcl_ListObjLength(INTERP, val2, &len2) == TCL_ERROR) { fprintf(stderr, "Error getting length of TCL object!!!\n"); fprintf(stderr, "%s\n", Tcl_GetStringResult(INTERP)); bu_exit (1, NULL); } if (len1 != len2) { return 1; } for (i = 0; i<len1; i++) { char *str1; char *str2; if (Tcl_ListObjIndex(INTERP, val1, i, &obj1) == TCL_ERROR) { fprintf(stderr, "Error getting word #%d in TCL object!!! (%s)\n", i, Tcl_GetStringFromObj(val1, NULL)); fprintf(stderr, "%s\n", Tcl_GetStringResult(INTERP)); bu_exit (1, NULL); } if (Tcl_ListObjIndex(INTERP, val2, i, &obj2) == TCL_ERROR) { fprintf(stderr, "Error getting word #%d in TCL object!!! (%s)\n", i, Tcl_GetStringFromObj(val2, NULL)); fprintf(stderr, "%s\n", Tcl_GetStringResult(INTERP)); bu_exit (1, NULL); } str1 = Tcl_GetString(obj1); str2 = Tcl_GetString(obj2); if (use_floats && (isNumber(str1) && isNumber(str2))) { a = atof(str1); b = atof(str2); if (!ZERO(a - b)) { return 1; } } else { if (!BU_STR_EQUAL(str1, str2)) { return strstr(str2, str1)?2:1; } } } return 0; }
/* * The stops are a list of stop lists where each stop list is: * {offset color ?opacity?} */ static int StopsSet( ClientData clientData, Tcl_Interp *interp, /* Current interp; may be used for errors. */ Tk_Window tkwin, /* Window for which option is being set. */ Tcl_Obj **value, /* Pointer to the pointer to the value object. * We use a pointer to the pointer because * we may need to return a value (NULL). */ char *recordPtr, /* Pointer to storage for the widget record. */ int internalOffset, /* Offset within *recordPtr at which the internal value is to be stored. */ char *oldInternalPtr, /* Pointer to storage for the old value. */ int flags) /* Flags for the option, set Tk_SetOptions. */ { char *internalPtr; int i, nstops, stopLen; int objEmpty = 0; Tcl_Obj *valuePtr; double offset, lastOffset, opacity; Tcl_Obj **objv; Tcl_Obj *stopObj; Tcl_Obj *obj; XColor *color; GradientStopArray *newrc = NULL; valuePtr = *value; internalPtr = ComputeSlotAddress(recordPtr, internalOffset); objEmpty = ObjectIsEmpty(valuePtr); if ((flags & TK_OPTION_NULL_OK) && objEmpty) { valuePtr = NULL; } else { /* Deal with each stop list in turn. */ if (Tcl_ListObjGetElements(interp, valuePtr, &nstops, &objv) != TCL_OK) { return TCL_ERROR; } newrc = NewGradientStopArray(nstops); lastOffset = 0.0; for (i = 0; i < nstops; i++) { stopObj = objv[i]; if (Tcl_ListObjLength(interp, stopObj, &stopLen) != TCL_OK) { goto error; } if ((stopLen == 2) || (stopLen == 3)) { Tcl_ListObjIndex(interp, stopObj, 0, &obj); if (Tcl_GetDoubleFromObj(interp, obj, &offset) != TCL_OK) { goto error; } if ((offset < 0.0) || (offset > 1.0)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "stop offsets must be in the range 0.0 to 1.0", -1)); goto error; } if (offset < lastOffset) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "stop offsets must be ordered", -1)); goto error; } Tcl_ListObjIndex(interp, stopObj, 1, &obj); color = Tk_AllocColorFromObj(interp, Tk_MainWindow(interp), obj); if (color == NULL) { Tcl_AppendResult(interp, "color \"", Tcl_GetStringFromObj(obj, NULL), "\" doesn't exist", NULL); goto error; } if (stopLen == 3) { Tcl_ListObjIndex(interp, stopObj, 2, &obj); if (Tcl_GetDoubleFromObj(interp, obj, &opacity) != TCL_OK) { goto error; } } else { opacity = 1.0; } /* Make new stop. */ newrc->stops[i] = NewGradientStop(offset, color, opacity); lastOffset = offset; } else { Tcl_SetObjResult(interp, Tcl_NewStringObj( "stop list not {offset color ?opacity?}", -1)); goto error; } } } if (internalPtr != NULL) { *((GradientStopArray **) oldInternalPtr) = *((GradientStopArray **) internalPtr); *((GradientStopArray **) internalPtr) = newrc; } return TCL_OK; error: if (newrc != NULL) { FreeStopArray(newrc); } return TCL_ERROR; }
int do_compare(int type, struct bu_vls *vls, Tcl_Obj *obj1, Tcl_Obj *obj2, char *obj_name) { Tcl_Obj *key1, *val1, *key2, *val2; int len1, len2, found, junk; int i, j; int start_index; int found_diffs = 0; int ev = 0; if (Tcl_ListObjLength(INTERP, obj1, &len1) == TCL_ERROR) { fprintf(stderr, "Error getting length of TCL object!!!\n"); fprintf(stderr, "%s\n", Tcl_GetStringResult(INTERP)); bu_exit (1, NULL); } if (Tcl_ListObjLength(INTERP, obj2, &len2) == TCL_ERROR) { fprintf(stderr, "Error getting length of TCL object!!!\n"); fprintf(stderr, "%s\n", Tcl_GetStringResult(INTERP)); bu_exit (1, NULL); } if (!len1 && !len2) return 0; if (type == ATTRS) { start_index = 0; } else { start_index = 1; } /* check for changed values from object 1 to object2 */ for (i=start_index; i<len1; i+=2) { if (Tcl_ListObjIndex(INTERP, obj1, i, &key1) == TCL_ERROR) { fprintf(stderr, "Error getting word #%d in TCL object!!! (%s)\n", i, Tcl_GetStringFromObj(obj1, &junk)); fprintf(stderr, "%s\n", Tcl_GetStringResult(INTERP)); bu_exit (1, NULL); } if (Tcl_ListObjIndex(INTERP, obj1, i+1, &val1) == TCL_ERROR) { fprintf(stderr, "Error getting word #%d in TCL object!!! (%s)\n", i+1, Tcl_GetStringFromObj(obj1, &junk)); fprintf(stderr, "%s\n", Tcl_GetStringResult(INTERP)); bu_exit (1, NULL); } found = 0; for (j=start_index; j<len2; j += 2) { if (Tcl_ListObjIndex(INTERP, obj2, j, &key2) == TCL_ERROR) { fprintf(stderr, "Error getting word #%d in TCL object!!! (%s)\n", j, Tcl_GetStringFromObj(obj2, &junk)); fprintf(stderr, "%s\n", Tcl_GetStringResult(INTERP)); bu_exit (1, NULL); } if (BU_STR_EQUAL(Tcl_GetStringFromObj(key1, &junk), Tcl_GetStringFromObj(key2, &junk))) { found = 1; if (Tcl_ListObjIndex(INTERP, obj2, j+1, &val2) == TCL_ERROR) { fprintf(stderr, "Error getting word #%d in TCL object!!! (%s)\n", j+1, Tcl_GetStringFromObj(obj2, &junk)); fprintf(stderr, "%s\n", Tcl_GetStringResult(INTERP)); bu_exit (1, NULL); } /* check if this value has changed */ ev = compare_values(type, val1, val2); if (ev) { if (!found_diffs++) { if (mode == HUMAN) { printf("%s has changed:\n", obj_name); } } if (mode == HUMAN) { if (type == PARAMS) { printf("\tparameter %s has changed from:\n\t\t%s\n\tto:\n\t\t%s\n", Tcl_GetStringFromObj(key1, &junk), Tcl_GetStringFromObj(val1, &junk), Tcl_GetStringFromObj(val2, &junk)); } else { printf("\t%s attribute \"%s\" has changed from:\n\t\t%s\n\tto:\n\t\t%s\n", obj_name, Tcl_GetStringFromObj(key1, &junk), Tcl_GetStringFromObj(val1, &junk), Tcl_GetStringFromObj(val2, &junk)); } } else { int val_len; if (type == ATTRS) { bu_vls_printf(vls, "attr set %s ", obj_name); } else { bu_vls_strcat(vls, " "); } bu_vls_strcat(vls, Tcl_GetStringFromObj(key1, &junk)); bu_vls_strcat(vls, " "); if (Tcl_ListObjLength(INTERP, val2, &val_len) == TCL_ERROR) { fprintf(stderr, "Error getting length of TCL object!!\n"); fprintf(stderr, "%s\n", Tcl_GetStringResult(INTERP)); bu_exit(1, NULL); } if (val_len > 1) bu_vls_putc(vls, '{'); bu_vls_strcat(vls, Tcl_GetStringFromObj(val2, &junk)); if (val_len > 1) bu_vls_putc(vls, '}'); if (type == ATTRS) { bu_vls_putc(vls, '\n'); } } } break; } } if (!found) { /* this keyword value pair has been eliminated */ if (!found_diffs++) { if (mode == HUMAN) { printf("%s has changed:\n", obj_name); } } if (mode == HUMAN) { if (type == PARAMS) { printf("\tparameter %s has been eliminated\n", Tcl_GetStringFromObj(key1, &junk)); } else { printf("\tattribute \"%s\" has been eliminated from %s\n", Tcl_GetStringFromObj(key1, &junk), obj_name); } } else { if (type == ATTRS) { bu_vls_printf(vls, "attr rm %s %s\n", obj_name, Tcl_GetStringFromObj(key1, &junk)); } else { bu_vls_strcat(vls, " "); bu_vls_strcat(vls, Tcl_GetStringFromObj(key1, &junk)); bu_vls_strcat(vls, " none"); } } } } /* check for keyword value pairs in object 2 that don't appear in object 1 */ for (i=start_index; i<len2; i+= 2) { /* get keyword/value pairs from object 2 */ if (Tcl_ListObjIndex(INTERP, obj2, i, &key2) == TCL_ERROR) { fprintf(stderr, "Error getting word #%d in TCL object!!! (%s)\n", i, Tcl_GetStringFromObj(obj2, &junk)); fprintf(stderr, "%s\n", Tcl_GetStringResult(INTERP)); bu_exit (1, NULL); } if (Tcl_ListObjIndex(INTERP, obj2, i+1, &val2) == TCL_ERROR) { fprintf(stderr, "Error getting word #%d in TCL object!!! (%s)\n", i+1, Tcl_GetStringFromObj(obj2, &junk)); fprintf(stderr, "%s\n", Tcl_GetStringResult(INTERP)); bu_exit (1, NULL); } found = 0; /* look for this keyword in object 1 */ for (j=start_index; j<len1; j += 2) { if (Tcl_ListObjIndex(INTERP, obj1, j, &key1) == TCL_ERROR) { fprintf(stderr, "Error getting word #%d in TCL object!!! (%s)\n", i, Tcl_GetStringFromObj(obj1, &junk)); fprintf(stderr, "%s\n", Tcl_GetStringResult(INTERP)); bu_exit (1, NULL); } if (BU_STR_EQUAL(Tcl_GetStringFromObj(key1, &junk), Tcl_GetStringFromObj(key2, &junk))) { found = 1; break; } } if (found) continue; /* This keyword/value pair in object 2 is not in object 1 */ if (!found_diffs++) { if (mode == HUMAN) { printf("%s has changed:\n", obj_name); } } if (mode == HUMAN) { if (type == PARAMS) { printf("\t%s has new parameter \"%s\" with value %s\n", obj_name, Tcl_GetStringFromObj(key2, &junk), Tcl_GetStringFromObj(val2, &junk)); } else { printf("\t%s has new attribute \"%s\" with value {%s}\n", obj_name, Tcl_GetStringFromObj(key2, &junk), Tcl_GetStringFromObj(val2, &junk)); } } else { int val_len; if (type == ATTRS) { bu_vls_printf(vls, "attr set %s ", obj_name); } else { bu_vls_strcat(vls, " "); } bu_vls_strcat(vls, Tcl_GetStringFromObj(key2, &junk)); bu_vls_strcat(vls, " "); if (Tcl_ListObjLength(INTERP, val2, &val_len) == TCL_ERROR) { fprintf(stderr, "Error getting length of TCL object!!\n"); fprintf(stderr, "%s\n", Tcl_GetStringResult(INTERP)); bu_exit(1, NULL); } if (val_len > 1) bu_vls_putc(vls, '{'); bu_vls_strcat(vls, Tcl_GetStringFromObj(val2, &junk)); if (val_len > 1) bu_vls_putc(vls, '}'); if (type == ATTRS) bu_vls_putc(vls, '\n'); } } if (evolutionary && found_diffs) bu_vls_strcat(vls, ev == 2 ? " (Evolutionary)" : " (Reworked)"); return found_diffs; }
/************************************************************************* * FUNCTION : RPMTransaction_Set::Install_or_remove * * ARGUMENTS : RPM headers to add * * RETURNS : TCL_OK or TCL_ERROR * * EXCEPTIONS : none * * PURPOSE : Add an RPM to an install set * *************************************************************************/ int RPMTransaction_Set::Install_or_remove(Tcl_Obj *name,Install_mode mode) { // Is this a list? if so, recurse through it Tcl_ObjType *listtype = Tcl_GetObjType("list"); if (name->typePtr == listtype) { // OK, go recursive on this int count = 0; if (Tcl_ListObjLength(_interp,name,&count) != TCL_OK) return TCL_ERROR; for (int i = 0; i < count; ++i) { Tcl_Obj *element = 0; if (Tcl_ListObjIndex(_interp,name,i,&element) != TCL_OK) { return TCL_ERROR; } if (Install_or_remove(element,mode) != TCL_OK) return TCL_ERROR; } return TCL_OK; } // OK, so not a list. Try to make it into an RPM header if (Tcl_ConvertToType(_interp,name,&RPMHeader_Obj::mytype) != TCL_OK) return TCL_ERROR; RPMHeader_Obj *header = ( RPMHeader_Obj *)(name->internalRep.otherValuePtr); \ // Unfortunately, the transaction set API does not give us a way to know when // it has freed a fnpyKey key object. In order to clean these up, we will create // a TCL list object of all headers we use for this purpose, and clean it as needed. Tcl_Obj *hdr_copy = header->Get_obj(); Tcl_IncrRefCount(hdr_copy); int error = 0; switch (mode) { case INSTALL: error = rpmtsAddInstallElement(transaction,*header,header,0,0); break; case UPGRADE: error = rpmtsAddInstallElement(transaction,*header,header,1,0); break; case REMOVE: error = rpmtsAddEraseElement(transaction,*header,header->DB_entry()); break; } switch (error) { case 0: // Record that we have created an entry on the list header_list = Grow_list(header_list,hdr_copy); return TCL_OK; case 1: header->Dec_refcount(); return Error("Error adding %s: %s\n",Tcl_GetStringFromObj(name,0),rpmErrorString()); case 2: header->Dec_refcount(); return Error("Error adding %s: needs capabilities %s\n",Tcl_GetStringFromObj(name,0),rpmErrorString()); default: header->Dec_refcount(); return Error("Unknown RPMlib error %d adding %s: needs capabilities %s\n",error,Tcl_GetStringFromObj(name,0),rpmErrorString()); } return TCL_OK; }
int class_browser_insert(ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ Tcl_Obj *objv[]) /* Argument strings. */ { Tcl_CmdInfo infoPtr; char *textwid; register void*textPtr = NULL; char image [64]; char *protected_font, *public_font, *private_font, font[512]; int del; Tcl_CmdProc *text_wdgcmd; char *linebuf; int linebuf_pos, linebuf_size = 1024; char *data; int data_pos, data_size = 1024; int len; char *tag_name; char *imageptr; unsigned int attr; Tcl_Obj *objlist, *next; int objlistc, oi; int wargc; char *wargv[12]; int fld_cou; int j, fnd1, fnd2; char **flds; char *p, * base_classes_of, * sub_classes_of, * viewed_classes; char *browsed_class; int overridden; unsigned int filter, filter1; int flags_and; char **prev_flds=NULL, **actu_flds=NULL, **next_flds=NULL; if (argc < 13 || argc > 14) { Tcl_AppendResult(interp, "wrong # args: should be ", Tcl_GetString(objv[0]), " ?-delete? textwidget list base_class_tree" " sub_class_tree viewed_classes" " overridden filter " " protected_font private_font, public_font" " browsed_class, and/or" , NULL); return TCL_ERROR; } if (Tcl_GetString(objv[1])[0] == '-') { del = TRUE; argc--; objv++; } else del = FALSE; textwid = Tcl_GetString(objv[1]); /* tree pathname */ objlist = objv[2]; /* list of entries */ base_classes_of = Tcl_GetString(objv[3]); /* base classes filter */ sub_classes_of = Tcl_GetString(objv[4]); /* sub classes filter */ viewed_classes = Tcl_GetString(objv[5]); /* list of viewed classes */ overridden = atoi (Tcl_GetString(objv[6])); /* overridden flag */ filter = atoi (Tcl_GetString(objv[7])); /* member filter */ filter1 = filter&(~(PAF_OVERRIDE|PAF_OVERLOADED)); /* flags without group flags */ public_font = Tcl_GetString(objv[8]); /* font for public members */ protected_font = Tcl_GetString(objv[9]); /* font for protected members */ private_font = Tcl_GetString(objv[10]); /* font for private members */ browsed_class = Tcl_GetString(objv[11]); /* browsed class in the browser */ flags_and = atoi(Tcl_GetString(objv[12])); /* Flag if all flags must be seted */ if (!Tcl_GetCommandInfo(interp, textwid, &infoPtr)) { Tcl_AppendResult(interp, "unknown widget \"", textwid,"\"",NULL); return TCL_ERROR; } textPtr = (void*)infoPtr.clientData; text_wdgcmd = (Tcl_CmdProc *)infoPtr.proc; /* set widget state as normal */ wargc = 0; wargv[wargc++] = textwid; wargv[wargc++] = "configure"; wargv[wargc++] = "-state"; wargv[wargc++] = "normal"; (*text_wdgcmd)((ClientData)textPtr,interp,wargc,wargv); /* delete old items */ if (del) { wargc = 0; wargv[wargc++] = textwid; wargv[wargc++] = "delete"; wargv[wargc++] = "0"; wargv[wargc++] = "end"; (*text_wdgcmd)((ClientData)textPtr,interp,wargc,wargv); } if (Tcl_ListObjLength(interp, objlist, &objlistc) != TCL_OK) { return TCL_ERROR; } if (objlistc == 0) { return TCL_OK; } /* using of dynamic buffers */ linebuf = ckalloc (linebuf_size); data = ckalloc (data_size); /* options for inserting items */ wargc = 0; wargv[wargc++] = textwid; wargv[wargc++] = "insert"; wargv[wargc++] = "end"; wargv[wargc++] = "-image"; wargv[wargc++] = image; wargv[wargc++] = "-font"; wargv[wargc++] = font; wargv[wargc++] = "-data"; wargv[wargc ] = data; data_pos = wargc++; wargv[wargc++] = "-text"; wargv[wargc ] = linebuf; linebuf_pos = wargc++; for (j=0, oi=0; oi<=objlistc; j++, oi++) { /* line scanning is complicated, because at least two lines are * to be stored to compare for overloaded and overridden flags */ if (oi == objlistc) { if (j > 1) { if (prev_flds) { ckfree ((char *) prev_flds); } prev_flds = actu_flds; actu_flds = next_flds; next_flds = NULL; } if (actu_flds == NULL) { break; } } else { if (Tcl_ListObjIndex (interp, objlist, oi, &next) != TCL_OK) { continue; } if (Tcl_SplitList(interp, Tcl_GetString(next), &fld_cou, &flds) != TCL_OK) { continue; } if (fld_cou < LIST_CNT) { ckfree((char *)flds); continue; } if (actu_flds == NULL) { actu_flds = flds; continue; } if (next_flds == NULL) { next_flds = flds; } else { if (prev_flds) { ckfree ((char *) prev_flds); } prev_flds = actu_flds; actu_flds = next_flds; next_flds = flds; } } if (Tcl_GetInt(interp, actu_flds[ATTR_POS],(int *)&attr) != TCL_OK) { continue; } /* verify if the class is selected */ p = Tcl_GetVar2 (interp, viewed_classes, CLASS(actu_flds[CLASS_POS]), TCL_LIST_ELEMENT); if (p != NULL && atoi (p) == 0) /* class not selected */ { continue; } /* if filter enabled, view only selected member types */ if (filter1) { if (flags_and) { if ((filter1&attr)!=filter1) { continue; } } else { int cnt = 0; if ((filter1&PAF_STATIC )!=0 && (attr&PAF_STATIC )!=0) cnt++; if ((filter1&PAF_STRUCT_DEF)!=0 && (attr&PAF_STRUCT_DEF)!=0) cnt++; if ((filter1&PAF_INLINE )!=0 && (attr&PAF_INLINE )!=0) cnt++; if ((filter1&PAF_VIRTUAL )!=0 && (attr&PAF_VIRTUAL )!=0) cnt++; if ((filter1&PAF_PUREVIRTUAL)==PAF_PUREVIRTUAL && (attr&PAF_PUREVIRTUAL)==PAF_PUREVIRTUAL) cnt ++; if (cnt == 0) { continue; } } } /* verif if overloaded flag is enabled */ if (filter & PAF_OVERLOADED) { if ((prev_flds && strcmp (actu_flds[MEMBER_POS], prev_flds[MEMBER_POS]) == 0) || (next_flds && strcmp (actu_flds[MEMBER_POS], next_flds[MEMBER_POS]) == 0)) { } else { continue; } } /* we need this to build correct image name */ strcpy (image, "cls_br_"); imageptr = image+7; if (attr & PAF_PROTECTED) { *imageptr++ = 'p'; } if (attr & PAF_STATIC) { *imageptr++ = 's'; } if (attr & PAF_VIRTUAL) { *imageptr++ = 'v'; } /* verify if the member overides a member on the base method * or is being overridden by a sub class */ fnd1 = fnd2 = 0; /* override flag */ if (next_flds && strcmp (next_flds[MEMBER_POS], actu_flds[MEMBER_POS]) == 0 && strcmp (CLASS(next_flds[CLASS_POS]), CLASS(actu_flds[CLASS_POS])) != 0 && /* different classes */ strcmp (next_flds[PARAM_POS ], actu_flds[PARAM_POS ]) == 0) { *imageptr++ = OVERRIDE; fnd1 = 0; } /* overridden flag */ if (prev_flds && strcmp (prev_flds[MEMBER_POS], actu_flds[MEMBER_POS]) == 0 && strcmp (CLASS(prev_flds[CLASS_POS]), CLASS(actu_flds[CLASS_POS])) != 0 && /* different classes */ strcmp (prev_flds[PARAM_POS ], actu_flds[PARAM_POS ]) == 0) { *imageptr++ = OVERRIDDEN; fnd2 = 1; } /* if we don't view the overridden members * or when we view only override/overridden members */ if ((fnd2 && overridden == 0) || ((filter & PAF_OVERRIDE) && fnd1 == 0 && fnd2 == 0)) { continue; } /* A private member uses a special empty image */ if (attr & PAF_PRIVATE) { char * pstr = "private"; strcpy (imageptr, pstr); imageptr += strlen(pstr); } /* finish image name */ strcpy (imageptr, "_image"); /* make text */ tag_name= strchr(actu_flds[MEMBER_POS],'('); /* function */ if (tag_name && (strncmp(tag_name + 1,"md",2) == 0 || strncmp(tag_name + 1,"fr",2) == 0)) { if (tag_name[1] == 'f') /* Friend use the private tag. */ { attr &= ~(PAF_PUBLIC|PAF_PROTECTED); } /* using dynamic buffers */ len = strlen (actu_flds[MEMBER_POS]) + strlen (actu_flds[CLASS_POS]) + strlen (actu_flds[TYPE_POS]) + strlen (actu_flds[PARAM_POS]) + 6; if (len > linebuf_size) { linebuf_size += len; linebuf = ckrealloc (linebuf, linebuf_size); wargv[linebuf_pos] = linebuf; } sprintf(linebuf,"%s\t%s\t%s\t(%s)", actu_flds[MEMBER_POS], actu_flds[CLASS_POS], actu_flds[TYPE_POS], actu_flds[PARAM_POS]); } /* variable */ else { /* using dynamic buffers */ len = strlen (actu_flds[MEMBER_POS]) + strlen (actu_flds[CLASS_POS]) + strlen (actu_flds[TYPE_POS]) + 3; if (len > linebuf_size) { linebuf_size += len; linebuf = ckrealloc (linebuf, linebuf_size); wargv[linebuf_pos] = linebuf; } sprintf(linebuf,"%s\t%s\t%s", actu_flds[MEMBER_POS], actu_flds[CLASS_POS], actu_flds[TYPE_POS]); } /* using dynamic buffers */ len = strlen (actu_flds[FILENAME_POS]) + strlen (actu_flds[FILEPOS_POS]) + 2; if (len > data_size) { data_size += len; data = ckrealloc (data, data_size); wargv[data_pos] = data; } /* Add file name and position in the data section */ sprintf (data, "%s\t%s", actu_flds[FILENAME_POS], actu_flds[FILEPOS_POS]); if (attr & PAF_PUBLIC) strcpy (font, public_font); else if (attr & PAF_PROTECTED) strcpy (font, protected_font); else if (attr & PAF_PRIVATE) strcpy (font, private_font); /* * Add line to browser list */ (*text_wdgcmd)((ClientData)textPtr,interp,wargc,wargv); /* Insert ! */ } /* free dynamic buffers */ ckfree ((void*)linebuf); ckfree ((void*)data); if (prev_flds) ckfree ((void*)prev_flds); if (actu_flds) ckfree ((void*)actu_flds); if (next_flds) ckfree ((void*)next_flds); return TCL_OK; }
/************************************************************************* * FUNCTION : RPMTransaction_Set::Show * * ARGUMENTS : Object to look for * * RETURNS : List of packages found * * EXCEPTIONS : none * * PURPOSE : Show the contents of a transaction set * *************************************************************************/ Tcl_Obj *RPMTransaction_Set::Show(Tcl_Obj *item) { Tcl_Obj *sub_obj = Tcl_NewObj(); Tcl_IncrRefCount(sub_obj); // Is this a list? if (item && item->typePtr == listtype) { // OK, go recursive on this int count = 0; if (Tcl_ListObjLength(_interp,item,&count) != TCL_OK) return sub_obj; for (int i = 0; i < count; ++i) { Tcl_Obj *element = 0; if (Tcl_ListObjIndex(_interp,item,i,&element) != TCL_OK) { return sub_obj; } Tcl_ListObjAppendElement(_interp,sub_obj,Show(element)); } return sub_obj; } // OK, not a list. were we given ANYTHING? if not, get everything. void *name = 0; if (item) { if (item->typePtr == &RPMHeader_Obj::mytype) { RPMHeader_Obj *header = ( RPMHeader_Obj *)(item->internalRep.otherValuePtr); int size = 0; int type = 0; if (!header->GetEntry(RPMTAG_NAME,type,name,size)) return sub_obj; } else // Not a header, interp as a string { name = (void *)Tcl_GetStringFromObj(item,0); } } rpmtsi matches = rpmtsiInit(transaction); if (!matches) return sub_obj; // OK, go over the list and create a list of items to return for(;;) { rpmte te = rpmtsiNext(matches,(rpmElementType)0); if (!te) break; Tcl_Obj *results[2]; switch (rpmteType(te)) { case TR_ADDED: { RPMHeader_Obj *hdr = (RPMHeader_Obj *)rpmteKey(te); results[0] = Tcl_NewStringObj("add",-1); results[1] = hdr->Get_obj();; } break; case TR_REMOVED: { results[0] = Tcl_NewStringObj("remove",-1); results[1] = Tcl_NewStringObj(rpmteN(te),-1); } break; } Tcl_Obj *list = Tcl_NewListObj(2,results); Tcl_IncrRefCount(list); Tcl_ListObjAppendElement(_interp,sub_obj,list); } rpmtsiFree(matches); return sub_obj; }