enum MqErrorE NS(ProcError) (
struct TclContextS * const tclctx,
MQ_CST proc
)
{
SETUP_interp
enum MqErrorE ret = MQ_OK;
Tcl_Obj *item;
Tcl_Obj *errorCode = Tcl_GetVar2Ex (interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
if (
Tcl_ListObjIndex (NULL, errorCode, 0, &item) == TCL_ERROR || // index "0" is not in the list "code"
strncmp (Tcl_GetString (item), "TCLMSGQUE", 9) // error is not from "TCLMSGQUE"
) {
// tcl error
ret = MqErrorC (MQCTX,proc,-1,Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY));
} else {
// tclmsgque error
int errnum = -1;
int errcode = -1;
Tcl_ListObjIndex (NULL, errorCode, 1, &item);
Tcl_GetIntFromObj(NULL, item, &errnum);
Tcl_ListObjIndex (NULL, errorCode, 2, &item);
Tcl_GetIntFromObj(NULL, item, &errcode);
Tcl_ListObjIndex (NULL, errorCode, 3, &item);
ret = MqErrorSet (MQCTX, errnum, (enum MqErrorE) errcode, Tcl_GetString(item), NULL);
}
Tcl_ResetResult(interp);
return ret;
}
static int tclvarColumn(sqlite3_vtab_cursor *cur, sqlite3_context *ctx, int i){
Tcl_Obj *p1;
Tcl_Obj *p2;
const char *z1;
const char *z2 = "";
tclvar_cursor *pCur = (tclvar_cursor*)cur;
Tcl_Interp *interp = ((tclvar_vtab *)cur->pVtab)->interp;
Tcl_ListObjIndex(interp, pCur->pList1, pCur->i1, &p1);
Tcl_ListObjIndex(interp, pCur->pList2, pCur->i2, &p2);
z1 = Tcl_GetString(p1);
if( p2 ){
z2 = Tcl_GetString(p2);
}
switch (i) {
case 0: {
sqlite3_result_text(ctx, z1, -1, SQLITE_TRANSIENT);
break;
}
case 1: {
sqlite3_result_text(ctx, z2, -1, SQLITE_TRANSIENT);
break;
}
case 2: {
Tcl_Obj *pVal = Tcl_GetVar2Ex(interp, z1, *z2?z2:0, TCL_GLOBAL_ONLY);
sqlite3_result_text(ctx, Tcl_GetString(pVal), -1, SQLITE_TRANSIENT);
break;
}
}
return SQLITE_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 );
}
HRESULT
ComObject::hresultFromErrorCode () const
{
#if TCL_MINOR_VERSION >= 1
Tcl_Obj *pErrorCode =
Tcl_GetVar2Ex(m_interp, "::errorCode", 0, TCL_LEAVE_ERR_MSG);
#else
TclObject errorCodeVarName("::errorCode");
Tcl_Obj *pErrorCode =
Tcl_ObjGetVar2(m_interp, errorCodeVarName, 0, TCL_LEAVE_ERR_MSG);
#endif
if (pErrorCode == 0) {
return E_UNEXPECTED;
}
Tcl_Obj *pErrorClass;
if (Tcl_ListObjIndex(m_interp, pErrorCode, 0, &pErrorClass) != TCL_OK) {
return E_UNEXPECTED;
}
if (strcmp(Tcl_GetStringFromObj(pErrorClass, 0), "COM") != 0) {
return E_UNEXPECTED;
}
Tcl_Obj *pHresult;
if (Tcl_ListObjIndex(m_interp, pErrorCode, 1, &pHresult) != TCL_OK) {
return E_UNEXPECTED;
}
HRESULT hr;
if (Tcl_GetLongFromObj(m_interp, pHresult, &hr) != TCL_OK) {
return E_UNEXPECTED;
}
return hr;
}
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
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;
}
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 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;
}
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;
}
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;
}
static Tcl_Obj *
FileBasename(
Tcl_Interp *interp, /* Interp, for error return. */
Tcl_Obj *pathPtr) /* Path whose basename to extract. */
{
int objc;
Tcl_Obj *splitPtr;
Tcl_Obj *resultPtr = NULL;
splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
Tcl_IncrRefCount(splitPtr);
if (objc != 0) {
if ((objc == 1) && (*TclGetString(pathPtr) == '~')) {
Tcl_DecrRefCount(splitPtr);
if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
return NULL;
}
splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
Tcl_IncrRefCount(splitPtr);
}
/*
* Return the last component, unless it is the only component, and it
* is the root of an absolute path.
*/
if (objc > 0) {
Tcl_ListObjIndex(NULL, splitPtr, objc-1, &resultPtr);
if ((objc == 1) &&
(Tcl_FSGetPathType(resultPtr) != TCL_PATH_RELATIVE)) {
resultPtr = NULL;
}
}
}
if (resultPtr == NULL) {
resultPtr = Tcl_NewObj();
}
Tcl_IncrRefCount(resultPtr);
Tcl_DecrRefCount(splitPtr);
return resultPtr;
}
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;
}
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;
}
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;
}
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 configure ( Tcl_Interp *interp, ComboParams *para,
GnoclOption options[] )
{
GtkEntry *entry = GTK_ENTRY ( para->combo->entry );
if ( options[itemsIdx].status == GNOCL_STATUS_CHANGED )
{
Tcl_Obj *strings = options[itemsIdx].val.obj;
int no;
if ( Tcl_ListObjLength ( interp, strings, &no ) != TCL_OK )
return TCL_ERROR;
if ( no == 0 )
{
gtk_container_foreach ( GTK_CONTAINER ( para->combo->list ),
removeAll, GTK_CONTAINER ( para->combo->list ) );
}
else
{
int n;
GList *items = NULL;
for ( n = 0; n < no; ++n )
{
Tcl_Obj *tp;
int ret = Tcl_ListObjIndex ( interp, strings, n, &tp );
if ( ret != TCL_OK )
return ret;
items = g_list_append ( items,
( char * ) gnoclGetStringFromObj ( tp, NULL ) );
}
gtk_combo_set_popdown_strings ( para->combo, items );
}
}
gnoclAttacheOptCmdAndVar (
&options[onChangedIdx], ¶->onChanged,
&options[variableIdx], ¶->variable,
"changed", G_OBJECT ( entry ),
G_CALLBACK ( changedFunc ), interp, traceFunc, para );
if ( options[variableIdx].status == GNOCL_STATUS_CHANGED
&& options[valueIdx].status == 0 /* value is handled below */
&& para->variable != NULL )
{
/* if variable does not exist -> set it, else set widget state */
const char *val = Tcl_GetVar ( interp, para->variable, TCL_GLOBAL_ONLY );
if ( val == NULL )
{
val = gtk_entry_get_text ( entry );
setVariable ( para, val );
}
else
setVal ( entry, val );
}
if ( options[valueIdx].status == GNOCL_STATUS_CHANGED )
{
char *str = options[valueIdx].val.str;
setVal ( entry, str );
setVariable ( para, str );
}
/* gnoclOptTooltip does not work since the tooltip must be
associated to the entry, not the combo.
I think this is a BUG in GTK 2.0.6
*/
if ( options[tooltipIdx].status == GNOCL_STATUS_CHANGED )
gnoclOptTooltip ( interp, &options[tooltipIdx], G_OBJECT ( entry ), NULL );
if ( options[editableIdx].status == GNOCL_STATUS_CHANGED )
g_object_set ( G_OBJECT ( entry ), "editable", options[editableIdx].val.b,
NULL );
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;
}
/**
\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;
}
/*************************************************************************
* 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);
}
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;
}
static int
Send(
LPDISPATCH pdispInterp, /* Pointer to the remote interp's COM
* object. */
Tcl_Interp *interp, /* The local interpreter. */
int async, /* Flag for the calling style. */
ClientData clientData, /* The RegisteredInterp structure for this
* interp. */
int objc, /* Number of arguments to be sent. */
Tcl_Obj *const objv[]) /* The arguments to be sent. */
{
VARIANT vCmd, vResult;
DISPPARAMS dp;
EXCEPINFO ei;
UINT uiErr = 0;
HRESULT hr = S_OK, ehr = S_OK;
Tcl_Obj *cmd = NULL;
DISPID dispid;
cmd = Tcl_ConcatObj(objc, objv);
/*
* Setup the arguments for the COM method call.
*/
VariantInit(&vCmd);
VariantInit(&vResult);
memset(&dp, 0, sizeof(dp));
memset(&ei, 0, sizeof(ei));
vCmd.vt = VT_BSTR;
vCmd.bstrVal = SysAllocString(Tcl_GetUnicode(cmd));
dp.cArgs = 1;
dp.rgvarg = &vCmd;
/*
* Select the method to use based upon the async flag and call the method.
*/
dispid = async ? TKWINSENDCOM_DISPID_ASYNC : TKWINSENDCOM_DISPID_SEND;
hr = pdispInterp->lpVtbl->Invoke(pdispInterp, dispid,
&IID_NULL, LOCALE_SYSTEM_DEFAULT, DISPATCH_METHOD,
&dp, &vResult, &ei, &uiErr);
/*
* Convert the result into a string and place in the interps result.
*/
ehr = VariantChangeType(&vResult, &vResult, 0, VT_BSTR);
if (SUCCEEDED(ehr)) {
Tcl_SetObjResult(interp, Tcl_NewUnicodeObj(vResult.bstrVal, -1));
}
/*
* Errors are returned as dispatch exceptions. If an error code was
* returned then we decode the exception and setup the Tcl error
* variables.
*/
if (hr == DISP_E_EXCEPTION && ei.bstrSource != NULL) {
Tcl_Obj *opError, *opErrorCode, *opErrorInfo;
opError = Tcl_NewUnicodeObj(ei.bstrSource, -1);
Tcl_ListObjIndex(interp, opError, 0, &opErrorCode);
Tcl_SetObjErrorCode(interp, opErrorCode);
Tcl_ListObjIndex(interp, opError, 1, &opErrorInfo);
Tcl_AppendObjToErrorInfo(interp, opErrorInfo);
}
/*
* Clean up any COM allocated resources.
*/
SysFreeString(ei.bstrDescription);
SysFreeString(ei.bstrSource);
SysFreeString(ei.bstrHelpFile);
VariantClear(&vCmd);
return (SUCCEEDED(hr) ? TCL_OK : TCL_ERROR);
}
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;
}
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;
}
/*
* 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
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::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;
}
char *
Tk_SetAppName(
Tk_Window tkwin, /* Token for any window in the application
* to be named: it is just used to identify
* the application and the display. */
char *name) /* The name that will be used to
* refer to the interpreter in later
* "send" commands. Must be globally
* unique. */
{
TkWindow *winPtr = (TkWindow *) tkwin;
Tcl_Interp *interp = winPtr->mainPtr->interp;
int i, suffix, offset, result;
int createCommand = 0;
RegisteredInterp *riPtr, *prevPtr;
char *actualName;
Tcl_DString dString;
Tcl_Obj *resultObjPtr, *interpNamePtr;
char *interpName;
if (!initialized) {
SendInit(interp);
}
/*
* See if the application is already registered; if so, remove its
* current name from the registry. The deletion of the command
* will take care of disposing of this entry.
*/
for (riPtr = interpListPtr, prevPtr = NULL; riPtr != NULL;
prevPtr = riPtr, riPtr = riPtr->nextPtr) {
if (riPtr->interp == interp) {
if (prevPtr == NULL) {
interpListPtr = interpListPtr->nextPtr;
} else {
prevPtr->nextPtr = riPtr->nextPtr;
}
break;
}
}
/*
* Pick a name to use for the application. Use "name" if it's not
* already in use. Otherwise add a suffix such as " #2", trying
* larger and larger numbers until we eventually find one that is
* unique.
*/
actualName = name;
suffix = 1;
offset = 0;
Tcl_DStringInit(&dString);
TkGetInterpNames(interp, tkwin);
resultObjPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(resultObjPtr);
for (i = 0; ; ) {
result = Tcl_ListObjIndex(NULL, resultObjPtr, i, &interpNamePtr);
if (interpNamePtr == NULL) {
break;
}
interpName = Tcl_GetStringFromObj(interpNamePtr, NULL);
if (strcmp(actualName, interpName) == 0) {
if (suffix == 1) {
Tcl_DStringAppend(&dString, name, -1);
Tcl_DStringAppend(&dString, " #", 2);
offset = Tcl_DStringLength(&dString);
Tcl_DStringSetLength(&dString, offset + 10);
actualName = Tcl_DStringValue(&dString);
}
suffix++;
sprintf(actualName + offset, "%d", suffix);
i = 0;
} else {
i++;
}
}
Tcl_DecrRefCount(resultObjPtr);
Tcl_ResetResult(interp);
/*
* We have found a unique name. Now add it to the registry.
*/
riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
riPtr->interp = interp;
riPtr->name = ckalloc(strlen(actualName) + 1);
riPtr->nextPtr = interpListPtr;
interpListPtr = riPtr;
strcpy(riPtr->name, actualName);
Tcl_CreateObjCommand(interp, "send", Tk_SendObjCmd,
(ClientData) riPtr, NULL /* TODO: DeleteProc */);
if (Tcl_IsSafe(interp)) {
Tcl_HideCommand(interp, "send", "send");
}
Tcl_DStringFree(&dString);
return riPtr->name;
}
/*************************************************************************
* 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;
}