C++ Tcl_CreateInterp函数代码示例

static isc_result_t
tcldb_driver_create(isc_mem_t *mctx, tcldb_driver_t **driverp) {
	int tclres;
	isc_result_t result = ISC_R_SUCCESS;
	tcldb_driver_t *driver = isc_mem_get(mctx, sizeof(tcldb_driver_t));
	if (driver == NULL)
		return (ISC_R_NOMEMORY);
	driver->mctx = mctx;
	driver->interp = Tcl_CreateInterp();

	tclres = Tcl_EvalFile(driver->interp, (char *) "lookup.tcl");
	if (tclres != TCL_OK) {
		isc_log_write(dns_lctx, DNS_LOGCATEGORY_GENERAL,
			      DNS_LOGMODULE_SDB, ISC_LOG_ERROR,
			      "initializing tcldb: "
			      "loading 'lookup.tcl' failed: %s",
			      driver->interp->result);
		result = ISC_R_FAILURE;
		goto cleanup;
	}
	*driverp = driver;
	return (ISC_R_SUCCESS);

 cleanup:
	isc_mem_put(mctx, driver, sizeof(tcldb_driver_t));
	return (result);

}

kit::kit()
{
	created++;

	if(interp != NULL)	// already initialized?
		return;

	interp = Tcl_CreateInterp();
	if (Tcl_Init(interp) == TCL_ERROR)
	{
		cerr << "Tcl_Init(interp) failed: " << interp->result << endl;
		exit(1);
	}
	if (Tk_Init(interp) == TCL_ERROR)
	{
		cerr << "Tk_Init(interp) failed: " << interp->result << endl;
		exit(1);
	}
	if (Tix_Init(interp) == TCL_ERROR) 
	{
		cerr << "Tix_Init(interp) failed: " << interp->result << endl;
		exit(1);
	}
	Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);

	/*
	 * We need more X event information that tk can provide, so install
	 * a handler for *each* event, to store a pointer to the Xevent
	 * structure, which has the information we need 
	 */
	Tk_CreateGenericHandler(dispatchX, NULL);
}

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

/* ui admin functions                                                        */
int
ui_init(struct queue_s *channels)
{
    interp = Tcl_CreateInterp();

    priv_c = channels;
 
    if (Tcl_Init(interp) == TCL_ERROR) {
        printf("Failed to initialise Tcl interpreter:\n%s\n",
               (interp)->result);
        return TCL_ERROR;
    }

    if (Tk_Init(interp)  == TCL_ERROR) {
        printf("Failed to initialise Tk package:\n%s\n", 
               (interp)->result);
        return TCL_ERROR;
    }
       
    Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL);

    Tcl_CreateCommand(interp, "get_ports", get_ports, NULL, NULL);
    Tcl_CreateCommand(interp, "update_engine", update_engine, NULL, NULL);
    Tcl_CreateCommand(interp, "query_engine", query_engine, NULL, NULL);
    Tcl_CreateCommand(interp, "ui_exit", ui_exit, NULL, NULL);

    if (Tcl_Eval(interp, &tclscript[0]) != TCL_OK) {
        printf("Failed to run tcl command, error: %s\n", (interp)->result);
        return 0;
    }

    return 1;
}

void task_tcl (void *arg)
{
	unsigned char *cmd;
	unsigned char result, got_partial, quit_flag;
	Tcl_Interp *interp;
	Tcl_CmdBuf buffer;

	configure_ram ();
	mem_init (&pool, (size_t) RAM_START, (size_t) RAM_END);
again:
	debug_printf ("\nEmbedded TCL\n\n");

	interp = Tcl_CreateInterp (&pool);
	Tcl_CreateCommand (interp, (unsigned char*) "loop", loop_cmd, 0, 0);
	Tcl_CreateCommand (interp, (unsigned char*) "echo", echo_cmd, 0, 0);

	buffer = Tcl_CreateCmdBuf (&pool);
	got_partial = 0;
	quit_flag = 0;
	while (! quit_flag) {
/*		clearerr (stdin);*/
		if (! got_partial) {
			debug_puts ("% ");
		}
		if (! debug_gets (line, sizeof (line))) {
			if (! got_partial)
				break;

			line[0] = 0;
		}
		cmd = Tcl_AssembleCmd (buffer, line);
		if (! cmd) {
			got_partial = 1;
			continue;
		}

		got_partial = 0;
		result = Tcl_Eval (interp, cmd, 0, 0);

		if (result != TCL_OK) {
			debug_puts ("Error");

			if (result != TCL_ERROR)
				debug_printf (" %d", result);

			if (*interp->result != 0)
				debug_printf (": %s", interp->result);

			debug_putchar (0, '\n');
			continue;
		}

		if (*interp->result != 0)
			debug_printf ("%s\n", interp->result);
	}

	Tcl_DeleteInterp (interp);
	Tcl_DeleteCmdBuf (buffer);
	goto again;
}

