C++ Tcl_GetStringResult函数代码示例

	virtual void OnKick(const CNick& OpNick, const CString& sKickedNick, CChan& Channel, const CString& sMessage) {
		CString sOpNick = TclEscape(CString(OpNick.GetNick()));
		CString sNick = TclEscape(sKickedNick);
		CString sOpHost = TclEscape(CString(OpNick.GetIdent() + "@" + OpNick.GetHost()));

		CString sCommand = "Binds::ProcessKick {" + sOpNick + "} {" + sOpHost + "} - {" + Channel.GetName() + "} {" + sNick + "} {" + sMessage + "}";
		i = Tcl_Eval(interp, sCommand.c_str());
		if (i != TCL_OK) {
			PutModule(Tcl_GetStringResult(interp));
		}
	}

/*
** This routine is invoked as the 'progress callback' for the database.
*/
static int DbProgressHandler(void *cd){
  SqliteDb *pDb = (SqliteDb*)cd;
  int rc;

  assert( pDb->zProgress );
  rc = Tcl_Eval(pDb->interp, pDb->zProgress);
  if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
    return 1;
  }
  return 0;
}

int ScriptTcl::eval(const char *script, const char **resultPtr) {

#ifdef NAMD_TCL
  int code = Tcl_EvalEx(interp,script,-1,TCL_EVAL_GLOBAL);
  *resultPtr = Tcl_GetStringResult(interp);
  return code;
#else
  NAMD_bug("ScriptTcl::eval called without Tcl.");
  return -1;  // appease compiler
#endif
}

static ngx_int_t
ngx_tcl_init(ngx_conf_t *cf)
{
    ngx_tcl_interp_conf_t *iconf;
    int rc;
    int i;

printf("%s\n", __FUNCTION__); fflush(stdout);

    if (interp_confs != NULL) {
        Tcl_FindExecutable(NULL);
    }

    for (iconf = interp_confs; iconf != NULL; iconf = iconf->next) {
        iconf->interp = Tcl_CreateInterp();
        rc = Tcl_Init(iconf->interp);
        if (rc != TCL_OK) {
            ngx_conf_log_error(NGX_LOG_EMERG, cf, 0,
                "tcl error: %s", Tcl_GetStringResult(iconf->interp));
            return NGX_ERROR;
        }

        for (i = 0; commands[i].name; ++i) {
            Tcl_CreateObjCommand(iconf->interp, commands[i].name,
                commands[i].cmd, iconf, NULL);
        }

        rc = Tcl_Eval(iconf->interp, (char*)iconf->initscript.data);
        if (rc != TCL_OK) {
            ngx_conf_log_error(NGX_LOG_EMERG, cf, 0,
                "tcl error: %s\n%s\n",
                Tcl_GetStringResult(iconf->interp),
                Tcl_GetVar(iconf->interp, "errorInfo", TCL_GLOBAL_ONLY)
            );

            return NGX_ERROR;
        }
    }

    return NGX_OK;
}

static void
imfsample_add_imf(Imfsample *imfsample, const char *imfname)
{
    int i;
    ImageFamily *imf = NULL;
    char tclbuf[100];
    int rslt;

    if (strcmp(imfname, "-all") == 0) {
	imfsample->numimages = 0;
	for (i = 0; i < numimages; ++i) {
	    if (imfsample->imfapp) {
		sprintf(tclbuf, 
".closeup.content itemconfigure status -text \"Loading %s\"", 
			images[i]->name);
		rslt = Tcl_Eval(interp, tclbuf);
		if (rslt == TCL_ERROR) {
		    fprintf(stderr, "Error: %s\n", Tcl_GetStringResult(interp));
		}
		sprintf(tclbuf, "update idletasks");
		rslt = Tcl_Eval(interp, tclbuf);
		if (rslt == TCL_ERROR) {
		    fprintf(stderr, "Error: %s\n", Tcl_GetStringResult(interp));
		}
	    }
	    imf = tk_find_imf(images[i]->name);
	    if (imf == NULL) {
		fprintf(stderr, "Missing imf %s\n", imfname);
		return;
	    }
	    imfsample->imf_list[imfsample->numimages++] = images[i];
	}
	return;
    }
    imf = tk_find_imf(imfname);
    if (imf == NULL) {
	fprintf(stderr, "Missing imf %s\n", imfname);
	return;
    }
    imfsample->imf_list[imfsample->numimages++] = imf;
}

