Пример #1
0
void
weechat_tcl_unload (struct t_plugin_script *script)
{
    Tcl_Interp* interp;
    int *rc;

    if ((weechat_tcl_plugin->debug >= 1) || !tcl_quiet)
    {
        weechat_printf (NULL,
                        weechat_gettext ("%s: unloading script \"%s\""),
                        TCL_PLUGIN_NAME, script->name);
    }

    if (script->shutdown_func && script->shutdown_func[0])
    {
        rc = (int *)weechat_tcl_exec (script,
                                      WEECHAT_SCRIPT_EXEC_INT,
                                      script->shutdown_func,
                                      NULL, NULL);
        if (rc)
            free (rc);
    }

    interp = (Tcl_Interp*)script->interpreter;

    if (tcl_current_script == script)
        tcl_current_script = (tcl_current_script->prev_script) ?
            tcl_current_script->prev_script : tcl_current_script->next_script;

    script_remove (weechat_tcl_plugin, &tcl_scripts, &last_tcl_script, script);

    Tcl_DeleteInterp(interp);
}
Пример #2
0
int
exit_tk()
{
  int code;

  if (Tk_GetNumMainWindows() > 0) {
    sprintf(tcl_command_buffer, "done_calculation");
    code = Tcl_Eval(interp, tcl_command_buffer);
    if (code != TCL_OK) {
      fprintf(stderr, "in Tcl_Eval: %s\n", interp->result);
      return code;
    }
  }

  while (Tk_GetNumMainWindows() > 0) {
    sprintf(tcl_command_buffer, "tkwait variable window_changed");
    code = Tcl_Eval(interp, tcl_command_buffer);
    if (code != TCL_OK) {
      fprintf(stderr, "in Tcl_Eval: %s\n", interp->result);
      return code;
    }
    draw_graph(maxstep);
  }

  sprintf(tcl_command_buffer, "exit");
  Tcl_Eval(interp, tcl_command_buffer);
  Tcl_DeleteInterp(interp);
}
Пример #3
0
void free_tpm(void)
{
    if(PlutoInterp) {
	Tcl_DeleteInterp(PlutoInterp);
    }
    PlutoInterp=NULL;
}
Пример #4
0
/* Cleans up after our scripting system. */
void CleanupScripting(void)
{
    if (interp != NULL) {
	Tcl_DeleteInterp(interp);
    }

}
Пример #5
0
static void tk_stop(void)
{
  if (interp) {
    Tcl_DeleteInterp(interp);
    interp = NULL;
  }
}
Пример #6
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;
}
Пример #7
0
static AP_Result tcl_delete(AP_World *w, AP_Obj interp_name)
{
	Tcl_HashEntry *entry;
	Tcl_Interp *interp;

	if (AP_ObjType(w, interp_name) != AP_ATOM) {
		return AP_SetStandardError(w, AP_TYPE_ERROR,
					AP_NewSymbolFromStr(w, "atom"), interp_name);
	}
	
	entry = Tcl_FindHashEntry(&tcl_interp_name_table, AP_GetAtomStr(w, interp_name));
	
	if (!entry) {
		return AP_SetStandardError(w, AP_DOMAIN_ERROR,
					AP_NewSymbolFromStr(w, "tcl_interpreter"), interp_name);
	}
	
	interp = Tcl_GetHashValue(entry);
	
	Tcl_DeleteInterp(interp);
	
	Tcl_DeleteHashEntry(entry);
	
	return AP_SUCCESS;
}
Пример #8
0
void ScriptTcl::run() {
#else
void ScriptTcl::run(char *scriptFile) {

  if ( NULL == scriptFile || NULL == (config = new ConfigList(scriptFile)) ) {
    NAMD_die("Simulation config file is empty.");
  }
#endif

  if (initWasCalled == 0) {
    initcheck();
    SimParameters *simParams = Node::Object()->simParameters;
    if ( simParams->minimizeCGOn ) runController(SCRIPT_MINIMIZE);
    else runController(SCRIPT_RUN);
    runWasCalled = 1;
  }

#if CMK_HAS_PARTITION
  replica_barrier();
#endif
  runController(SCRIPT_END);

}

ScriptTcl::~ScriptTcl() {
  DebugM(3,"Destructing ScriptTcl\n");
#ifdef NAMD_TCL
  if ( interp ) Tcl_DeleteInterp(interp);
  delete [] callbackname;
#endif

  molfile_dcdplugin_fini();
}
Пример #9
0
/*
 *----------------------------------------------------------------------
 *
 * MainEx -- Main program for Tk-based applications.
 *
 *----------------------------------------------------------------------
 */
void
MainEx( int argc, char** argv, Tcl_AppInitProc *appInitProc,
        Tcl_Interp *pintrp, char *fileName )
{
    int code;

    (*appInitProc)(pintrp);

    if ( Commands_Init(pintrp) != TCL_OK) 
        Panic (pintrp,"Can't initialise commands!");

    char set_path[1000];
    strcat( strcat( strcpy( set_path, "set ::image_path \"" ), module_path ), "\"" );
    code = Tcl_Eval( pintrp, set_path );
    
    if (fileName != NULL) 
    {
        char  script[1000];
        strcat( strcat( strcpy( script, module_path ), "" ), fileName );
        code = Tcl_EvalFile(pintrp, script);
        if (code != TCL_OK)
            Panic (pintrp,"Evaluate file error!");
    }
    else Tcl_SourceRCFile(pintrp);

    Tcl_ResetResult(pintrp);

    Tk_MainLoop();
    
    Tcl_DeleteInterp(pintrp);
    return;
}
Пример #10
0
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;
}
Пример #11
0
static void
DeleteConsoleInterp(
    ClientData clientData)
{
    Tcl_Interp *interp = clientData;

    Tcl_DeleteInterp(interp);
}
Пример #12
0
void
TclInterp::initialize()
{
    if (interp != NULL)
	Tcl_DeleteInterp(interp);

    interp = Tcl_CreateInterp();
    runCallbacks("tcl");
}
Пример #13
0
commandsManager::~commandsManager()
{
	 TclCallBack<commandsManager>::unregisterAll();
	 if (interp && createdInterp)
	 {
			//Delete the Tcl interpreter
			Tcl_DeleteInterp(interp);
			interp = NULL;
	 }
}
Пример #14
0
TclTextInterp::~TclTextInterp() {
  // Set callback variable, giving a chance for Tcl to do some clean-ups
  // (for example, if external jobs have been run and need to be halted...)
  setString("vmd_quit", "1");
  
  // DeleteInterp must precede Finalize!
  Tcl_DeleteInterp(interp);
  interp = NULL; // prevent use by Python if Tcl_Finalize() invokes
                 // shutdown scripts
}
Пример #15
0
kit::~kit()
{
	deleted++;
	if(deleted == created)	// last interpreter?
	{
		for(map<int, binding *, less<int> >::iterator i = fd_table.begin(); i != fd_table.end(); i++)
			unbind((*i).first);
		Tcl_DeleteInterp(interp);
	}
}
Пример #16
0
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;
}
Пример #17
0
void Panic (Tcl_Interp * pintrp, const char * pch)
{
    printf("Thread %P:",Tcl_GetCurrentThread());
    printf(pch);
    printf("\n    Reason:");
    printf(pintrp->result);
    printf("\n");

    Tcl_DeleteInterp(pintrp);
    Tcl_Exit(1);
}
Пример #18
0
/********************************************************************************************
 * test_Quit
 * purpose : This function is called when the test application is closed from the GUI.
 *           It is responsible for closing the application gracefully.
 * syntax  : test.Quit
 * input   : clientData - used for creating new command in tcl
 *           interp - interpreter for tcl commands
 *           argc - number of parameters entered to the new command
 *           argv - the parameters entered to the tcl command
 * output  : none
 * return  : TCL_OK
 ********************************************************************************************/