int
main()
{
  int mpi_argc = 0;
  char** mpi_argv = NULL;

  MPI_Init(&mpi_argc, &mpi_argv);

  // Create communicator for ADLB
  MPI_Comm comm;
  MPI_Comm_dup(MPI_COMM_WORLD, &comm);

  // Build up arguments
  int argc = 3;
  const char* argv[argc];
  argv[0] = "howdy";
  argv[1] = "ok";
  argv[2] = "bye";

  Tcl_Interp* interp = Tcl_CreateInterp();
  Tcl_Init(interp);

  Tcl_CreateObjCommand(interp, "ptasks_1_c", ptasks_1,
                       NULL, NULL);

  // Run Turbine
  turbine_code rc =
    turbine_run_interp(comm, "tests/ptasks-1.tcl", argc, argv, NULL,
                       interp);
  assert(rc == TURBINE_SUCCESS);

  MPI_Comm_free(&comm);
  MPI_Finalize();
  return 0;
}

turbine_code turbine_run_string(MPI_Comm comm, const char* script,
                                int argc, const char** argv, char* output,
                                Tcl_Interp* interp)
{
  bool created_interp = false;
  if (interp == NULL)
  {
    // Create Tcl interpreter:
    interp = Tcl_CreateInterp();
    Tcl_Init(interp);
    created_interp = true;
  }
  
  if (comm != MPI_COMM_NULL)
  {
    // Store communicator pointer in Tcl variable for turbine::init
    MPI_Comm* comm_ptr = &comm;
    Tcl_Obj* TURBINE_ADLB_COMM =
        Tcl_NewStringObj("TURBINE_ADLB_COMM", -1);
    Tcl_Obj* adlb_comm_ptr = Tcl_NewLongObj((long) comm_ptr);
    Tcl_ObjSetVar2(interp, TURBINE_ADLB_COMM, NULL, adlb_comm_ptr, 0);
  }

  // Render argc/argv for Tcl
  turbine_tcl_set_integer(interp, "argc", argc);
  Tcl_Obj* argv_obj     = Tcl_NewStringObj("argv", -1);
  Tcl_Obj* argv_val_obj;
  if (argc > 0)
    argv_val_obj = turbine_tcl_list_new(argc, argv);
  else
    argv_val_obj = Tcl_NewStringObj("", 0);
  Tcl_ObjSetVar2(interp, argv_obj, NULL, argv_val_obj, 0);

  if (output != NULL)
    turbine_tcl_set_wideint(interp, "turbine_run_output",
                            (ptrdiff_t) output);

  // Run the user script
  int rc = Tcl_Eval(interp, script);

  // Check for errors
  if (rc != TCL_OK)
  {
    Tcl_Obj* error_dict = Tcl_GetReturnOptions(interp, rc);
    Tcl_Obj* error_info = Tcl_NewStringObj("-errorinfo", -1);
    Tcl_Obj* error_msg;
    Tcl_DictObjGet(interp, error_dict, error_info, &error_msg);
    char* msg_string = Tcl_GetString(error_msg);
    printf("turbine_run(): Tcl error: %s\n", msg_string);
    return TURBINE_ERROR_UNKNOWN;
  }

  if (created_interp)
  {
    // Clean up
    Tcl_DeleteInterp(interp);
  }

  return TURBINE_SUCCESS;
}

int
main(int argc, char **argv)
{
    /*
     * The following #if block allows you to change the AppInit
     * function by using a #define of TCL_LOCAL_APPINIT instead
     * of rewriting this entire file.  The #if checks for that
     * #define and uses Tcl_AppInit if it doesn't exist.
     */

#ifndef TK_LOCAL_APPINIT
#define TK_LOCAL_APPINIT Tcl_AppInit
#endif
    /*
      extern int TK_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
    */

    /*
     * The following #if block allows you to change how Tcl finds the startup
     * script, prime the library or encoding paths, fiddle with the argv,
     * etc., without needing to rewrite Tk_Main()
     */

#ifdef TK_LOCAL_MAIN_HOOK
    extern int TK_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
    TK_LOCAL_MAIN_HOOK(&argc, &argv);
#endif

    Tk_MainOpenSees(argc, argv, TK_LOCAL_APPINIT, Tcl_CreateInterp());
    return 0;  /* Needed only to prevent compiler warning. */
}