//-----------------------------------------------------------------------
extern "C" int If_GetString(const char *name, const char **val)
{
  if (!theInterp)
    return IF_ERROR;

  if (Tcl_Eval(theInterp, (char *)name) != TCL_OK) {
    val = NULL;
    return IF_ERROR;
  }
  *val = Tcl_GetStringResult(theInterp);
  return IF_OK;
}

/*
 * plot vertical contigs and deal with diagonal line in dot plot
 */
void
update_contig_comparator(Tcl_Interp *interp,
			 GapIO *io,
			 obj_cs *cs)
{
    int win_wd;
    char cmd[1024];

    Tcl_VarEval(interp, "winfo width ", cs->vert, NULL);
    win_wd = atoi(Tcl_GetStringResult(interp));

    display_contigs(interp, io, cs->vert, cs->line_colour, cs->line_width,
		    cs->tick->line_width, cs->tick->ht, win_wd/2, "vertical");

    scaleSingleCanvas(interp, cs->world, cs->canvas, cs->vert, 'y', "all");

    sprintf(cmd, "DisplayDiagonal %s %s %d", cs->frame, cs->window,
	    *handle_io(io));
    if (TCL_ERROR == Tcl_Eval(interp, cmd))
	printf("update_contig_comparator: %s\n", Tcl_GetStringResult(interp));

}

void screen_tcl(ESContext *esContext) {
	static uint8_t startup = 0;
	if (startup == 0) {
		startup = 1;
		char scriptfile[1024];
		sprintf(scriptfile, "%s/scripts/screen_tcl.tcl", BASE_DIR);
		tcl_runFile(scriptfile);
		if (Tcl_Eval(tcl_interp, "init") != TCL_OK) {
			SDL_Log("TCL-ERROR:\n");
			SDL_Log("#######################################################\n");
			SDL_Log("%s\n", Tcl_GetStringResult(tcl_interp));
			SDL_Log("#######################################################\n");
		}
	}
	tcl_update_modeldata();
	if (Tcl_Eval(tcl_interp, "view") != TCL_OK) {
		SDL_Log("TCL-ERROR:\n");
		SDL_Log("#######################################################\n");
		SDL_Log("%s\n", Tcl_GetStringResult(tcl_interp));
		SDL_Log("#######################################################\n");
	}
}

/* Executes a script in our customized interpreter. Returns 0 on success.
   Returns -1 and prints a message on standard error on failure.

   We'll use this to preload the procedures in the script. The interpreter's
   state is maintained after Tcl_EvalFile. We will NOT call Tcl_EvalFile after
   each frame - that would be hideously slow. */
int LoadGameScript(char *filename)
{
    int status;

    status = Tcl_EvalFile(interp, filename);
    if (status != TCL_OK) {
	fprintf(stderr, "Error executing %s: %s\n", filename,
		Tcl_GetStringResult(interp));
	return -1;
    }

    return 0;
}

	virtual EModRet OnChanMsg(CNick& Nick, CChan& Channel, CString& sMessage) {
		CString sMes = TclEscape(sMessage);
		CString sNick = TclEscape(CString(Nick.GetNick()));
		CString sHost = TclEscape(CString(Nick.GetIdent() + "@" + Nick.GetHost()));
		CString sChannel = TclEscape(CString(Channel.GetName()));

		CString sCommand = "Binds::ProcessPubm {" + sNick + "} {" + sHost + "} - {" + sChannel + "} {" + sMes + "}";
		i = Tcl_Eval(interp, sCommand.c_str());
		if (i != TCL_OK) {
			PutModule(Tcl_GetStringResult(interp));
		}
		return CONTINUE;
	}

void driver_plot_icon(double x, double y, const char *icon)
{
    char buf[1024];
    int xi, yi;

    G_plot_where_xy(x, y, &xi, &yi);

    sprintf(buf,
	    ".screen.canvas create bitmap %d %d -bitmap @$iconpath/%s.xbm -foreground %s -anchor center",
	    xi, yi, icon, color);
    if (Tcl_Eval(Toolbox, buf) != TCL_OK)
	G_warning("driver_plot_icon: %s", Tcl_GetStringResult(Toolbox));
}

void tcl_run(char *script) {
	if (tcl_startup == 0) {
		tcl_init();
	}
	tcl_update_modeldata();
	if (Tcl_Eval(tcl_interp, script) != TCL_OK) {
		SDL_Log("TCL-ERROR:\n");
		SDL_Log("#######################################################\n");
		SDL_Log("%s\n", script);
		SDL_Log("#######################################################\n");
		SDL_Log("%s\n", Tcl_GetStringResult(tcl_interp));
		SDL_Log("#######################################################\n");
	}
}