int test_Quit(ClientData clientData, Tcl_Interp *interp,int argc, char *argv[])
{
    TclExecute("init:SaveOptions 0");

    /* We should kill the stack only after we save the application's options */
    EndStack();

    /* Finish with the interperter */
    Tcl_DeleteInterp(interp);
    exit(0);
    return TCL_OK;
}
Пример #19
0
Файл: test.c Проект: dup2X/gcti
int main() {
	Tcl_Interp *pTclInterp = Tcl_CreateInterp();
    if(!pTclInterp)
    {
            printf("Tcl Interpreter could not be created.\n");
            return 0;
    }
    Tcl_Eval(pTclInterp," package req Expect");
    printf("%s",pTclInterp->result);
    Tcl_Eval(pTclInterp," puts \"Hello ,world !\"");
    Tcl_DeleteInterp(pTclInterp);
    return 0;
}
Пример #20
0
static void rpmtclFini(void * _tcl)
        /*@globals fileSystem @*/
        /*@modifies *_tcl, fileSystem @*/
{
    rpmtcl tcl = (rpmtcl) _tcl;

#if defined(WITH_TCL)
    Tcl_DeleteInterp((Tcl_Interp *)tcl->I);
#endif
    tcl->I = NULL;
    (void)rpmiobFree(tcl->iob);
    tcl->iob = NULL;
}
Пример #21
0
static void
ConsoleDeleteProc(
    ClientData clientData)
{
    ConsoleInfo *info = clientData;

    if (info->consoleInterp) {
	Tcl_DeleteInterp(info->consoleInterp);
    }
    if (--info->refCount <= 0) {
	ckfree((char *) info);
    }
}
Пример #22
0
static void
ConsoleDeleteProc(
    ClientData clientData)
{
    ConsoleInfo *info = clientData;

    if (info->consoleInterp) {
	Tcl_DeleteInterp(info->consoleInterp);
    }
    if (info->refCount-- <= 1) {
	ckfree(info);
    }
}
Пример #23
0
/*
 * Display error message and quit (see "z-util.c")
 */
