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