int
thwl_set_result_cbitmap (Tcl_Interp* interp, hwloc_const_bitmap_t bitmap) {
char* res;
if (hwloc_bitmap_list_asprintf(&res, bitmap) == -1) {
Tcl_SetResult(interp, "hwloc_bitmap_list_asprintf() failed", TCL_STATIC);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(res, -1));
free(res);
return TCL_OK;
}
/* Ttk_NewStickyObj --
* Construct a new Tcl_Obj * containing a stickiness specification.
*/
Tcl_Obj *Ttk_NewStickyObj(Ttk_Sticky sticky)
{
char buf[5];
char *p = buf;
if (sticky & TTK_STICK_N) *p++ = 'n';
if (sticky & TTK_STICK_S) *p++ = 's';
if (sticky & TTK_STICK_W) *p++ = 'w';
if (sticky & TTK_STICK_E) *p++ = 'e';
*p = '\0';
return Tcl_NewStringObj(buf, p - buf);
}
static void
CheckbuttonInitialize(Tcl_Interp *interp, void *recordPtr)
{
Checkbutton *checkPtr = recordPtr;
Tcl_Obj *variableObj;
/* default -variable is the widget name:
*/
variableObj = Tcl_NewStringObj(Tk_PathName(checkPtr->core.tkwin), -1);
Tcl_IncrRefCount(variableObj);
checkPtr->checkbutton.variableObj = variableObj;
BaseInitialize(interp, recordPtr);
}
void TclTextInterp::mobile_cb(float tx, float ty, float tz,
float rx, float ry, float rz, int buttondown) {
Tcl_Obj *poslist = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(tx));
Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(ty));
Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(tz));
Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(rx));
Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(ry));
Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(rz));
Tcl_ListObjAppendElement(interp, poslist, Tcl_NewIntObj(buttondown));
Tcl_Obj *varname = Tcl_NewStringObj("vmd_mobile", -1);
Tcl_ObjSetVar2(interp, varname, NULL, poslist, TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
}
/*
* ------------------------------------------------------------------------
* AddClassUnknowMethod()
*
* ------------------------------------------------------------------------
*/
static int
AddClassUnknowMethod(
Tcl_Interp *interp,
ItclObjectInfo *infoPtr,
Tcl_Class clsPtr)
{
ClientData tmPtr, pmPtr;
infoPtr->unknownNamePtr = Tcl_NewStringObj("unknown", -1);
Tcl_IncrRefCount(infoPtr->unknownNamePtr);
infoPtr->unknownArgumentPtr = Tcl_NewStringObj("m args", -1);
Tcl_IncrRefCount(infoPtr->unknownArgumentPtr);
infoPtr->unknownBodyPtr = Tcl_NewStringObj(clazzUnknownBody, -1);
Tcl_IncrRefCount(infoPtr->unknownBodyPtr);
tmPtr = (ClientData)Itcl_NewProcClassMethod(interp,
clsPtr, NULL, NULL, NULL, NULL, infoPtr->unknownNamePtr,
infoPtr->unknownArgumentPtr, infoPtr->unknownBodyPtr, &pmPtr);
if (tmPtr == NULL) {
Tcl_Panic("cannot add class method unknown");
}
return TCL_OK;
}
static void tvfsExecTcl(
Testvfs *p,
const char *zMethod,
Tcl_Obj *arg1,
Tcl_Obj *arg2,
Tcl_Obj *arg3
){
int rc; /* Return code from Tcl_EvalObj() */
int nArg; /* Elements in eval'd list */
int nScript;
Tcl_Obj ** ap;
assert( p->pScript );
if( !p->apScript ){
int nByte;
int i;
if( TCL_OK!=Tcl_ListObjGetElements(p->interp, p->pScript, &nScript, &ap) ){
Tcl_BackgroundError(p->interp);
Tcl_ResetResult(p->interp);
return;
}
p->nScript = nScript;
nByte = (nScript+TESTVFS_MAX_ARGS)*sizeof(Tcl_Obj *);
p->apScript = (Tcl_Obj **)ckalloc(nByte);
memset(p->apScript, 0, nByte);
for(i=0; i<nScript; i++){
p->apScript[i] = ap[i];
}
}
p->apScript[p->nScript] = Tcl_NewStringObj(zMethod, -1);
p->apScript[p->nScript+1] = arg1;
p->apScript[p->nScript+2] = arg2;
p->apScript[p->nScript+3] = arg3;
for(nArg=p->nScript; p->apScript[nArg]; nArg++){
Tcl_IncrRefCount(p->apScript[nArg]);
}
rc = Tcl_EvalObjv(p->interp, nArg, p->apScript, TCL_EVAL_GLOBAL);
if( rc!=TCL_OK ){
Tcl_BackgroundError(p->interp);
Tcl_ResetResult(p->interp);
}
for(nArg=p->nScript; p->apScript[nArg]; nArg++){
Tcl_DecrRefCount(p->apScript[nArg]);
p->apScript[nArg] = 0;
}
}
/* $pw identify ?what? $x $y --
* Return index of sash at $x,$y
*/
static int PanedIdentifyCommand(
void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
{
const char *whatTable[] = { "element", "sash", NULL };
enum { IDENTIFY_ELEMENT, IDENTIFY_SASH };
int what = IDENTIFY_SASH;
Paned *pw = recordPtr;
int sashThickness = pw->paned.sashThickness;
int nSashes = Ttk_NumberSlaves(pw->paned.mgr) - 1;
int x, y, pos;
int index;
if (objc < 4 || objc > 5) {
Tcl_WrongNumArgs(interp, 2,objv, "?what? x y");
return TCL_ERROR;
}
if ( Tcl_GetIntFromObj(interp, objv[objc-2], &x) != TCL_OK
|| Tcl_GetIntFromObj(interp, objv[objc-1], &y) != TCL_OK
|| (objc == 5 &&
Tcl_GetIndexFromObj(interp, objv[2], whatTable, "option", 0, &what)
!= TCL_OK)
) {
return TCL_ERROR;
}
pos = pw->paned.orient == TTK_ORIENT_HORIZONTAL ? x : y;
for (index = 0; index < nSashes; ++index) {
Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
if (pane->sashPos <= pos && pos <= pane->sashPos + sashThickness) {
/* Found it. */
switch (what) {
case IDENTIFY_SASH:
Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
return TCL_OK;
case IDENTIFY_ELEMENT:
{
Ttk_Element element =
Ttk_IdentifyElement(SashLayout(pw, index), x, y);
if (element) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj(Ttk_ElementName(element), -1));
}
return TCL_OK;
}
}
}
}
return TCL_OK; /* nothing found - return empty string */
}
SWIG_Tcl_InstallConstants(Tcl_Interp *interp, swig_const_info constants[]) {
int i;
Tcl_Obj *obj;
Tcl_HashEntry *entryPtr;
int newobj;
if (!swigconstTableinit) {
Tcl_InitHashTable(&swigconstTable, TCL_STRING_KEYS);
swigconstTableinit = 1;
}
for (i = 0; constants[i].type; i++) {
switch(constants[i].type) {
case SWIG_TCL_INT:
obj = Tcl_NewIntObj(constants[i].lvalue);
break;
case SWIG_TCL_FLOAT:
obj = Tcl_NewDoubleObj(constants[i].dvalue);
break;
case SWIG_TCL_STRING:
obj = Tcl_NewStringObj((char *) constants[i].pvalue,-1);
break;
case SWIG_TCL_POINTER:
obj = SWIG_NewPointerObj(constants[i].pvalue, *(constants[i]).ptype,0);
break;
case SWIG_TCL_BINARY:
obj = SWIG_NewPackedObj(constants[i].pvalue, constants[i].lvalue, *(constants[i].ptype),0);
break;
default:
obj = 0;
break;
}
if (obj) {
Tcl_ObjSetVar2(interp,Tcl_NewStringObj(constants[i].name,-1), NULL, obj, TCL_GLOBAL_ONLY);
entryPtr = Tcl_CreateHashEntry(&swigconstTable, constants[i].name, &newobj);
Tcl_SetHashValue(entryPtr, (ClientData) obj);
}
}
}
/*
** This is the callback from a quota-over-limit.
*/
static void tclQuotaCallback(
const char *zFilename, /* Name of file whose size increases */
sqlite3_int64 *piLimit, /* IN/OUT: The current limit */
sqlite3_int64 iSize, /* Total size of all files in the group */
void *pArg /* Client data */
){
TclQuotaCallback *p; /* Callback script object */
Tcl_Obj *pEval; /* Script to evaluate */
Tcl_Obj *pVarname; /* Name of variable to pass as 2nd arg */
unsigned int rnd; /* Random part of pVarname */
int rc; /* Tcl error code */
p = (TclQuotaCallback *)pArg;
if( p==0 ) return;
pVarname = Tcl_NewStringObj("::piLimit_", -1);
Tcl_IncrRefCount(pVarname);
sqlite3_randomness(sizeof(rnd), (void *)&rnd);
Tcl_AppendObjToObj(pVarname, Tcl_NewIntObj((int)(rnd&0x7FFFFFFF)));
Tcl_ObjSetVar2(p->interp, pVarname, 0, Tcl_NewWideIntObj(*piLimit), 0);
pEval = Tcl_DuplicateObj(p->pScript);
Tcl_IncrRefCount(pEval);
Tcl_ListObjAppendElement(0, pEval, Tcl_NewStringObj(zFilename, -1));
Tcl_ListObjAppendElement(0, pEval, pVarname);
Tcl_ListObjAppendElement(0, pEval, Tcl_NewWideIntObj(iSize));
rc = Tcl_EvalObjEx(p->interp, pEval, TCL_EVAL_GLOBAL);
if( rc==TCL_OK ){
Tcl_Obj *pLimit = Tcl_ObjGetVar2(p->interp, pVarname, 0, 0);
rc = Tcl_GetWideIntFromObj(p->interp, pLimit, piLimit);
Tcl_UnsetVar(p->interp, Tcl_GetString(pVarname), 0);
}
Tcl_DecrRefCount(pEval);
Tcl_DecrRefCount(pVarname);
if( rc!=TCL_OK ) Tcl_BackgroundError(p->interp);
}
Tcl_Obj *
PathColorGetOption(
ClientData clientData,
Tk_Window tkwin,
char *recordPtr, /* Pointer to widget record. */
int internalOffset) /* Offset within *recordPtr containing the
* value. */
{
char *internalPtr;
Tcl_Obj *objPtr = NULL;
TkPathColor *pathColor = NULL;
internalPtr = recordPtr + internalOffset;
pathColor = *((TkPathColor **) internalPtr);
if (pathColor != NULL) {
if (pathColor->color) {
objPtr = Tcl_NewStringObj(Tk_NameOfColor(pathColor->color), -1);
} else if (pathColor->gradientInstPtr) {
objPtr = Tcl_NewStringObj(pathColor->gradientInstPtr->masterPtr->name, -1);
}
}
return objPtr;
}
int gnoclComboCmd ( ClientData data, Tcl_Interp *interp,
int objc, Tcl_Obj * const objv[] )
{
ComboParams *para;
int ret;
if ( gnoclParseOptions ( interp, objc, objv, comboOptions )
!= TCL_OK )
{
gnoclClearOptions ( comboOptions );
return TCL_ERROR;
}
para = g_new ( ComboParams, 1 );
para->interp = interp;
para->combo = GTK_COMBO ( gtk_combo_new( ) );
para->variable = NULL;
para->onChanged = NULL;
para->inSetVar = 0;
ret = gnoclSetOptions ( interp, comboOptions,
G_OBJECT ( para->combo ), -1 );
if ( ret == TCL_OK )
ret = configure ( interp, para, comboOptions );
gnoclClearOptions ( comboOptions );
if ( ret != TCL_OK )
{
g_free ( para );
gtk_widget_destroy ( GTK_WIDGET ( para->combo ) );
return TCL_ERROR;
}
para->name = gnoclGetAutoWidgetId();
g_signal_connect ( G_OBJECT ( para->combo ), "destroy",
G_CALLBACK ( destroyFunc ), para );
gnoclMemNameAndWidget ( para->name, GTK_WIDGET ( para->combo ) );
gtk_widget_show ( GTK_WIDGET ( para->combo ) );
Tcl_CreateObjCommand ( interp, para->name, comboFunc, para, NULL );
Tcl_SetObjResult ( interp, Tcl_NewStringObj ( para->name, -1 ) );
return TCL_OK;
}
void test_ota_delta(sqlite3_context *pCtx, int nArg, sqlite3_value **apVal){
Tcl_Interp *interp = (Tcl_Interp*)sqlite3_user_data(pCtx);
Tcl_Obj *pScript;
int i;
pScript = Tcl_NewObj();
Tcl_IncrRefCount(pScript);
Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj("ota_delta", -1));
for(i=0; i<nArg; i++){
sqlite3_value *pIn = apVal[i];
const char *z = (const char*)sqlite3_value_text(pIn);
Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(z, -1));
}
if( TCL_OK==Tcl_EvalObjEx(interp, pScript, TCL_GLOBAL_ONLY) ){
const char *z = Tcl_GetStringResult(interp);
sqlite3_result_text(pCtx, z, -1, SQLITE_TRANSIENT);
}else{
Tcl_BackgroundError(interp);
}
Tcl_DecrRefCount(pScript);
}
//
// Return a list of ctable quote type names (cache it, too)
//
CTABLE_INTERNAL Tcl_Obj *ctable_quoteTypeList(Tcl_Interp *interp)
{
static Tcl_Obj *result = NULL;
if (!result) {
int index;
result = Tcl_NewObj();
for(index = 0; ctable_quote_names[index]; index++) {
Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(ctable_quote_names[index], -1));
}
Tcl_IncrRefCount(result);
}
return result;
}
static void
ScaleSetVariable(
register TkScale *scalePtr) /* Info about widget. */
{
if (scalePtr->varNamePtr != NULL) {
char string[PRINT_CHARS];
sprintf(string, scalePtr->format, scalePtr->value);
scalePtr->flags |= SETTING_VAR;
Tcl_ObjSetVar2(scalePtr->interp, scalePtr->varNamePtr, NULL,
Tcl_NewStringObj(string, -1), TCL_GLOBAL_ONLY);
scalePtr->flags &= ~SETTING_VAR;
}
}
static void
get_register_types (int regnum, map_arg arg)
{
struct type *reg_vtype;
int i,n;
reg_vtype = register_type (get_current_arch (), regnum);
if (TYPE_CODE (reg_vtype) == TYPE_CODE_UNION)
{
n = TYPE_NFIELDS (reg_vtype);
/* limit to 16 types */
if (n > 16)
n = 16;
for (i = 0; i < n; i++)
{
Tcl_Obj *ar[3], *list;
char *buff;
buff = xstrprintf ("%lx", (long)TYPE_FIELD_TYPE (reg_vtype, i));
ar[0] = Tcl_NewStringObj (TYPE_FIELD_NAME (reg_vtype, i), -1);
ar[1] = Tcl_NewStringObj (buff, -1);
if (TYPE_CODE (TYPE_FIELD_TYPE (reg_vtype, i)) == TYPE_CODE_FLT)
ar[2] = Tcl_NewStringObj ("float", -1);
else
ar[2] = Tcl_NewStringObj ("int", -1);
list = Tcl_NewListObj (3, ar);
Tcl_ListObjAppendElement (gdbtk_interp, result_ptr->obj_ptr, list);
xfree (buff);
}
}
else
{
Tcl_Obj *ar[3], *list;
char *buff;
buff = xstrprintf ("%lx", (long)reg_vtype);
ar[0] = Tcl_NewStringObj (TYPE_NAME(reg_vtype), -1);
ar[1] = Tcl_NewStringObj (buff, -1);
if (TYPE_CODE (reg_vtype) == TYPE_CODE_FLT)
ar[2] = Tcl_NewStringObj ("float", -1);
else
ar[2] = Tcl_NewStringObj ("int", -1);
list = Tcl_NewListObj (3, ar);
xfree (buff);
Tcl_ListObjAppendElement (gdbtk_interp, result_ptr->obj_ptr, list);
}
}
static int
TestgetwindowinfoObjCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
long hwnd;
Tcl_Obj *dictObj = NULL, *classObj = NULL, *textObj = NULL;
Tcl_Obj *childrenObj = NULL;
TCHAR buf[512];
int cch, cchBuf = 256;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "hwnd");
return TCL_ERROR;
}
if (Tcl_GetLongFromObj(interp, objv[1], &hwnd) != TCL_OK)
return TCL_ERROR;
cch = GetClassName(INT2PTR(hwnd), buf, cchBuf);
if (cch == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to get class name: ", -1));
AppendSystemError(interp, GetLastError());
return TCL_ERROR;
} else {
Tcl_DString ds;
Tcl_WinTCharToUtf(buf, -1, &ds);
classObj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
}
dictObj = Tcl_NewDictObj();
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("class", 5), classObj);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("id", 2),
Tcl_NewLongObj(GetWindowLongA(INT2PTR(hwnd), GWL_ID)));
cch = GetWindowText(INT2PTR(hwnd), (LPTSTR)buf, cchBuf);
textObj = Tcl_NewUnicodeObj((LPCWSTR)buf, cch);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("text", 4), textObj);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("parent", 6),
Tcl_NewLongObj(PTR2INT(GetParent((INT2PTR(hwnd))))));
childrenObj = Tcl_NewListObj(0, NULL);
EnumChildWindows(INT2PTR(hwnd), EnumChildrenProc, (LPARAM)childrenObj);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("children", -1), childrenObj);
Tcl_SetObjResult(interp, dictObj);
return TCL_OK;
}
static Tcl_Obj *PrologToTclObj(AP_World *w, AP_Obj prolog_obj, Tcl_Interp *interp)
{
Tcl_Obj *tcl_obj;
AP_Obj i;
switch (AP_ObjType(w, prolog_obj)) {
case AP_INTEGER:
tcl_obj = Tcl_NewIntObj(AP_GetLong(w, prolog_obj));
break;
case AP_FLOAT:
tcl_obj = Tcl_NewDoubleObj(AP_GetDouble(w, prolog_obj));
break;
case AP_ATOM:
if (AP_IsNullList(w, prolog_obj)) {
tcl_obj = Tcl_NewStringObj((char *)"", -1);
} else {
tcl_obj = Tcl_NewStringObj((char *)AP_GetAtomStr(w, prolog_obj), -1);
}
break;
case AP_LIST:
tcl_obj = Tcl_NewListObj(0, NULL);
for (i = prolog_obj; !AP_IsNullList(w, i); i = AP_ListTail(w, i)) {
Tcl_ListObjAppendElement(interp, tcl_obj, PrologToTclObj(w, AP_ListHead(w, i), interp));
}
break;
case AP_STRUCTURE:
tcl_obj = Tcl_NewStringObj((char *)"structure", -1);
break;
case AP_VARIABLE:
tcl_obj = Tcl_NewStringObj((char *)"variable", -1);
break;
default:
tcl_obj = NULL;
}
return tcl_obj;
}
char *tcl_var_read(Tcl_TVInfo *vinfo, Tcl_Interp *I, char *n1, char *n2, int flags)
{
Tcl_Obj *obj;
union {
int i;
const char *c;
} rdata;
switch(vinfo->type & TVINFO_UNTYPED)
{
case TVINFO_pointer:
rdata.c = vinfo->data;
break;
case TVINFO_guid:
rdata.i = (current) ? current->guid : -1;
break;
case TVINFO_nick:
rdata.c = (current) ? current->nick : "(undefined variable)";
break;
case TVINFO_wantnick:
rdata.c = (current) ? current->wantnick : "(undefined variable)";
break;
case TVINFO_server:
rdata.i = (current) ? current->server : -1;
break;
case TVINFO_nextserver:
rdata.i = (current) ? current->nextserver : -1;
break;
case TVINFO_currentchan:
rdata.c = (current && current->activechan) ? current->activechan->name : "(undefined variable)";
break;
default:
return("(undefined variable)");
}
if (vinfo->type & TVINFO_INT)
{
obj = Tcl_NewIntObj(rdata.i);
}
else
/* if (vinfo->type & TVINFO_CHAR) */
{
obj = Tcl_NewStringObj((char*)rdata.c,strlen(rdata.c));
}
Tcl_ObjSetVar2(energymech_tcl,vinfo->n1,NULL,obj,TCL_GLOBAL_ONLY);
return(NULL);
}
static void tvfsShmBarrier(sqlite3_file *pFile){
TestvfsFd *pFd = tvfsGetFd(pFile);
Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
if( p->isFullshm ){
sqlite3OsShmBarrier(pFd->pReal);
return;
}
if( p->pScript && p->mask&TESTVFS_SHMBARRIER_MASK ){
tvfsExecTcl(p, "xShmBarrier",
Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, 0, 0
);
}
}
/*
** This SQLite callback records the datatype of all columns.
**
** The pArg argument is really a pointer to a TCL interpreter. The
** column names are inserted as the result of this interpreter.
**
** This routine returns non-zero which causes the query to abort.
*/
static int rememberDataTypes(void *pArg, int nCol, char **argv, char **colv){
int i;
Tcl_Interp *interp = (Tcl_Interp*)pArg;
Tcl_Obj *pList, *pElem;
if( colv[nCol+1]==0 ){
return 1;
}
pList = Tcl_NewObj();
for(i=0; i<nCol; i++){
pElem = Tcl_NewStringObj(colv[i+nCol] ? colv[i+nCol] : "NULL", -1);
Tcl_ListObjAppendElement(interp, pList, pElem);
}
Tcl_SetObjResult(interp, pList);
return 1;
}
/*
** This is a second alternative callback for database queries. A the
** first column of the first row of the result is made the TCL result.
*/
static int DbEvalCallback3(
void *clientData, /* An instance of CallbackData */
int nCol, /* Number of columns in the result */
char ** azCol, /* Data for each column */
char ** azN /* Name for each column */
){
Tcl_Interp *interp = (Tcl_Interp*)clientData;
Tcl_Obj *pElem;
if( azCol==0 ) return 1;
if( nCol==0 ) return 1;
#ifdef UTF_TRANSLATION_NEEDED
{
Tcl_DString dCol;
Tcl_DStringInit(&dCol);
Tcl_ExternalToUtfDString(NULL, azCol[0], -1, &dCol);
pElem = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
Tcl_DStringFree(&dCol);
}
#else
pElem = Tcl_NewStringObj(azCol[0], -1);
#endif
Tcl_SetObjResult(interp, pElem);
return 1;
}
static int tclvarFilter(
sqlite3_vtab_cursor *pVtabCursor,
int idxNum, const char *idxStr,
int argc, sqlite3_value **argv
){
tclvar_cursor *pCur = (tclvar_cursor *)pVtabCursor;
Tcl_Interp *interp = ((tclvar_vtab *)(pVtabCursor->pVtab))->interp;
Tcl_Obj *p = Tcl_NewStringObj("info vars", -1);
Tcl_IncrRefCount(p);
assert( argc==0 || argc==1 );
if( argc==1 ){
Tcl_Obj *pArg = Tcl_NewStringObj((char*)sqlite3_value_text(argv[0]), -1);
Tcl_ListObjAppendElement(0, p, pArg);
}
Tcl_EvalObjEx(interp, p, TCL_EVAL_GLOBAL);
pCur->pList1 = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(pCur->pList1);
assert( pCur->i1==0 && pCur->i2==0 && pCur->pList2==0 );
Tcl_DecrRefCount(p);
return tclvarNext(pVtabCursor);
}
static int cget ( Tcl_Interp *interp, ComboParams *para,
GnoclOption options[], int idx )
{
Tcl_Obj *obj = NULL;
GtkEntry *entry = GTK_ENTRY ( para->combo->entry );
if ( idx == variableIdx )
obj = Tcl_NewStringObj ( para->variable, -1 );
else if ( idx == onChangedIdx )
obj = Tcl_NewStringObj ( para->onChanged ? para->onChanged : "", -1 );
else if ( idx == itemsIdx )
{
obj = Tcl_NewListObj ( 0, NULL );
gtk_container_foreach ( GTK_CONTAINER ( para->combo->list ),
getAllItems, obj );
}
else if ( idx == valueIdx )
obj = Tcl_NewStringObj ( gtk_entry_get_text ( entry ), -1 );
else if ( idx == tooltipIdx )
gnoclOptTooltip ( interp, &options[tooltipIdx], G_OBJECT ( entry ), &obj );
else if ( idx == editableIdx )
{
gboolean on;
g_object_get ( G_OBJECT ( entry ), "editable", &on, NULL );
obj = Tcl_NewBooleanObj ( on );
}
if ( obj != NULL )
{
Tcl_SetObjResult ( interp, obj );
return TCL_OK;
}
return gnoclCgetNotImplemented ( interp, options + idx );
}
TnmSnmp*
TnmSnmpCreateSession(Tcl_Interp *interp, char type)
{
TnmSnmp *session;
const char *user;
session = (TnmSnmp *) ckalloc(sizeof(TnmSnmp));
memset((char *) session, 0, sizeof(TnmSnmp));
session->interp = interp;
session->maddr.sin_family = AF_INET;
if (type == TNM_SNMP_GENERATOR || type == TNM_SNMP_NOTIFIER) {
session->maddr.sin_addr.s_addr = htonl(INADDR_LOOPBACK);
} else {
session->maddr.sin_addr.s_addr = htonl(INADDR_ANY);
}
if (type == TNM_SNMP_LISTENER || type == TNM_SNMP_NOTIFIER) {
session->maddr.sin_port = htons((unsigned short) TNM_SNMP_TRAPPORT);
} else {
session->maddr.sin_port = htons((unsigned short) TNM_SNMP_PORT);
}
session->version = TNM_SNMPv1;
session->domain = TNM_SNMP_UDP_DOMAIN;
session->type = type;
session->community = Tcl_NewStringObj("public", 6);
Tcl_IncrRefCount(session->community);
session->context = Tcl_NewStringObj("", 0);
Tcl_IncrRefCount(session->context);
user = Tcl_GetVar2(interp, "tnm", "user", TCL_GLOBAL_ONLY);
if (! user) {
user = "******";
}
session->user = Tcl_NewStringObj(user, (int) strlen(user));
Tcl_IncrRefCount(session->user);
session->engineID = Tcl_NewStringObj("", 0);
Tcl_IncrRefCount(session->engineID);
session->maxSize = TNM_SNMP_MAXSIZE;
session->securityLevel = TNM_SNMP_AUTH_NONE | TNM_SNMP_PRIV_NONE;
session->maxSize = TNM_SNMP_MAXSIZE;
session->authPassWord = Tcl_NewStringObj("public", 6);
Tcl_IncrRefCount(session->authPassWord);
session->privPassWord = Tcl_NewStringObj("private", 6);
Tcl_IncrRefCount(session->privPassWord);
session->retries = TNM_SNMP_RETRIES;
session->timeout = TNM_SNMP_TIMEOUT;
session->window = TNM_SNMP_WINDOW;
session->delay = TNM_SNMP_DELAY;
session->tagList = Tcl_NewListObj(0, NULL);
Tcl_IncrRefCount(session->tagList);
TnmOidInit(&session->enterpriseOid);
TnmOidFromString(&session->enterpriseOid, "1.3.6.1.4.1.1575");
return session;
}
/*
** Delete the file located at zPath. If the dirSync argument is true,
** ensure the file-system modifications are synced to disk before
** returning.
*/
static int tvfsDelete(sqlite3_vfs *pVfs, const char *zPath, int dirSync){
int rc = SQLITE_OK;
Testvfs *p = (Testvfs *)pVfs->pAppData;
if( p->pScript && p->mask&TESTVFS_DELETE_MASK ){
tvfsExecTcl(p, "xDelete",
Tcl_NewStringObj(zPath, -1), Tcl_NewIntObj(dirSync), 0, 0
);
tvfsResultCode(p, &rc);
}
if( rc==SQLITE_OK ){
rc = sqlite3OsDelete(PARENTVFS(pVfs), zPath, dirSync);
}
return rc;
}
void
TnmAttrList(Tcl_HashTable *tablePtr, Tcl_Interp *interp)
{
Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
Tcl_Obj *listPtr, *elemObjPtr;
listPtr = Tcl_GetObjResult(interp);
entryPtr = Tcl_FirstHashEntry(tablePtr, &search);
while (entryPtr) {
elemObjPtr = Tcl_NewStringObj(Tcl_GetHashKey(tablePtr, entryPtr), -1);
Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
entryPtr = Tcl_NextHashEntry(&search);
}
}
/**
\brief
\author Peter G Baum, William J Giddings
\date
**/
static int cget (
Tcl_Interp *interp,
LabelParams *para,
GnoclOption options[], int idx )
{
#ifdef DEBUG_LABEL
printf ( "label/staticFuncs/cget\n" );
#endif
Tcl_Obj *obj = NULL;
if ( idx == textVariableIdx )
{
obj = Tcl_NewStringObj ( para->textVariable, -1 );
}
else if ( idx == onChangedIdx )
{
obj = Tcl_NewStringObj ( para->onChanged ? para->onChanged : "", -1 );
}
else if ( idx == valueIdx )
{
obj = Tcl_NewStringObj ( gtk_label_get_text ( para->label ), -1 );
}
if ( obj != NULL )
{
Tcl_SetObjResult ( interp, obj );
return TCL_OK;
}
return gnoclCgetNotImplemented ( interp, options + idx );
}
static int tvfsShmOpen(sqlite3_file *pFile){
Testvfs *p;
int rc = SQLITE_OK; /* Return code */
TestvfsBuffer *pBuffer; /* Buffer to open connection to */
TestvfsFd *pFd; /* The testvfs file structure */
pFd = tvfsGetFd(pFile);
p = (Testvfs *)pFd->pVfs->pAppData;
assert( 0==p->isFullshm );
assert( pFd->pShmId && pFd->pShm==0 && pFd->pNext==0 );
/* Evaluate the Tcl script:
**
** SCRIPT xShmOpen FILENAME
*/
Tcl_ResetResult(p->interp);
if( p->pScript && p->mask&TESTVFS_SHMOPEN_MASK ){
tvfsExecTcl(p, "xShmOpen", Tcl_NewStringObj(pFd->zFilename, -1), 0, 0, 0);
if( tvfsResultCode(p, &rc) ){
if( rc!=SQLITE_OK ) return rc;
}
}
assert( rc==SQLITE_OK );
if( p->mask&TESTVFS_SHMOPEN_MASK && tvfsInjectIoerr(p) ){
return SQLITE_IOERR;
}
/* Search for a TestvfsBuffer. Create a new one if required. */
for(pBuffer=p->pBuffer; pBuffer; pBuffer=pBuffer->pNext){
if( 0==strcmp(pFd->zFilename, pBuffer->zFile) ) break;
}
if( !pBuffer ){
int nByte = sizeof(TestvfsBuffer) + (int)strlen(pFd->zFilename) + 1;
pBuffer = (TestvfsBuffer *)ckalloc(nByte);
memset(pBuffer, 0, nByte);
pBuffer->zFile = (char *)&pBuffer[1];
strcpy(pBuffer->zFile, pFd->zFilename);
pBuffer->pNext = p->pBuffer;
p->pBuffer = pBuffer;
}
/* Connect the TestvfsBuffer to the new TestvfsShm handle and return. */
pFd->pNext = pBuffer->pFile;
pBuffer->pFile = pFd;
pFd->pShm = pBuffer;
return SQLITE_OK;
}
extern int swift_mpi_init(Tcl_Interp *interp) {
#if defined(VMDMPI)
if (getenv("VMDNOSWIFTCOMM") == NULL) {
if (MPI_SUCCESS == MPI_Comm_dup(MPI_COMM_WORLD, &turbine_adlb_comm)) {
Tcl_Obj* TURBINE_ADLB_COMM = Tcl_NewStringObj("TURBINE_ADLB_COMM", -1);
// XXX this is another gross hack. This passes the MPI communicator pointer
// as if it were a long, to make it available through Tcl,
// but there MUST be a better way. This is copied from what was done in NAMD.
Tcl_Obj* adlb_comm_ptr = Tcl_NewLongObj((long) &turbine_adlb_comm);
Tcl_ObjSetVar2(interp, TURBINE_ADLB_COMM, NULL, adlb_comm_ptr, 0);
}
}
#endif
return 0;
}
static VTableInfo *VTableInfoNew(VTableDB *vtdbP, const char *name)
{
VTableInfo *vtabP;
char buf[24];
vtabP = (VTableInfo *) ckalloc(sizeof(*vtabP));
/* Note sqlite3 takes care of initalizing vtabP->vtab, just zero it */
memset(&vtabP->vtab, 0, sizeof(vtabP->vtab));
vtabP->vtdbP = vtdbP;
vtabP->cmdprefixP = NULL;
sqlite3_snprintf(sizeof(buf), buf, "vt%d", ++gVTableHandleCounter);
vtabP->vthandleP = Tcl_NewStringObj(buf, -1);
Tcl_IncrRefCount(vtabP->vthandleP);
return vtabP;
}
