C++ Tcl_NewStringObj函数代码示例

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

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