Class TclTkIp
In: tcltklib/tcltklib.c
Parent: Object

Methods

Public Class methods

new(...)

Public Instance methods

_conv_listelement(p1)
_eval(p1)
_fromUTF8(...)
_get_global_var(p1)
_get_global_var2(p1, p2)

access Tcl variables

[Source]

/* 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_variable2(p1, p2, p3)
_invoke(...)
_merge_tklist(...)

get return code from Tcl_Eval()

[Source]

/* 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));
}
_set_global_var(p1, p2)
_set_global_var2(p1, p2, p3)
_set_variable(p1, p2, p3)
_set_variable2(p1, p2, p3, p4)
_split_tklist(p1)
_thread_tkwait(p1, p2)
_thread_vwait(p1)
_toUTF8(...)
_unset_global_var(p1)
_unset_global_var2(p1, p2)
_unset_variable(p1, p2)
_unset_variable2(p1, p2, p3)

allow_ruby_exit = mode

[Source]

/* 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?

[Source]

/* 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;
    }
}
create_slave(...)

delete interpreter

[Source]

/* 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?

[Source]

/* 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;
    }
}
do_one_event(...)
get_eventloop_tick()
get_eventloop_weight()
get_no_event_wait()
mainloop(...)
mainloop_abort_on_exception()
mainloop_abort_on_exception=(p1)
mainloop_watchdog(...)

make ip "safe"

[Source]

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

is safe?

[Source]

/* 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;
    }
}
set_eventloop_tick(p1)
set_eventloop_weight(p1, p2)
set_max_block_time(p1)
set_no_event_wait(p1)

[Validate]