C++ Tcl_GetVar函数代码示例

test() {
  int code;
  int i=123;
  double d=3.14;

  // Link C/C++ variable and Tcl variable
  Tcl_LinkVar(interp,"i",(char*)(&i),TCL_LINK_INT);
  Tcl_LinkVar(interp,"d",(char*)(&d),TCL_LINK_DOUBLE);

  printf("i=%s\n",Tcl_GetVar(interp,"i",0));
  printf("d=%s\n",Tcl_GetVar(interp,"d",0));

  Tcl_SetVar(interp,"i","456",0);
  Tcl_SetVar(interp,"d","1.41421356",0);
  printf("i=%d\n",i);
  printf("d=%g\n",d);

  i=3229;
  d=1.6e-19;
  code=Tcl_Eval(interp,"expr $i");
  if(*interp->result!=0) printf("%s\n",interp->result);
  code=Tcl_Eval(interp,"expr $d");
  if(*interp->result!=0) printf("%s\n",interp->result);

  if(code!=TCL_OK) exit(1);
}

    virtual void SetParameters (Tcl_Interp * interp) 
    {
      occparam.resthcloseedgefac =
	atof (Tcl_GetVar (interp, "::stloptions.resthcloseedgefac", 0));
      occparam.resthcloseedgeenable =
	atoi (Tcl_GetVar (interp, "::stloptions.resthcloseedgeenable", 0));
    }

int NpInitInterp(Tcl_Interp *interp, int install_tk) {
  Tcl_Preserve((ClientData) interp);
  
  /*
   * Set sharedlib in interp while we are here.  This will be used to
   * base the location of the default pluginX.Y package in the stardll
   * usage scenario.
   */
  if (Tcl_SetVar2(interp, "plugin", "sharedlib", dllName, TCL_GLOBAL_ONLY)
      == NULL) {
    NpPlatformMsg("Failed to set plugin(sharedlib)!", "NpInitInterp");
    return TCL_ERROR;
  }
  
  /*
   * The plugin doesn't directly call Tk C APIs - it's all managed at
   * the Tcl level, so we can just pkg req Tk here instead of calling
   * Tk_InitStubs.
   */
  if (TCL_OK != Tcl_Init(interp)) {
    CONST char *msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
    fprintf(stderr, "GTKWAVE | Tcl_Init error: %s\n", msg) ;
    exit(EXIT_FAILURE);
  }
  if (install_tk) {
    NpLog("Tcl_PkgRequire(\"Tk\", \"%s\", 0)\n", TK_VERSION);
    if (1 && Tcl_PkgRequire(interp, "Tk", TK_VERSION, 0) == NULL) {
      CONST char *msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);      
      NpPlatformMsg(msg, "NpInitInterp Tcl_PkgRequire(Tk)");
      NpPlatformMsg("Failed to create initialize Tk", "NpInitInterp");
      return TCL_ERROR;
    }
  }
  return TCL_OK;
}

static int
ThreadEventProc(
    Tcl_Event *evPtr,		/* Really ThreadEvent */
    int mask)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ThreadEvent *threadEventPtr = (ThreadEvent *)evPtr;
    ThreadEventResult *resultPtr = threadEventPtr->resultPtr;
    Tcl_Interp *interp = tsdPtr->interp;
    int code;
    const char *result, *errorCode, *errorInfo;

    if (interp == NULL) {
	code = TCL_ERROR;
	result = "no target interp!";
	errorCode = "THREAD";
	errorInfo = "";
    } else {
	Tcl_Preserve((ClientData) interp);
	Tcl_ResetResult(interp);
	Tcl_CreateThreadExitHandler(ThreadFreeProc,
		(ClientData) threadEventPtr->script);
	code = Tcl_GlobalEval(interp, threadEventPtr->script);
	Tcl_DeleteThreadExitHandler(ThreadFreeProc,
		(ClientData) threadEventPtr->script);
	if (code != TCL_OK) {
	    errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
	    errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
	} else {
	    errorCode = errorInfo = NULL;
	}
	result = Tcl_GetStringResult(interp);
    }
    ckfree(threadEventPtr->script);
    if (resultPtr) {
	Tcl_MutexLock(&threadMutex);
	resultPtr->code = code;
	resultPtr->result = ckalloc(strlen(result) + 1);
	strcpy(resultPtr->result, result);
	if (errorCode != NULL) {
	    resultPtr->errorCode = ckalloc(strlen(errorCode) + 1);
	    strcpy(resultPtr->errorCode, errorCode);
	}
	if (errorInfo != NULL) {
	    resultPtr->errorInfo = ckalloc(strlen(errorInfo) + 1);
	    strcpy(resultPtr->errorInfo, errorInfo);
	}
	Tcl_ConditionNotify(&resultPtr->done);
	Tcl_MutexUnlock(&threadMutex);
    }
    if (interp != NULL) {
	Tcl_Release((ClientData) interp);
    }
    return 1;
}

