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