C++ Tcl_ListObjAppendElement函数代码示例

static int
TestwinclockCmd(
    ClientData dummy,		/* Unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Argument count */
    Tcl_Obj *const objv[])	/* Argument vector */
{
    static const FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE };
				/* The Posix epoch, expressed as a Windows
				 * FILETIME */
    Tcl_Time tclTime;		/* Tcl clock */
    FILETIME sysTime;		/* System clock */
    Tcl_Obj *result;		/* Result of the command */
    LARGE_INTEGER t1, t2;
    LARGE_INTEGER p1, p2;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "");
	return TCL_ERROR;
    }

    QueryPerformanceCounter(&p1);

    Tcl_GetTime(&tclTime);
    GetSystemTimeAsFileTime(&sysTime);
    t1.LowPart = posixEpoch.dwLowDateTime;
    t1.HighPart = posixEpoch.dwHighDateTime;
    t2.LowPart = sysTime.dwLowDateTime;
    t2.HighPart = sysTime.dwHighDateTime;
    t2.QuadPart -= t1.QuadPart;

    QueryPerformanceCounter(&p2);

    result = Tcl_NewObj();
    Tcl_ListObjAppendElement(interp, result,
	    Tcl_NewIntObj((int) (t2.QuadPart / 10000000)));
    Tcl_ListObjAppendElement(interp, result,
	    Tcl_NewIntObj((int) ((t2.QuadPart / 10) % 1000000)));
    Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.sec));
    Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.usec));

    Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p1.QuadPart));
    Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p2.QuadPart));

    Tcl_SetObjResult(interp, result);

    return TCL_OK;
}

int sqlite3OutstandingMallocs(Tcl_Interp *interp){
  void *p;
  Tcl_Obj *pRes = Tcl_NewObj();
  Tcl_IncrRefCount(pRes);


  for(p=sqlite3_pFirst; p; p=((void **)p)[1]){
    Tcl_Obj *pEntry = Tcl_NewObj();
    Tcl_Obj *pStack = Tcl_NewObj();
    char *z;
    u32 iLine;
    int nBytes = sqlite3OsAllocationSize(p) - TESTALLOC_OVERHEAD;
    char *zAlloc = (char *)p;
    int i;

    Tcl_ListObjAppendElement(0, pEntry, Tcl_NewIntObj(nBytes));

    z = &zAlloc[TESTALLOC_OFFSET_FILENAME(p)];
    Tcl_ListObjAppendElement(0, pEntry, Tcl_NewStringObj(z, -1));

    z = &zAlloc[TESTALLOC_OFFSET_LINENUMBER(p)];
    memcpy(&iLine, z, sizeof(u32));
    Tcl_ListObjAppendElement(0, pEntry, Tcl_NewIntObj(iLine));

    z = &zAlloc[TESTALLOC_OFFSET_USER(p)];
    Tcl_ListObjAppendElement(0, pEntry, Tcl_NewStringObj(z, -1));

    z = &zAlloc[TESTALLOC_OFFSET_STACK(p)];
    for(i=0; i<TESTALLOC_STACKFRAMES; i++){
      char zHex[128];
      sprintf(zHex, "%p", ((void **)z)[i]);
      Tcl_ListObjAppendElement(0, pStack, Tcl_NewStringObj(zHex, -1));
    }

    Tcl_ListObjAppendElement(0, pEntry, pStack);
    Tcl_ListObjAppendElement(0, pRes, pEntry);
  }

  Tcl_ResetResult(interp);
  Tcl_SetObjResult(interp, pRes);
  Tcl_DecrRefCount(pRes);
  return TCL_OK;
}

static int
PrefixAllObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int tableObjc, result, t, length, elemLength;
    const char *string, *elemString;
    Tcl_Obj **tableObjv, *resultPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "table string");
	return TCL_ERROR;
    }

    result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
    if (result != TCL_OK) {
	return result;
    }
    resultPtr = Tcl_NewListObj(0, NULL);
    string = Tcl_GetStringFromObj(objv[2], &length);

    for (t = 0; t < tableObjc; t++) {
	elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);

	/*
	 * A prefix cannot match if it is longest.
	 */

	if (length <= elemLength) {
	    if (TclpUtfNcmp2(elemString, string, length) == 0) {
		Tcl_ListObjAppendElement(interp, resultPtr, tableObjv[t]);
	    }
	}
    }

    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}

/* $pw panes --
 * 	Return list of managed panes.
 */
