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