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); }
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); }
void free_tpm(void) { if(PlutoInterp) { Tcl_DeleteInterp(PlutoInterp); } PlutoInterp=NULL; }
/* Cleans up after our scripting system. */ void CleanupScripting(void) { if (interp != NULL) { Tcl_DeleteInterp(interp); } }
static void tk_stop(void) { if (interp) { Tcl_DeleteInterp(interp); interp = NULL; } }
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; }
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; }
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(); }
/* *---------------------------------------------------------------------- * * 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; }
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; }
static void DeleteConsoleInterp( ClientData clientData) { Tcl_Interp *interp = clientData; Tcl_DeleteInterp(interp); }
void TclInterp::initialize() { if (interp != NULL) Tcl_DeleteInterp(interp); interp = Tcl_CreateInterp(); runCallbacks("tcl"); }
commandsManager::~commandsManager() { TclCallBack<commandsManager>::unregisterAll(); if (interp && createdInterp) { //Delete the Tcl interpreter Tcl_DeleteInterp(interp); interp = NULL; } }
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 }
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); } }
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; }
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); }
/******************************************************************************************** * 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; }
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; }
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; }
static void ConsoleDeleteProc( ClientData clientData) { ConsoleInfo *info = clientData; if (info->consoleInterp) { Tcl_DeleteInterp(info->consoleInterp); } if (--info->refCount <= 0) { ckfree((char *) info); } }
static void ConsoleDeleteProc( ClientData clientData) { ConsoleInfo *info = clientData; if (info->consoleInterp) { Tcl_DeleteInterp(info->consoleInterp); } if (info->refCount-- <= 1) { ckfree(info); } }
/* * 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; }
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); }
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); }
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' **/
/* ** 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; }
/* 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; }
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; }
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); }