/*
 * cat命令处理
 */
int PacketDefCmd::cat_proc(ClientData clientData, Tcl_Interp *interp, int argc,char *argv[])
{
    if(argc < 2)
    {
        //DataLog::insertERROR("cat command wrong, usage: cat 00 11 ...");
        return TCL_ERROR;
    }

    char result[512] = {0} ;
    memset(result,0,argc);
    int pos = 0;

    for(int i=1;i<argc;i++)
    {
        if(argv[i][0] != '$')
        {
            strcpy(result+pos,argv[i]);
            pos += strlen(argv[i]);
        }
        else      //进行值替换
        {
            const char* value = Tcl_GetVar(interp,argv[i]+1,TCL_GLOBAL_ONLY);
            strcpy(result+pos,value);
            pos += strlen(value);
        }
    }

    //interp->result的缺省大小为200字节
    strcpy(interp->result,result);

    //output data log
//    DataLog::insertDEBUG("[cat ...] command success!");

    return TCL_OK;
}

/*
 * header命令处理
 */
int PacketDefCmd::header_proc(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
    //Check the StopTcl flag
    const char* stoptcl = Tcl_GetVar(interp,"StopTcl",TCL_GLOBAL_ONLY);
    if(stoptcl != NULL && (bcmp(stoptcl,"yes",3) == 0))    //TclIntepreter thread stop
        return TCL_BREAK;

    if(argc != 3)
    {
        //DataLog::insertERROR("header command wrong, usage: header name body");
        return TCL_ERROR;
    }

    memset(headerName,0,sizeof(headerName));
    strcpy(headerName,argv[1]);  //save the header name;

    int len = strlen(argv[2]);
    getLine(argv[2],len,interp,0);

    //output data log
    snprintf(logdata,LOGLEN,"header %s {...} command success!",argv[1]);
//    DataLog::insertDEBUG(logdata);

    return TCL_OK;
}

static int echoBegin(sqlite3_vtab *tab){
  int rc;
  echo_vtab *pVtab = (echo_vtab *)tab;
  Tcl_Interp *interp = pVtab->interp;
  const char *zVal; 

  assert( !pVtab->inTransaction );

  if( simulateVtabError(pVtab, "xBegin") ){
    return SQLITE_ERROR;
  }

  rc = echoTransactionCall(tab, "xBegin");

  if( rc==SQLITE_OK ){
    zVal = Tcl_GetVar(interp, "echo_module_begin_fail", TCL_GLOBAL_ONLY);
    if( zVal && 0==strcmp(zVal, pVtab->zTableName) ){
      rc = SQLITE_ERROR;
    }
  }
  if( rc==SQLITE_OK ){
    pVtab->inTransaction = 1;
  }
  return rc;
}