static int PanedPanesCommand(
    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
{
    Paned *pw = recordPtr;
    Ttk_Manager *mgr = pw->paned.mgr;
    Tcl_Obj *panes;
    int i;

    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 2, objv, "");
        return TCL_ERROR;
    }

    panes = Tcl_NewListObj(0, NULL);
    for (i = 0; i < Ttk_NumberSlaves(mgr); ++i) {
        const char *pathName = Tk_PathName(Ttk_SlaveWindow(mgr,i));
        Tcl_ListObjAppendElement(interp, panes, Tcl_NewStringObj(pathName,-1));
    }
    Tcl_SetObjResult(interp, panes);

    return TCL_OK;
}

static int
msg_filenames(Tcl_Interp *interp, notmuch_message_t *msg, int argc, const char *argv[]) {
    if (argc != 0) {
        tcl_result_printf(interp, "msg filenames takes no arguments");
        return TCL_ERROR;
    }

    Tcl_Obj* list = Tcl_NewListObj(0, NULL);
    if (!list) {
        return TCL_ERROR;
    }
    notmuch_filenames_t *fns = notmuch_message_get_filenames(msg);
    while (notmuch_filenames_valid(fns)) {
        const char *fn = notmuch_filenames_get(fns);
        Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(fn, -1));
        notmuch_filenames_move_to_next(fns);
    }
    notmuch_filenames_destroy(fns);

    Tcl_SetObjResult(interp, list);
    return TCL_OK;
}

/*-----------------------------------------------------------------------------
 * ReturnSelectedFileList --
 *
 *   Take the resulting file descriptor sets from a select, and the
 *   list of file descritpors and build up a list of Tcl file handles.
 *
 * Parameters:
 *   o fileDescSetPtr (I) - The select fd_set.
 *   o fileDescCnt (I) - Number of descriptors in the list.
 *   o channelListPtr (I) - A pointer to a list of the FILE pointers for
 *     files that are in the set.
 * Returns:
 *   List of file handles.
 *-----------------------------------------------------------------------------
 */
static Tcl_Obj *
ReturnSelectedFileList (fd_set        *fileDescSetPtr,
                        int            fileDescCnt,
                        channelData_t *channelList)
{
    int idx, handleCnt;
    Tcl_Obj *fileHandleList = Tcl_NewListObj (0, NULL);

    handleCnt = 0;
    for (idx = 0; idx < fileDescCnt; idx++) {
        if (((channelList [idx].readFd >= 0) &&
             FD_ISSET (channelList [idx].readFd, fileDescSetPtr)) ||
            ((channelList [idx].writeFd >= 0) &&
             FD_ISSET (channelList [idx].writeFd, fileDescSetPtr))) {
            Tcl_ListObjAppendElement (NULL, fileHandleList,
                                      channelList [idx].channelIdObj);
            handleCnt++;
        }
    }

    return fileHandleList;
}

int proxenet_tcl_load_file(plugin_t* plugin)
{
	char* pathname;
	Tcl_Interp* tcl_interpreter;
        Tcl_Obj* tcl_cmds_ptr;

        if(plugin->state != INACTIVE){
#ifdef DEBUG
                if(cfg->verbose > 2)
                        xlog_tcl(LOG_DEBUG, "Plugin '%s' is already loaded. Skipping...\n", plugin->name);
#endif
                return 0;
        }

        pathname = plugin->fullpath;
	tcl_interpreter = (Tcl_Interp*) plugin->interpreter->vm;

        if (Tcl_EvalFile (tcl_interpreter, pathname) != TCL_OK){
		xlog_tcl(LOG_ERROR, "Failed to load '%s'\n", pathname);
		return -1;
	}

        plugin->interpreter->vm = tcl_interpreter;
	plugin->interpreter->ready = true;


        tcl_cmds_ptr = Tcl_NewListObj (0, NULL);
        Tcl_IncrRefCount(tcl_cmds_ptr);
        Tcl_ListObjAppendElement(tcl_interpreter, tcl_cmds_ptr, Tcl_NewStringObj(CFG_ONLEAVE_PLUGIN_FUNCTION, -1));

        if (Tcl_EvalObjEx(tcl_interpreter, tcl_cmds_ptr, TCL_EVAL_DIRECT) != TCL_OK) {
                xlog_tcl(LOG_WARNING, "%s() failed to execute properly\n", CFG_ONLOAD_PLUGIN_FUNCTION);
        }

        Tcl_DecrRefCount(tcl_cmds_ptr);

	return 0;
}

	/* ARGSUSED */
