Пример #1
0
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;
}
Пример #2
0
/* 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);
}
Пример #3
0
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);
}
Пример #4
0
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);
}
Пример #5
0
/*
 * ------------------------------------------------------------------------
 *  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;
}
Пример #6
0
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;
  }
}
Пример #7
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 */
}
Пример #8
0
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);
    }
  }
}
Пример #9
0
/*
** 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);
}
Пример #10
0
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;
}
Пример #11
0
Файл: combo.c Проект: zdia/gnocl
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;
}
Пример #12
0
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);
}
Пример #13
0
//
// 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;
}
Пример #14
0
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;
    }
}
Пример #15
0
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);
    }
}
Пример #16
0
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;
}
Пример #17
0
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;
}
Пример #18
0
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);
}
Пример #19
0
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
    );
  }
}
Пример #20
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;
}
Пример #21
0
/*
** 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;
}
Пример #22
0
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);
}
Пример #23
0
Файл: combo.c Проект: zdia/gnocl
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 );
}
Пример #24
0
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;
}
Пример #25
0
/*
** 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;
}
Пример #26
0
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);
    }
}
Пример #27
0
Файл: label.c Проект: zdia/gnocl
/**
\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 );
}
Пример #28
0
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;
}
Пример #29
0
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;
}
Пример #30
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;
}