int TCLSH_MAIN(int argc, char **argv){
#ifndef TCL_THREADS
  Tcl_Interp *interp;
  Tcl_FindExecutable(argv[0]);
  interp = Tcl_CreateInterp();
  Libsqlite_Init(interp);
  if( argc>=2 ){
    int i;
    Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
    for(i=2; i<argc; i++){
      Tcl_SetVar(interp, "argv", argv[i],
          TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
    }
    if( Tcl_EvalFile(interp, argv[1])!=TCL_OK ){
      const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
      if( zInfo==0 ) zInfo = interp->result;
      fprintf(stderr,"%s: %s\n", *argv, zInfo);
      return TCL_ERROR;
    }
  }else{
    Tcl_GlobalEval(interp, zMainloop);
  }
  return 0;
#else
  Tcl_Main(argc, argv, Libsqlite_Init);
#endif /* TCL_THREADS */
  return 0;
}

static int echoSync(sqlite3_vtab *tab){
  int rc;
  echo_vtab *pVtab = (echo_vtab *)tab;
  Tcl_Interp *interp = pVtab->interp;
  const char *zVal; 

  /* Ticket #3083 - Only call xSync if we have previously started a
  ** transaction */
  assert( pVtab->inTransaction );

  if( simulateVtabError(pVtab, "xSync") ){
    return SQLITE_ERROR;
  }

  rc = echoTransactionCall(tab, "xSync");

  if( rc==SQLITE_OK ){
    /* Check if the $::echo_module_sync_fail variable is defined. If it is,
    ** and it is set to the name of the real table underlying this virtual
    ** echo module table, then cause this xSync operation to fail.
    */
    zVal = Tcl_GetVar(interp, "echo_module_sync_fail", TCL_GLOBAL_ONLY);
    if( zVal && 0==strcmp(zVal, pVtab->zTableName) ){
      rc = -1;
    }
  }
  return rc;
}

void fetch_param_bool( struct param *p )
{
    const char *str_val;
    int val;
    bool_t no_val = False;

    check_assertion( p->type == PARAM_BOOL, 
		     "configuration parameter type mismatch" );

    str_val = Tcl_GetVar( g_game.tcl_interp, p->name, TCL_GLOBAL_ONLY );
    
    if ( str_val == NULL ) {
	no_val = True;
    } else if ( string_cmp_no_case( str_val, "false" ) == 0 ) {
	p->val.bool_val = False;
    } else if ( string_cmp_no_case( str_val, "true" ) == 0 ) {
	p->val.bool_val = True;
    } else if ( Tcl_GetInt( g_game.tcl_interp, str_val, &val) == TCL_ERROR ) {
	no_val = True;
    } else {
	p->val.bool_val = (val == 0) ? False : True ;
    }

    if ( no_val ) {
	p->val.bool_val = p->deflt.bool_val;
    }

    p->loaded = True;
}

static void
ThreadErrorProc(
    Tcl_Interp *interp)		/* Interp that failed */
{
    Tcl_Channel errChannel;
    const char *errorInfo, *argv[3];
    char *script;
    char buf[TCL_DOUBLE_SPACE+1];
    sprintf(buf, "%ld", (long) Tcl_GetCurrentThread());

    errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
    if (errorProcString == NULL) {
	errChannel = Tcl_GetStdChannel(TCL_STDERR);
	Tcl_WriteChars(errChannel, "Error from thread ", -1);
	Tcl_WriteChars(errChannel, buf, -1);
	Tcl_WriteChars(errChannel, "\n", 1);
	Tcl_WriteChars(errChannel, errorInfo, -1);
	Tcl_WriteChars(errChannel, "\n", 1);
    } else {
	argv[0] = errorProcString;
	argv[1] = buf;
	argv[2] = errorInfo;
	script = Tcl_Merge(3, argv);
	TclThreadSend(interp, errorThreadId, script, 0);
	ckfree(script);
    }
}

static int echoBegin(sqlite3_vtab *tab){
  int rc;
  echo_vtab *pVtab = (echo_vtab *)tab;
  Tcl_Interp *interp = pVtab->interp;
  const char *zVal; 

  /* Ticket #3083 - do not start a transaction if we are already in
  ** a transaction */
  assert( !pVtab->inTransaction );

  if( simulateVtabError(pVtab, "xBegin") ){
    return SQLITE_ERROR;
  }

  rc = echoTransactionCall(tab, "xBegin");

  if( rc==SQLITE_OK ){
    /* Check if the $::echo_module_begin_fail variable is defined. If it is,
    ** and it is set to the name of the real table underlying this virtual
    ** echo module table, then cause this xSync operation to fail.
    */
    zVal = Tcl_GetVar(interp, "echo_module_begin_fail", TCL_GLOBAL_ONLY);
    if( zVal && 0==strcmp(zVal, pVtab->zTableName) ){
      rc = SQLITE_ERROR;
    }
  }
  if( rc==SQLITE_OK ){
    pVtab->inTransaction = 1;
  }
  return rc;
}

static void ThreadErrorProc(Tcl_Interp *interpreter)
{
#ifdef WIN32
/* George Petasis, 21 Feb 2006:
 * Unfortunatelly, I cannot find a way to measure the LONG_MAX characters
 * with Visual C++ preprocessor. char buffer[strlen("")] does nto seem to work
 * with static functions under Visual C++ .NET.*/
    char buffer[15];
#else
    char buffer[strlen(XSTRING(LONG_MAX))];
#endif
    CONST char *errorInformation;
    Tcl_Channel errorChannel;

    errorInformation = Tcl_GetVar(interpreter, "errorInfo", TCL_GLOBAL_ONLY);
    if (errorInformation == 0) {
        errorInformation = "";
    }
    errorChannel = Tcl_GetStdChannel(TCL_STDERR);
    if (errorChannel == NULL) return;
    sprintf(buffer, "%ld", (long)CURRENTTHREAD);
    Tcl_WriteChars(errorChannel, "Error from thread ", -1);
    Tcl_WriteChars(errorChannel, buffer, -1);
    Tcl_WriteChars(errorChannel, "\n", 1);
    Tcl_WriteChars(errorChannel, errorInformation, -1);
    Tcl_WriteChars(errorChannel, "\n", 1);
}

void
gdbtk_interp::pre_command_loop ()
{
  /* We no longer want to use stdin as the command input stream: disable
     events from stdin. */
  main_ui->input_fd = -1;

  if (Tcl_Eval (gdbtk_tcl_interp, "gdbtk_tcl_preloop") != TCL_OK)
    {
      const char *msg;

      /* Force errorInfo to be set up propertly.  */
      Tcl_AddErrorInfo (gdbtk_tcl_interp, "");

      msg = Tcl_GetVar (gdbtk_tcl_interp, "errorInfo", TCL_GLOBAL_ONLY);
#ifdef _WIN32
      MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
#else
      fputs_unfiltered (msg, gdb_stderr);
#endif
    }

#ifdef _WIN32
  close_bfds ();
#endif
}

/*--------------------------------------------------------------------------*/
BOOL TCL_ArrayExist(Tcl_Interp *TCLinterpreter,char *VarName)
{
	BOOL bExist = FALSE;

	if (strcmp(VarName,TCL_VAR_NAME_TMP))
	{
		char MyTclCommand[2048];
		char *StrArrayExist=NULL;

		sprintf(MyTclCommand, "set TclScilabTmpVar [array exists %s];",VarName); 

		if ( Tcl_Eval(TCLinterpreter,MyTclCommand) == TCL_ERROR  )
		{
			Scierror(999,_("Tcl Error : %s\n"),Tcl_GetStringResult(TCLinterpreter));
			return FALSE;
		}

		StrArrayExist = (char *) Tcl_GetVar(TCLinterpreter, TCL_VAR_NAME_TMP,TCL_GLOBAL_ONLY);

		if (StrArrayExist)
		{
			int r  = (int)atoi(StrArrayExist);
			if (r) bExist = TRUE;
			Tcl_UnsetVar(TCLinterpreter,TCL_VAR_NAME_TMP, TCL_GLOBAL_ONLY);
		}
	}

	return bExist;
}