void shell_run(tree_t e, struct tree_rd_ctx *ctx)
{
   const int ndecls = tree_decls(e);
   hash_t *decl_hash = hash_new(ndecls * 2, true);
   for (int i = 0; i < ndecls; i++) {
      tree_t d = tree_decl(e, i);
      hash_put(decl_hash, tree_ident(d), d);
   }

   Tcl_Interp *interp = Tcl_CreateInterp();

   shell_cmd_t shell_cmds[] = {
      CMD(quit,      NULL,       "Exit simulation"),
      CMD(run,       NULL,       "Start or resume simulation"),
      CMD(restart,   e,          "Restart simulation"),
      CMD(show,      decl_hash,  "Display simulation objects"),
      CMD(help,      shell_cmds, "Display this message"),
      CMD(copyright, NULL,       "Display copyright information"),
      CMD(signals,   e,          "Find signal objects in the design"),
      CMD(now,       NULL,       "Display current simulation time"),
      CMD(watch,     decl_hash,  "Trace changes to a signal"),
      CMD(unwatch,   decl_hash,  "Stop tracing signals"),

      { NULL, NULL, NULL, NULL}
   };

   qsort(shell_cmds, ARRAY_LEN(shell_cmds) - 1, sizeof(shell_cmd_t),
         compare_shell_cmd);

   for (shell_cmd_t *c = shell_cmds; c->name != NULL; c++)
      Tcl_CreateObjCommand(interp, c->name, c->fn, c->cd, NULL);

   show_banner();

   char *line;
   while ((line = shell_get_line())) {
      switch (Tcl_Eval(interp, line)) {
      case TCL_OK:
         break;
      case TCL_ERROR:
         errorf("%s", Tcl_GetStringResult(interp));
         break;
      }

      free(line);
   }

   printf("\nBye.\n");
   Tcl_Finalize();
}

void TclTextInterp::graph_label_cb(const char *type, const int *ids, int n) {
  Tcl_Obj *itemlist = Tcl_NewListObj(0, NULL);
  for (int i=0; i<n; i++) {
    Tcl_Obj *item = Tcl_NewListObj(0, NULL);
    Tcl_ListObjAppendElement(interp, item, Tcl_NewStringObj(type, -1));
    Tcl_ListObjAppendElement(interp, item, Tcl_NewIntObj(ids[i]));
    Tcl_ListObjAppendElement(interp, itemlist, item);
  }
  Tcl_Obj *varname = Tcl_NewStringObj("vmd_graph_label", -1);
  if (!Tcl_ObjSetVar2(interp, varname, NULL, itemlist, 
        TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY)) {
    msgErr << "Error graphing labels: " << Tcl_GetStringResult(interp) << sendmsg;
  }
}

static void expandPercentsEval(Tcl_Interp * interp,	/* interpreter context */
			       register char *before,	/* Command with percent expressions */
			       char *r,	/* vgpaneHandle string to substitute for "%r" */
			       int npts,	/* number of coordinates */
			       point * ppos	/* Cordinates to substitute for %t */
    )
{
    register char *string;
    Tcl_DString scripts;

    Tcl_DStringInit(&scripts);
    while (1) {
	/*
	 * Find everything up to the next % character and append it to the
	 * result string.
	 */

	for (string = before; (*string != 0) && (*string != '%'); string++) {
	    /* Empty loop body. */
	}
	if (string != before) {
	    Tcl_DStringAppend(&scripts, before, string - before);
	    before = string;
	}
	if (*before == 0) {
	    break;
	}
	/*
	 * There's a percent sequence here.  Process it.
	 */

	switch (before[1]) {
	case 'r':
	    Tcl_DStringAppend(&scripts, r, strlen(r));	/* vgcanvasHandle */
	    break;
	case 't':
	    dgsprintxy(&scripts, npts, ppos);
	    break;
	default:
	    Tcl_DStringAppend(&scripts, before + 1, 1);
	    break;
	}
	before += 2;
    }
    if (Tcl_GlobalEval(interp, Tcl_DStringValue(&scripts)) != TCL_OK)
	fprintf(stderr, "%s while in binding: %s\n\n",
		Tcl_GetStringResult(interp), Tcl_DStringValue(&scripts));
    Tcl_DStringFree(&scripts);
}