rpmtcl rpmtclNew(char ** av, uint32_t flags)
{
    rpmtcl tcl =
#ifdef	NOTYET
	(flags & 0x80000000) ? rpmtclI() :
#endif
	rpmtclGetPool(_rpmtclPool);

#if defined(WITH_TCL)
    static char * _av[] = { "rpmtcl", NULL };
    Tcl_Interp * tclI = Tcl_CreateInterp();
    char b[32];
    int ac;

    if (av == NULL) av = _av;
    ac = argvCount((ARGV_t)av);

    Tcl_SetVar(tclI, "argv", Tcl_Merge(ac-1, (const char *const *)av+1), TCL_GLOBAL_ONLY);
    (void)sprintf(b, "%d", ac-1);
    Tcl_SetVar(tclI, "argc", b, TCL_GLOBAL_ONLY);
    Tcl_SetVar(tclI, "argv0", av[0], TCL_GLOBAL_ONLY);
    Tcl_SetVar(tclI, "tcl_interactive", "0", TCL_GLOBAL_ONLY);

    tcl->I = tclI;
    {	Tcl_Channel tclout = Tcl_GetStdChannel(TCL_STDOUT);
	Tcl_SetChannelOption(tclI, tclout, "-translation", "auto");
	Tcl_StackChannel(tclI, &rpmtclIO, tcl, TCL_WRITABLE, tclout);
	tcl->tclout = (void *) tclout;
    }
#endif
    tcl->iob = rpmiobNew(0);

    return rpmtclLink(tcl);
}

/*-----------------------------------------------------------------------------
 * main --
 *
 * This is the main program for the application.
 *-----------------------------------------------------------------------------
 */
int
main (int    argc,
      char **argv)
{
    TclX_MainEx (argc, argv, TclX_AppInit, Tcl_CreateInterp());

    return 0;                   /* Needed only to prevent compiler warning. */
}

tcl::tcl()
{
	tcl_int = Tcl_CreateInterp();
	curid = 0;

	Tcl_Init(tcl_int);
	Tcl_SetVar(tcl_int, "argv0", "psotnic", TCL_GLOBAL_ONLY);
	addCommands();
}

void
TclInterp::initialize()
{
    if (interp != NULL)
	Tcl_DeleteInterp(interp);

    interp = Tcl_CreateInterp();
    runCallbacks("tcl");
}

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();

   bool have_quit = false;

   Tcl_CreateExitHandler(shell_exit_handler, &have_quit);

   shell_cmd_t shell_cmds[] = {
      CMD(quit,      &have_quit, "Exit simulation"),
      CMD(run,       ctx,        "Start or resume simulation"),
      CMD(restart,   NULL,       "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();

   slave_post_msg(SLAVE_RESTART, NULL, 0);

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

      free(line);
   }

   Tcl_Exit(EXIT_SUCCESS);
}

dfsch_object_t* dfsch_tcl_create_interpreter(){
  Tcl_Interp* i = Tcl_CreateInterp();
  if (Tcl_Init(i) == TCL_ERROR){
    dfsch_tcl_error(i);
  }
  if (Tk_Init(i) == TCL_ERROR){
    dfsch_tcl_error(i);
  }
  return dfsch_tcl_make_interpreter(i);
}

bool ecAdminDialog::EvalTclFile(int nargc, const wxString& Argv, const wxString& msg)
{
    wxProgressDialog dlgWait(msg, _("Please wait..."), 100, this);

    dlgWait.Update(50);

//TRACE (_T("Evaluating ecosadmin.tcl %s\n"), pszArgv);

    // set up the data structure which is passed to the Tcl thread

    wxString strArgc;
    strArgc.Printf (wxT("%d"), nargc);
    std::string argv0 = ecUtils::UnicodeToStdStr (m_strRepository) + "/ecosadmin.tcl";
    std::string argv = ecUtils::UnicodeToStdStr (Argv);
    std::string argc = ecUtils::UnicodeToStdStr (strArgc);

    Tcl_Interp * interp = Tcl_CreateInterp ();

#ifdef __WXMSW__
    Tcl_Channel outchan = Tcl_OpenFileChannel (interp, "nul", "a+", 777);
    Tcl_SetStdChannel (outchan, TCL_STDOUT); // direct standard output to NUL:
#endif

    const char * pszStatus = Tcl_SetVar (interp, "argv0", (char*) argv0.c_str(), 0);
    pszStatus = Tcl_SetVar (interp, "argv", (char*) argv.c_str(), 0);
    pszStatus = Tcl_SetVar (interp, "argc", (char*) argc.c_str(), 0);
    pszStatus = Tcl_SetVar (interp, "gui_mode", "1", 0); // return errors in result string
    int nStatus = Tcl_EvalFile (interp, (char*) argv0.c_str());
    const char* result = Tcl_GetStringResult (interp);

#ifdef __WXMSW__
    Tcl_SetStdChannel (NULL, TCL_STDOUT);
    Tcl_UnregisterChannel (interp, outchan);
#endif

    Tcl_DeleteInterp (interp);

    wxString strErrorMessage (result);

    // report any error
    if (! strErrorMessage.IsEmpty ())
    {
        wxString msg (_("Command execution error:\n\n") + strErrorMessage);
        wxMessageBox(msg, wxGetApp().GetSettings().GetAppName(), wxICON_EXCLAMATION|wxOK);
	return FALSE;
    }
    else if (TCL_OK != nStatus)
    {
        wxString msg (_("Command execution error"));
        wxMessageBox(msg, wxGetApp().GetSettings().GetAppName(), wxICON_EXCLAMATION|wxOK);
    return FALSE;
    }

    return TRUE;
}