| Class | TclTkIp |
| In: |
tcltklib/tcltklib.c
|
| Parent: | Object |
access Tcl variables
/* access Tcl variables */
static VALUE
ip_get_variable(self, varname_arg, flag_arg)
VALUE self;
VALUE varname_arg;
VALUE flag_arg;
{
struct tcltkip *ptr = get_ip(self);
int thr_crit_bup;
volatile VALUE varname, flag;
varname = varname_arg;
flag = flag_arg;
StringValue(varname);
#if TCL_MAJOR_VERSION >= 8
{
Tcl_Obj *nameobj, *ret;
char *s;
int len;
volatile VALUE strval;
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
nameobj = Tcl_NewStringObj(RSTRING(varname)->ptr,
RSTRING(varname)->len);
Tcl_IncrRefCount(nameobj);
/* ip is deleted? */
if (Tcl_InterpDeleted(ptr->ip)) {
DUMP1("ip is deleted");
Tcl_DecrRefCount(nameobj);
rb_thread_critical = thr_crit_bup;
return rb_tainted_str_new2("");
} else {
/* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
ret = Tcl_ObjGetVar2(ptr->ip, nameobj, (Tcl_Obj*)NULL,
FIX2INT(flag));
}
Tcl_DecrRefCount(nameobj);
if (ret == (Tcl_Obj*)NULL) {
volatile VALUE exc;
#if TCL_MAJOR_VERSION >= 8
exc = rb_exc_new2(rb_eRuntimeError, Tcl_GetStringResult(ptr->ip));
#else /* TCL_MAJOR_VERSION < 8 */
exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result);
#endif
/* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup;
rb_exc_raise(exc);
}
Tcl_IncrRefCount(ret);
# if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
s = Tcl_GetStringFromObj(ret, &len);
strval = rb_tainted_str_new(s, len);
Tcl_DecrRefCount(ret);
/* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup;
return(strval);
# else /* TCL_VERSION >= 8.1 */
if (Tcl_GetCharLength(ret)
!= Tcl_UniCharLen(Tcl_GetUnicode(ret))) {
/* possibly binary string */
s = Tcl_GetByteArrayFromObj(ret, &len);
strval = rb_tainted_str_new(s, len);
rb_ivar_set(strval, ID_at_enc, rb_tainted_str_new2("binary"));
} else {
/* possibly text string */
s = Tcl_GetStringFromObj(ret, &len);
strval = rb_tainted_str_new(s, len);
}
Tcl_DecrRefCount(ret);
/* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup;
return(strval);
# endif
}
#else /* TCL_MAJOR_VERSION < 8 */
{
char *ret;
/* ip is deleted? */
if (Tcl_InterpDeleted(ptr->ip)) {
DUMP1("ip is deleted");
return rb_tainted_str_new2("");
} else {
/* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
ret = Tcl_GetVar2(ptr->ip, RSTRING(varname)->ptr,
(char*)NULL, FIX2INT(flag));
}
if (ret == (char*)NULL) {
volatile VALUE exc;
#if TCL_MAJOR_VERSION >= 8
exc = rb_exc_new2(rb_eRuntimeError, Tcl_GetStringResult(ptr->ip));
#else /* TCL_MAJOR_VERSION < 8 */
exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result);
#endif
/* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup;
rb_exc_raise(exc);
}
strval = rb_tainted_str_new2(ret);
/* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
rb_thread_critical = thr_crit_bup;
return(strval);
}
#endif
}
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 (Tcl_InterpDeleted(ptr->ip)) {
DUMP1("ip is deleted");
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 (Tcl_InterpDeleted(ptr->ip)) {
DUMP1("ip is deleted");
rb_raise(rb_eRuntimeError, "interpreter is deleted");
}
if (Tcl_IsSafe(ptr->ip)) {
rb_raise(rb_eSecurityError,
"insecure operation on a safe interpreter");
}
mainWin = Tk_MainWindow(ptr->ip);
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 (Tcl_InterpDeleted(ptr->ip)) {
DUMP1("ip is deleted");
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;
{
struct tcltkip *ptr = get_ip(self);
/* Tcl_Preserve(ptr->ip); */
rbtk_preserve_ip(ptr);
#if TCL_MAJOR_VERSION < 8 || ( TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 4)
#else
if (!Tcl_InterpDeleted(ptr->ip)) {
Tcl_Eval(ptr->ip, "foreach i [after info] { after cancel $i }");
}
#endif
del_root(ptr->ip);
DUMP1("delete interp");
while(!Tcl_InterpDeleted(ptr->ip)) {
DUMP1("wait ip is deleted");
Tcl_DeleteInterp(ptr->ip);
}
/* Tcl_Release(ptr->ip); */
rbtk_release_ip(ptr);
return Qnil;
}
is deleted?
/* is deleted? */
static VALUE
ip_is_deleted_p(self)
VALUE self;
{
struct tcltkip *ptr = get_ip(self);
if (Tcl_InterpDeleted(ptr->ip)) {
return Qtrue;
} else {
return Qfalse;
}
}
make ip "safe"
/* make ip "safe" */
static VALUE
ip_make_safe(self)
VALUE self;
{
struct tcltkip *ptr = get_ip(self);
Tk_Window mainWin;
/* ip is deleted? */
if (Tcl_InterpDeleted(ptr->ip)) {
DUMP1("ip is deleted");
rb_raise(rb_eRuntimeError, "interpreter is deleted");
}
if (Tcl_MakeSafe(ptr->ip) == TCL_ERROR) {
#if TCL_MAJOR_VERSION >= 8
rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
#endif
}
ptr->allow_ruby_exit = 0;
/* replace 'exit' command --> 'interp_exit' command */
mainWin = Tk_MainWindow(ptr->ip);
#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 self;
}
is safe?
/* is safe? */
static VALUE
ip_is_safe_p(self)
VALUE self;
{
struct tcltkip *ptr = get_ip(self);
/* ip is deleted? */
if (Tcl_InterpDeleted(ptr->ip)) {
DUMP1("ip is deleted");
rb_raise(rb_eRuntimeError, "interpreter is deleted");
}
if (Tcl_IsSafe(ptr->ip)) {
return Qtrue;
} else {
return Qfalse;
}
}