static void hook_quit(cptr str)
{
	(void) str;

	Icon_Exit();
	
	/* cleanup_angband(); */
	
	/* Cleanup Tcl and Tk */
	Tcl_DeleteInterp(g_interp);
	
	/* Hack - no longer hook tcl memory routines */
	rnfree_aux = NULL;
}
Пример #24
0
static void
FreeMainInterp(
    ClientData clientData)
{
    Tcl_Interp *interp = clientData;

    /*if (TclInExit()) return;*/

    if (!Tcl_InterpDeleted(interp)) {
	Tcl_DeleteInterp(interp);
    }
    Tcl_SetStartupScript(NULL, NULL);
    Tcl_Release(interp);
}
Пример #25
0
void XG_Quit()
{
  Quit();
  if (theCodeName) free(theCodeName);
  if (theInputFile) free(theInputFile);
  if (theDumpFile) free(theDumpFile);
  if (theEPSFile) free(theEPSFile);
  if (theRunWithXFlag == TRUE) {
    Tcl_DeleteInterp(interp);
    XFreeFont(theDisplay,theFontStruct);
    XCloseDisplay(theDisplay);
  }
  exit(0);
}
Пример #26
0
void EM_DeleteInterp(Tcl_Interp *interp) {

#if WITH_DEBUGGING_INIT
    ErrorLogger( NO_ERR_START, LOC, _proc_EM_DeleteInterp, NULL);
#endif

    /*
     * avoid freeing storage when in use, now release
     */
    Tcl_Release(interp);

    Tcl_DeleteInterp(interp);

} /** End of 'EM_DeleteInterp' **/
Пример #27
0
/*
** The main function for threads created with [sqlthread spawn].
*/
static Tcl_ThreadCreateType tclScriptThread(ClientData pSqlThread){
  Tcl_Interp *interp;
  Tcl_Obj *pRes;
  Tcl_Obj *pList;
  int rc;
  SqlThread *p = (SqlThread *)pSqlThread;
  extern int Sqlitetest_mutex_Init(Tcl_Interp*);

  interp = Tcl_CreateInterp();
  Tcl_CreateObjCommand(interp, "clock_seconds", clock_seconds_proc, 0, 0);
  Tcl_CreateObjCommand(interp, "sqlthread", sqlthread_proc, pSqlThread, 0);
#if SQLITE_OS_UNIX && defined(SQLITE_ENABLE_UNLOCK_NOTIFY)
  Tcl_CreateObjCommand(interp, "sqlite3_blocking_step", blocking_step_proc,0,0);
  Tcl_CreateObjCommand(interp, 
      "sqlite3_blocking_prepare_v2", blocking_prepare_v2_proc, (void *)1, 0);
  Tcl_CreateObjCommand(interp, 
      "sqlite3_nonblocking_prepare_v2", blocking_prepare_v2_proc, 0, 0);
#endif
  Sqlitetest1_Init(interp);
  Sqlitetest_mutex_Init(interp);
  Sqlite3_Init(interp);

  rc = Tcl_Eval(interp, p->zScript);
  pRes = Tcl_GetObjResult(interp);
  pList = Tcl_NewObj();
  Tcl_IncrRefCount(pList);
  Tcl_IncrRefCount(pRes);

  if( rc!=TCL_OK ){
    Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj("error", -1));
    Tcl_ListObjAppendElement(interp, pList, pRes);
    postToParent(p, pList);
    Tcl_DecrRefCount(pList);
    pList = Tcl_NewObj();
  }

  Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj("set", -1));
  Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj(p->zVarname, -1));
  Tcl_ListObjAppendElement(interp, pList, pRes);
  postToParent(p, pList);

  ckfree((void *)p);
  Tcl_DecrRefCount(pList);
  Tcl_DecrRefCount(pRes);
  Tcl_DeleteInterp(interp);
  while( Tcl_DoOneEvent(TCL_ALL_EVENTS|TCL_DONT_WAIT) );
  Tcl_ExitThread(0);
  TCL_THREAD_CREATE_RETURN;
}
Пример #28
0
/* Tcl functions implemented in C                                            */
static int 
ui_exit(ClientData clientData,
        Tcl_Interp *interp,
        int argc,
        char *argv[])
{
    Tcl_DeleteInterp(interp);
    interp = NULL;
    exit_now = 1;

    UNUSED(clientData);
    UNUSED(argc);
    UNUSED(argv);
    return 0;
}
Пример #29
0
static AP_Result tcl_delete_all(AP_World *ignore)
{
	Tcl_HashEntry *entry;
	Tcl_HashSearch search;

	for (entry = Tcl_FirstHashEntry(&tcl_interp_name_table, &search);
		entry; entry = Tcl_NextHashEntry(&search)) {
		Tcl_DeleteInterp(Tcl_GetHashValue(entry)); 
	}
	
	Tcl_DeleteHashTable(&tcl_interp_name_table);
	
	Tcl_InitHashTable(&tcl_interp_name_table, TCL_STRING_KEYS);

	return AP_SUCCESS;
}
Пример #30
0
static void
OptionInit(
    register TkMainInfo *mainPtr)
				/* Top-level information about window that
				 * isn't initialized yet. */
{
    int i;
    Tcl_Interp *interp;
    ThreadSpecificData *tsdPtr =
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    Element *defaultMatchPtr = &tsdPtr->defaultMatch;

    /*
     * First, once-only initialization.
     */

    if (tsdPtr->initialized == 0) {
	tsdPtr->initialized = 1;
	tsdPtr->cachedWindow = NULL;
	tsdPtr->numLevels = 5;
	tsdPtr->curLevel = -1;
	tsdPtr->serial = 0;

	tsdPtr->levels = (StackLevel *)
		ckalloc((unsigned) (5*sizeof(StackLevel)));
	for (i = 0; i < NUM_STACKS; i++) {
	    tsdPtr->stacks[i] = NewArray(10);
	    tsdPtr->levels[0].bases[i] = 0;
	}

	defaultMatchPtr->nameUid = NULL;
	defaultMatchPtr->child.valueUid = NULL;
	defaultMatchPtr->priority = -1;
	defaultMatchPtr->flags = 0;
	Tcl_CreateThreadExitHandler(OptionThreadExitProc, NULL);
    }

    /*
     * Then, per-main-window initialization. Create and delete dummy
     * interpreter for message logging.
     */

    mainPtr->optionRootPtr = NewArray(20);
    interp = Tcl_CreateInterp();
    GetDefaultOptions(interp, mainPtr->winPtr);
    Tcl_DeleteInterp(interp);
}