Class | TclTkIp |
In: |
tcltklib/tcltklib.c
|
Parent: | Object |
initialize interpreter
/* initialize interpreter */ static VALUE ip_init(argc, argv, self) int argc; VALUE *argv; VALUE self; { struct tcltkip *ptr; /* tcltkip data struct */ VALUE argv0, opts; int cnt; int st; int with_tk = 1; Tk_Window mainWin = (Tk_Window)NULL; /* security check */ if (ruby_safe_level >= 4) { rb_raise(rb_eSecurityError, "Cannot create a TclTkIp object at level %d", ruby_safe_level); } /* create object */ Data_Get_Struct(self, struct tcltkip, ptr); ptr = ALLOC(struct tcltkip); DATA_PTR(self) = ptr; ptr->ref_count = 0; ptr->allow_ruby_exit = 1; ptr->return_value = 0; /* from Tk_Main() */ DUMP1("Tcl_CreateInterp"); ptr->ip = ruby_tcl_create_ip_and_stubs_init(&st); if (ptr->ip == NULL) { switch(st) { case TCLTK_STUBS_OK: break; case NO_TCL_DLL: rb_raise(rb_eLoadError, "tcltklib: fail to open tcl_dll"); case NO_FindExecutable: rb_raise(rb_eLoadError, "tcltklib: can't find Tcl_FindExecutable"); case NO_CreateInterp: rb_raise(rb_eLoadError, "tcltklib: can't find Tcl_CreateInterp()"); case NO_DeleteInterp: rb_raise(rb_eLoadError, "tcltklib: can't find Tcl_DeleteInterp()"); case FAIL_CreateInterp: rb_raise(rb_eRuntimeError, "tcltklib: fail to create a new IP"); case FAIL_Tcl_InitStubs: rb_raise(rb_eRuntimeError, "tcltklib: fail to Tcl_InitStubs()"); default: rb_raise(rb_eRuntimeError, "tcltklib: unknown error(%d) on ruby_tcl_create_ip_and_stubs_init", st); } } #if TCL_MAJOR_VERSION >= 8 #if TCL_NAMESPACE_DEBUG DUMP1("get current namespace"); if ((ptr->default_ns = Tcl_GetCurrentNamespace(ptr->ip)) == (Tcl_Namespace*)NULL) { rb_raise(rb_eRuntimeError, "a new Tk interpreter has a NULL namespace"); } #endif #endif rbtk_preserve_ip(ptr); DUMP2("IP ref_count = %d", ptr->ref_count); current_interp = ptr->ip; ptr->has_orig_exit = Tcl_GetCommandInfo(ptr->ip, "exit", &(ptr->orig_exit_info)); /* from Tcl_AppInit() */ DUMP1("Tcl_Init"); if (Tcl_Init(ptr->ip) == TCL_ERROR) { rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip)); } /* set variables */ cnt = rb_scan_args(argc, argv, "02", &argv0, &opts); switch(cnt) { case 2: /* options */ if (NIL_P(opts) || opts == Qfalse) { /* without Tk */ with_tk = 0; } else { /* Tcl_SetVar(ptr->ip, "argv", StringValuePtr(opts), 0); */ Tcl_SetVar(ptr->ip, "argv", StringValuePtr(opts), TCL_GLOBAL_ONLY); } case 1: /* argv0 */ if (!NIL_P(argv0)) { if (strncmp(StringValuePtr(argv0), "-e", 3) == 0 || strncmp(StringValuePtr(argv0), "-", 2) == 0) { Tcl_SetVar(ptr->ip, "argv0", "ruby", TCL_GLOBAL_ONLY); } else { /* Tcl_SetVar(ptr->ip, "argv0", StringValuePtr(argv0), 0); */ Tcl_SetVar(ptr->ip, "argv0", StringValuePtr(argv0), TCL_GLOBAL_ONLY); } } case 0: /* no args */ ; } /* from Tcl_AppInit() */ if (with_tk) { DUMP1("Tk_Init"); st = ruby_tk_stubs_init(ptr->ip); switch(st) { case TCLTK_STUBS_OK: break; case NO_Tk_Init: rb_raise(rb_eLoadError, "tcltklib: can't find Tk_Init()"); case FAIL_Tk_Init: rb_raise(rb_eRuntimeError, "tcltklib: fail to Tk_Init(). %s", Tcl_GetStringResult(ptr->ip)); case FAIL_Tk_InitStubs: rb_raise(rb_eRuntimeError, "tcltklib: fail to Tk_InitStubs(). %s", Tcl_GetStringResult(ptr->ip)); default: rb_raise(rb_eRuntimeError, "tcltklib: unknown error(%d) on ruby_tk_stubs_init", st); } DUMP1("Tcl_StaticPackage(\"Tk\")"); #if TCL_MAJOR_VERSION >= 8 Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init, Tk_SafeInit); #else /* TCL_MAJOR_VERSION < 8 */ Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL); #endif /* get main window */ mainWin = Tk_MainWindow(ptr->ip); Tk_Preserve((ClientData)mainWin); } /* add ruby command to the interpreter */ #if TCL_MAJOR_VERSION >= 8 DUMP1("Tcl_CreateObjCommand(\"ruby\")"); Tcl_CreateObjCommand(ptr->ip, "ruby", ip_ruby_eval, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); DUMP1("Tcl_CreateObjCommand(\"ruby_eval\")"); Tcl_CreateObjCommand(ptr->ip, "ruby_eval", ip_ruby_eval, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); DUMP1("Tcl_CreateObjCommand(\"ruby_cmd\")"); Tcl_CreateObjCommand(ptr->ip, "ruby_cmd", ip_ruby_cmd, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); #else /* TCL_MAJOR_VERSION < 8 */ DUMP1("Tcl_CreateCommand(\"ruby\")"); Tcl_CreateCommand(ptr->ip, "ruby", ip_ruby_eval, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); DUMP1("Tcl_CreateCommand(\"ruby_eval\")"); Tcl_CreateCommand(ptr->ip, "ruby_eval", ip_ruby_eval, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); DUMP1("Tcl_CreateCommand(\"ruby_cmd\")"); Tcl_CreateCommand(ptr->ip, "ruby_cmd", ip_ruby_cmd, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); #endif /* add 'interp_exit', 'ruby_exit' and replace 'exit' command */ #if TCL_MAJOR_VERSION >= 8 DUMP1("Tcl_CreateObjCommand(\"interp_exit\")"); Tcl_CreateObjCommand(ptr->ip, "interp_exit", ip_InterpExitObjCmd, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); DUMP1("Tcl_CreateObjCommand(\"ruby_exit\")"); Tcl_CreateObjCommand(ptr->ip, "ruby_exit", ip_RubyExitObjCmd, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); DUMP1("Tcl_CreateObjCommand(\"exit\") --> \"ruby_exit\""); Tcl_CreateObjCommand(ptr->ip, "exit", ip_RubyExitObjCmd, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #else /* TCL_MAJOR_VERSION < 8 */ DUMP1("Tcl_CreateCommand(\"interp_exit\")"); Tcl_CreateCommand(ptr->ip, "interp_exit", ip_InterpExitCommand, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); DUMP1("Tcl_CreateCommand(\"ruby_exit\")"); Tcl_CreateCommand(ptr->ip, "ruby_exit", ip_RubyExitCommand, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); DUMP1("Tcl_CreateCommand(\"exit\") --> \"ruby_exit\""); Tcl_CreateCommand(ptr->ip, "exit", ip_RubyExitCommand, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #endif /* replace vwait and tkwait */ ip_replace_wait_commands(ptr->ip, mainWin); /* wrap namespace command */ ip_wrap_namespace_command(ptr->ip); /* set finalizer */ Tcl_CallWhenDeleted(ptr->ip, ip_CallWhenDeleted, (ClientData)mainWin); if (mainWin != (Tk_Window)NULL) { Tk_Release((ClientData)mainWin); } return self; }
get return code from Tcl_Eval()
/* get return code from Tcl_Eval() */ static VALUE ip_retval(self) VALUE self; { struct tcltkip *ptr; /* tcltkip data struct */ /* get the data strcut */ ptr = get_ip(self); /* ip is deleted? */ if (deleted_ip(ptr)) { return rb_tainted_str_new2(""); } return (INT2FIX(ptr->return_value)); }
allow_ruby_exit = mode
/* allow_ruby_exit = mode */ static VALUE ip_allow_ruby_exit_set(self, val) VALUE self, val; { struct tcltkip *ptr = get_ip(self); Tk_Window mainWin; rb_secure(4); /* ip is deleted? */ if (deleted_ip(ptr)) { rb_raise(rb_eRuntimeError, "interpreter is deleted"); } if (Tcl_IsSafe(ptr->ip)) { rb_raise(rb_eSecurityError, "insecure operation on a safe interpreter"); } mainWin = (tk_stubs_init_p())? Tk_MainWindow(ptr->ip): (Tk_Window)NULL; if (RTEST(val)) { ptr->allow_ruby_exit = 1; #if TCL_MAJOR_VERSION >= 8 DUMP1("Tcl_CreateObjCommand(\"exit\") --> \"ruby_exit\""); Tcl_CreateObjCommand(ptr->ip, "exit", ip_RubyExitObjCmd, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #else /* TCL_MAJOR_VERSION < 8 */ DUMP1("Tcl_CreateCommand(\"exit\") --> \"ruby_exit\""); Tcl_CreateCommand(ptr->ip, "exit", ip_RubyExitCommand, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #endif return Qtrue; } else { ptr->allow_ruby_exit = 0; #if TCL_MAJOR_VERSION >= 8 DUMP1("Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\""); Tcl_CreateObjCommand(ptr->ip, "exit", ip_InterpExitObjCmd, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #else /* TCL_MAJOR_VERSION < 8 */ DUMP1("Tcl_CreateCommand(\"exit\") --> \"interp_exit\""); Tcl_CreateCommand(ptr->ip, "exit", ip_InterpExitCommand, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #endif return Qfalse; } }
/* allow_ruby_exit? */ static VALUE ip_allow_ruby_exit_p(self) VALUE self; { struct tcltkip *ptr = get_ip(self); /* ip is deleted? */ if (deleted_ip(ptr)) { rb_raise(rb_eRuntimeError, "interpreter is deleted"); } if (ptr->allow_ruby_exit) { return Qtrue; } else { return Qfalse; } }
delete interpreter
/* delete interpreter */ static VALUE ip_delete(self) VALUE self; { int thr_crit_bup; struct tcltkip *ptr = get_ip(self); Tcl_CmdInfo info; if (ptr == (struct tcltkip *)NULL || ptr->ip == (Tcl_Interp*)NULL) { DUMP1("delete deleted IP"); return Qnil; } thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; DUMP1("call ip_finalize"); ip_finalize(ptr->ip); DUMP1("delete interp"); Tcl_DeleteInterp(ptr->ip); Tcl_Release(ptr->ip); ptr->ip = (Tcl_Interp*)NULL; rb_thread_critical = thr_crit_bup; return Qnil; }
is deleted?
/* is deleted? */ static VALUE ip_has_invalid_namespace_p(self) VALUE self; { struct tcltkip *ptr = get_ip(self); if (ptr == (struct tcltkip *)NULL || ptr->ip == (Tcl_Interp *)NULL) { /* deleted IP */ return Qtrue; } #if TCL_NAMESPACE_DEBUG if (rbtk_invalid_namespace(ptr)) { return Qtrue; } else { return Qfalse; } #else return Qfalse; #endif }