TclTkIp ^(Class)

/* 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;
	VALUE strval;

	thr_crit_bup = rb_thread_critical;
	rb_thread_critical = Qtrue;

	nameobj = Tcl_NewStringObj(RSTRING(varname)->ptr, 
				   RSTRING(varname)->len);
	Tcl_IncrRefCount(nameobj);

	ret = Tcl_ObjGetVar2(ptr->ip, nameobj, (Tcl_Obj*)NULL, FIX2INT(flag));

	Tcl_DecrRefCount(nameobj);

	rb_thread_critical = thr_crit_bup;

	if (ret == (Tcl_Obj*)NULL) {
#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
	}

	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);
	return(strval);
# else /* TCL_VERSION >= 8.1 */
	{
	    thr_crit_bup = rb_thread_critical;
	    rb_thread_critical = Qtrue;

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

	    rb_thread_critical = thr_crit_bup;
	}

	Tcl_DecrRefCount(ret);
	return(strval);
# endif
    }
#else /* TCL_MAJOR_VERSION < 8 */
    {
	char *ret;

	ret = Tcl_GetVar2(ptr->ip, RSTRING(varname)->ptr, 
			  (char*)NULL, FIX2INT(flag));
	if (ret == (char*)NULL) {
	    rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
	}
	return(rb_tainted_str_new2(ret));
    }
#endif
}

/* 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);

    return (INT2FIX(ptr->return_value));
}

/* delete interpreter */
static VALUE
ip_delete(self)
    VALUE self;
{
    struct tcltkip *ptr = get_ip(self);

    Tcl_DeleteInterp(ptr->ip);

    return Qnil;
}

/* 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" */
static VALUE
ip_make_safe(self)
    VALUE self;
{
    struct tcltkip *ptr = get_ip(self);
    
    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
    }

    return self;
}

/* is safe? */
static VALUE
ip_is_safe_p(self)
    VALUE self;
{
    struct tcltkip *ptr = get_ip(self);
    
    if (Tcl_IsSafe(ptr->ip)) {
	return Qtrue;
    } else {
	return Qfalse;
    }
}