int
Tcl_PidObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
	return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_SetObjResult(interp, Tcl_NewLongObj((long) getpid()));
    } else {
	Tcl_Channel chan;
	const Tcl_ChannelType *chanTypePtr;
	PipeState *pipePtr;
	int i;
	Tcl_Obj *resultPtr, *longObjPtr;

	chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
	if (chan == (Tcl_Channel) NULL) {
	    return TCL_ERROR;
	}
	chanTypePtr = Tcl_GetChannelType(chan);
	if (chanTypePtr != &pipeChannelType) {
	    return TCL_OK;
	}
	pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
	resultPtr = Tcl_NewObj();
	for (i = 0; i < pipePtr->numPids; i++) {
	    longObjPtr = Tcl_NewLongObj((long) TclpGetPid(pipePtr->pidPtr[i]));
	    Tcl_ListObjAppendElement(NULL, resultPtr, longObjPtr);
	}
	Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

int proxenet_tcl_destroy_plugin(plugin_t* plugin)
{
        Tcl_Interp* tcl_interpreter;
        Tcl_Obj* tcl_cmds_ptr;

	tcl_interpreter = (Tcl_Interp*)plugin->interpreter->vm;

        proxenet_plugin_set_state(plugin, INACTIVE);

        tcl_cmds_ptr = Tcl_NewListObj (0, NULL);
        Tcl_IncrRefCount(tcl_cmds_ptr);
        Tcl_ListObjAppendElement(tcl_interpreter, tcl_cmds_ptr, Tcl_NewStringObj(CFG_ONLEAVE_PLUGIN_FUNCTION, -1));

        if (Tcl_EvalObjEx(tcl_interpreter, tcl_cmds_ptr, TCL_EVAL_DIRECT) != TCL_OK) {
                xlog_tcl(LOG_WARNING, "%s() failed to execute properly\n", CFG_ONLEAVE_PLUGIN_FUNCTION);
        }

        Tcl_DecrRefCount(tcl_cmds_ptr);

        plugin->pre_function = NULL;
        plugin->post_function = NULL;
        return 0;
}

SEXP RTcl_ObjFromIntVector(SEXP args)
{
    int count;
    Tcl_Obj *tclobj, *elem;
    int i;
    SEXP val, drop;

    val = CADR(args);
    drop = CADDR(args);

    tclobj = Tcl_NewObj();

    count = length(val);
    if (count == 1 && LOGICAL(drop)[0])
	tclobj = Tcl_NewIntObj(INTEGER(val)[0]);
    else
	for ( i = 0 ; i < count ; i++) {
	    elem = Tcl_NewIntObj(INTEGER(val)[i]);
	    Tcl_ListObjAppendElement(RTcl_interp, tclobj, elem);
	}

    return makeRTclObject(tclobj);
}

static int getIDs( Tcl_Interp *interp, int objc, Tcl_Obj * const objv[], 
      CanvasParams *param, GPtrArray *items )
{
   if( objc != 3 )
   {
      Tcl_WrongNumArgs( interp, 2, objv, NULL );
      return TCL_ERROR;
   }

   if( items != NULL && items->len > 0 )
   {
      int     k;
      Tcl_Obj *resList = Tcl_NewListObj( 0, NULL );
      for( k = 0; k < items->len; ++k )
      {
         Gnocl_CanvasItemInfo *info = GET_INFO( items, k );
         Tcl_ListObjAppendElement( interp, resList, 
               Tcl_NewIntObj( info->id ) );
      }
      Tcl_SetObjResult( interp, resList );
   }
   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;
}

static int
ForeachAssignments (Tcl_Interp * const interp, ForeachState * const statePtr,
                    Tcl_Obj * const varPtr, DBFHandle const dbfHandle)
{
  Tcl_Obj *const valuePtr = Tcl_NewObj ();
  int const i = statePtr->i;
  int j;
  int const size = statePtr->size;

  for (j = 0; j < size; j++)
    {
      if (Tcl_ListObjAppendElement
          (interp, valuePtr, NewAttributeObj (dbfHandle, i, j)) != TCL_OK)
        {
          return TCL_ERROR;
        }
    }
  if (Tcl_ObjSetVar2 (interp, varPtr, NULL, valuePtr, TCL_LEAVE_ERR_MSG) ==
      NULL)
    {
      return TCL_ERROR;
    }
  return TCL_OK;
}

static void 
freeTile (HtmlImage2 *pImage)
{
    HtmlTree *pTree = pImage->pImageServer->pTree;
    int flags = TCL_GLOBAL_ONLY;
    Tcl_Obj *pScript;
    if (pImage->pTileName) {
        pScript = Tcl_NewStringObj("image delete", -1);
        Tcl_IncrRefCount(pScript);
        Tcl_ListObjAppendElement(0, pScript, pImage->pTileName);
        Tcl_EvalObjEx(pTree->interp, pScript, flags);
        Tcl_DecrRefCount(pScript);
    
        Tcl_DecrRefCount(pImage->pTileName);
        pImage->tile = 0;
        pImage->pTileName = 0;
    }
    if (pImage->tilepixmap) {
        assert(pImage->pixmap);
        Tk_FreePixmap(
            Tk_Display(pImage->pImageServer->pTree->tkwin), pImage->tilepixmap);
        pImage->tilepixmap = 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);
}