diff options
-rw-r--r-- | ChangeLog | 33 | ||||
-rw-r--r-- | ext/tk/lib/multi-tk.rb | 4 | ||||
-rw-r--r-- | ext/tk/lib/tk.rb | 4 | ||||
-rw-r--r-- | ext/tk/lib/tk/variable.rb | 11 | ||||
-rw-r--r-- | ext/tk/sample/tktree.rb | 2 | ||||
-rw-r--r-- | ext/tk/stubs.c | 428 | ||||
-rw-r--r-- | ext/tk/stubs.h | 33 | ||||
-rw-r--r-- | ext/tk/tcltklib.c | 500 | ||||
-rw-r--r-- | ext/tk/tkutil/tkutil.c | 26 |
9 files changed, 836 insertions, 205 deletions
@@ -1,3 +1,36 @@ +Thu Jul 28 18:09:55 2005 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> + + * ext/tk/stubs.c: When --enable-tcltk-stubs, the initialize + routine creates a Tcl/Tk interpreter and deletes it. However, + init cost of Tk's MainWindow is not so small. And that makes it + impossible to use libraries written with Tcl functions only on + an environment without a graphical display. This changes support + delaying initalization of Tk_Stubs until the script needs Tk. + + * ext/tk/stubs.h: New file. Define prototypes and return codes of + functions on stubs.c. + + * ext/tk/tcltklib.c: Support delaying initalization of Tk_Stubs + until the script needs Tk. + + * ext/tk/tcltklib.c: Show friendly error messages for errors on + initialization. + + * ext/tk/tcltklib.c: Avoid SEGV on ip_finalize() when ruby is + exiting and $DEBUG is true. (Not fix. If you know the reason of + why, please fix it.) + + * ext/tk/tkutil/tkutil.c (ary2list, ary2list2): bug fix on handling + of encoding. + + * ext/tk/lib/multi-tk.rb: MultiTkIp#eval_string and bg_eval_string + don't work propery. + + * ext/tk/lib/tk.rb: Forget extending Tk::Encoding module to Tk. + + * ext/tk/lib/tk/variable.rb: TkVarAccess fails to initialize the + object for an element of a Tcl's array variable. + Thu Jul 28 17:23:37 2005 Yukihiro Matsumoto <matz@ruby-lang.org> * parse.y (f_larglist): allow block argument in lambda parameter diff --git a/ext/tk/lib/multi-tk.rb b/ext/tk/lib/multi-tk.rb index 8ef3aa62bf..c82fa8f4e3 100644 --- a/ext/tk/lib/multi-tk.rb +++ b/ext/tk/lib/multi-tk.rb @@ -1579,7 +1579,7 @@ class MultiTkIp proc{|safe| $SAFE=safe if $SAFE < safe Kernel.eval(cmd, *eval_args) - }, safe_level) + }) end alias eval_str eval_string @@ -1593,7 +1593,7 @@ class MultiTkIp proc{|safe| $SAFE=safe if $SAFE < safe Kernel.eval(cmd, *eval_args) - }, safe_level) + }) } end alias background_eval_string bg_eval_string diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb index 174d34ceaa..37f311c6f2 100644 --- a/ext/tk/lib/tk.rb +++ b/ext/tk/lib/tk.rb @@ -2325,6 +2325,8 @@ else end alias encoding_convert_to encoding_convertto end + + extend Encoding end end @@ -4199,7 +4201,7 @@ end #Tk.freeze module Tk - RELEASE_DATE = '2005-07-25'.freeze + RELEASE_DATE = '2005-07-28'.freeze autoload :AUTO_PATH, 'tk/variable' autoload :TCL_PACKAGE_PATH, 'tk/variable' diff --git a/ext/tk/lib/tk/variable.rb b/ext/tk/lib/tk/variable.rb index 4cf2eae8ed..33cf603a92 100644 --- a/ext/tk/lib/tk/variable.rb +++ b/ext/tk/lib/tk/variable.rb @@ -1531,7 +1531,16 @@ class TkVarAccess<TkVariable @element_type = Hash.new{|k,v| var.default_value_type } # teach Tk-ip that @id is global var - INTERP._invoke_without_enc('global', @id) + begin + INTERP._invoke_without_enc('global', @id) + rescue => e + if @id =~ /^(.+)\([^()]+\)$/ + # is an element --> varname == $1 + INTERP._invoke_without_enc('global', $1) + else + fail e + end + end if val if val.kind_of?(Hash) diff --git a/ext/tk/sample/tktree.rb b/ext/tk/sample/tktree.rb index d16d3344bd..56b7211c88 100644 --- a/ext/tk/sample/tktree.rb +++ b/ext/tk/sample/tktree.rb @@ -25,7 +25,7 @@ class TkTree < TkCanvas end begin tk_call('::tktree::treecreate', *args) - rescue NameError + rescue NameError, RuntimeError Tk.load_tclscript(TkTree::TCL_SCRIPT_PATH) tk_call('::tktree::treecreate', *args) end diff --git a/ext/tk/stubs.c b/ext/tk/stubs.c index 3913abb570..e8b05355a9 100644 --- a/ext/tk/stubs.c +++ b/ext/tk/stubs.c @@ -1,7 +1,30 @@ -int ruby_tcltk_stubs(); +#include "stubs.h" +#include "ruby.h" +#include <tcl.h> +#include <tk.h> + +/*------------------------------*/ + +#ifdef __MACOS__ +# include <tkMac.h> +# include <Quickdraw.h> + +static int call_macinit = 0; + +static void +_macinit() +{ + if (!call_macinit) { + tcl_macQdPtr = &qd; /* setup QuickDraw globals */ + Tcl_MacSetEventProc(TkMacConvertEvent); /* setup event handler */ + call_macinit = 1; + } +} +#endif + +/*------------------------------*/ #if defined USE_TCL_STUBS && defined USE_TK_STUBS -#include "ruby.h" #if defined _WIN32 || defined __CYGWIN__ # include "util.h" @@ -26,42 +49,33 @@ int ruby_tcltk_stubs(); # define TK_NAME "libtk8.9%s" #endif -#include <tcl.h> -#include <tk.h> +static DL_HANDLE tcl_dll = (DL_HANDLE)0; +static DL_HANDLE tk_dll = (DL_HANDLE)0; int -ruby_tcltk_stubs() +ruby_open_tcl_dll(appname) + char *appname; { - DL_HANDLE tcl_dll; - DL_HANDLE tk_dll; void (*p_Tcl_FindExecutable)(const char *); - Tcl_Interp *(*p_Tcl_CreateInterp)(); - int (*p_Tk_Init)(Tcl_Interp *); - Tcl_Interp *tcl_ip; int n; char *ruby_tcl_dll = 0; - char *ruby_tk_dll = 0; char tcl_name[20]; - char tk_name[20]; + + if (tcl_dll) return TCLTK_STUBS_OK; ruby_tcl_dll = getenv("RUBY_TCL_DLL"); #if defined _WIN32 if (ruby_tcl_dll) ruby_tcl_dll = ruby_strdup(ruby_tcl_dll); #endif - ruby_tk_dll = getenv("RUBY_TK_DLL"); - if (ruby_tcl_dll && ruby_tk_dll) { + if (ruby_tcl_dll) { tcl_dll = (DL_HANDLE)DL_OPEN(ruby_tcl_dll); - tk_dll = (DL_HANDLE)DL_OPEN(ruby_tk_dll); } else { snprintf(tcl_name, sizeof tcl_name, TCL_NAME, DLEXT); - snprintf(tk_name, sizeof tk_name, TK_NAME, DLEXT); /* examine from 8.9 to 8.1 */ for (n = '9'; n > '0'; n--) { tcl_name[TCL_INDEX] = n; - tk_name[TK_INDEX] = n; tcl_dll = (DL_HANDLE)DL_OPEN(tcl_name); - tk_dll = (DL_HANDLE)DL_OPEN(tk_name); - if (tcl_dll && tk_dll) + if (tcl_dll) break; } } @@ -70,35 +84,377 @@ ruby_tcltk_stubs() if (ruby_tcl_dll) ruby_xfree(ruby_tcl_dll); #endif - if (!tcl_dll || !tk_dll) - return -1; + if (!tcl_dll) + return NO_TCL_DLL; p_Tcl_FindExecutable = (void (*)(const char *))DL_SYM(tcl_dll, "Tcl_FindExecutable"); if (!p_Tcl_FindExecutable) - return -7; + return NO_FindExecutable; - p_Tcl_FindExecutable("ruby"); + if (appname) { + p_Tcl_FindExecutable(appname); + } else { + p_Tcl_FindExecutable("ruby"); + } - p_Tcl_CreateInterp = (Tcl_Interp *(*)())DL_SYM(tcl_dll, "Tcl_CreateInterp"); - if (!p_Tcl_CreateInterp) - return -2; + return TCLTK_STUBS_OK; +} - tcl_ip = (*p_Tcl_CreateInterp)(); - if (!tcl_ip) - return -3; +int +ruby_open_tk_dll() +{ + int n; + char *ruby_tk_dll = 0; + char tk_name[20]; - p_Tk_Init = (int (*)(Tcl_Interp *))DL_SYM(tk_dll, "Tk_Init"); - if (!p_Tk_Init) - return -4; - (*p_Tk_Init)(tcl_ip); + if (!tcl_dll) { + int ret = ruby_open_tcl_dll(RSTRING(rb_argv0)->ptr); + if (ret != TCLTK_STUBS_OK) return ret; + } + + if (tk_dll) return TCLTK_STUBS_OK; + + ruby_tk_dll = getenv("RUBY_TK_DLL"); + if (ruby_tk_dll) { + tk_dll = (DL_HANDLE)DL_OPEN(ruby_tk_dll); + } else { + snprintf(tk_name, sizeof tk_name, TK_NAME, DLEXT); + /* examine from 8.9 to 8.1 */ + for (n = '9'; n > '0'; n--) { + tk_name[TK_INDEX] = n; + tk_dll = (DL_HANDLE)DL_OPEN(tk_name); + if (tk_dll) + break; + } + } + + if (!tk_dll) + return NO_TK_DLL; + + return TCLTK_STUBS_OK; +} + +int +ruby_open_tcltk_dll(appname) + char *appname; +{ + return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() ); +} + +int +tcl_stubs_init_p() +{ + return(tclStubsPtr != (TclStubs*)NULL); +} + +int +tk_stubs_init_p() +{ + return(tkStubsPtr != (TkStubs*)NULL); +} + + +Tcl_Interp * +ruby_tcl_create_ip_and_stubs_init(st) + int *st; +{ + if (st) *st = 0; + + if (tcl_stubs_init_p()) { + return Tcl_CreateInterp(); + } else { + Tcl_Interp *(*p_Tcl_CreateInterp)(); + Tcl_Interp *(*p_Tcl_DeleteInterp)(); + Tcl_Interp *tcl_ip; + + if (!tcl_dll) { + int ret = ruby_open_tcl_dll(RSTRING(rb_argv0)->ptr); + if (ret != TCLTK_STUBS_OK) { + if (st) *st = ret; + return (Tcl_Interp*)NULL; + } + } + + p_Tcl_CreateInterp + = (Tcl_Interp *(*)())DL_SYM(tcl_dll, "Tcl_CreateInterp"); + if (!p_Tcl_CreateInterp) { + if (st) *st = NO_CreateInterp; + return (Tcl_Interp*)NULL; + } + + p_Tcl_DeleteInterp + = (Tcl_Interp *(*)())DL_SYM(tcl_dll, "Tcl_DeleteInterp"); + if (!p_Tcl_DeleteInterp) { + if (st) *st = NO_DeleteInterp; + return (Tcl_Interp*)NULL; + } + + tcl_ip = (*p_Tcl_CreateInterp)(); + if (!tcl_ip) { + if (st) *st = FAIL_CreateInterp; + return (Tcl_Interp*)NULL; + } + + if (!Tcl_InitStubs(tcl_ip, "8.1", 0)) { + if (st) *st = FAIL_Tcl_InitStubs; + (*p_Tcl_DeleteInterp)(tcl_ip); + return (Tcl_Interp*)NULL; + } + + return tcl_ip; + } +} + +int +ruby_tcl_stubs_init() +{ + int st; + Tcl_Interp *tcl_ip; + + if (!tcl_stubs_init_p()) { + tcl_ip = ruby_tcl_create_ip_and_stubs_init(&st); + + if (!tcl_ip) return st; + + Tcl_DeleteInterp(tcl_ip); + } + + return TCLTK_STUBS_OK; +} + +int +ruby_tk_stubs_init(tcl_ip) + Tcl_Interp *tcl_ip; +{ + Tcl_ResetResult(tcl_ip); + + if (tk_stubs_init_p()) { + if (Tk_Init(tcl_ip) == TCL_ERROR) { + return FAIL_Tk_Init; + } + } else { + int (*p_Tk_Init)(Tcl_Interp *); + + if (!tk_dll) { + int ret = ruby_open_tk_dll(); + if (ret != TCLTK_STUBS_OK) return ret; + } + + p_Tk_Init = (int (*)(Tcl_Interp *))DL_SYM(tk_dll, "Tk_Init"); + if (!p_Tk_Init) + return NO_Tk_Init; + + if ((*p_Tk_Init)(tcl_ip) == TCL_ERROR) + return FAIL_Tk_Init; + + if (!Tk_InitStubs(tcl_ip, "8.1", 0)) + return FAIL_Tk_InitStubs; + +#ifdef __MACOS__ + _macinit(); +#endif + } + + return TCLTK_STUBS_OK; +} + +int +ruby_tk_stubs_safeinit(tcl_ip) + Tcl_Interp *tcl_ip; +{ + Tcl_ResetResult(tcl_ip); + + if (tk_stubs_init_p()) { + if (Tk_SafeInit(tcl_ip) == TCL_ERROR) + return FAIL_Tk_Init; + } else { + int (*p_Tk_SafeInit)(Tcl_Interp *); + + if (!tk_dll) { + int ret = ruby_open_tk_dll(); + if (ret != TCLTK_STUBS_OK) return ret; + } + + p_Tk_SafeInit = (int (*)(Tcl_Interp *))DL_SYM(tk_dll, "Tk_SafeInit"); + if (!p_Tk_SafeInit) + return NO_Tk_Init; + + if ((*p_Tk_SafeInit)(tcl_ip) == TCL_ERROR) + return FAIL_Tk_Init; + + if (!Tk_InitStubs(tcl_ip, "8.1", 0)) + return FAIL_Tk_InitStubs; + +#ifdef __MACOS__ + _macinit(); +#endif + } + + return TCLTK_STUBS_OK; +} - if (!Tcl_InitStubs(tcl_ip, "8.1", 0)) - return -5; - if (!Tk_InitStubs(tcl_ip, "8.1", 0)) +int +ruby_tcltk_stubs() +{ + int st; + Tcl_Interp *tcl_ip; + + st = ruby_open_tcltk_dll(RSTRING(rb_argv0)->ptr); + switch(st) { + case NO_FindExecutable: + return -7; + case NO_TCL_DLL: + case NO_TK_DLL: + return -1; + } + + tcl_ip = ruby_tcl_create_ip_and_stubs_init(&st); + if (!tcl_ip) { + switch(st) { + case NO_CreateInterp: + case NO_DeleteInterp: + return -2; + case FAIL_CreateInterp: + return -3; + case FAIL_Tcl_InitStubs: + return -5; + } + } + + st = ruby_tk_stubs_init(tcl_ip); + switch(st) { + case NO_Tk_Init: + Tcl_DeleteInterp(tcl_ip); + return -4; + case FAIL_Tk_Init: + case FAIL_Tk_InitStubs: + Tcl_DeleteInterp(tcl_ip); return -6; + } Tcl_DeleteInterp(tcl_ip); return 0; } + +/*###################################################*/ +#else /* ! USE_TCL_STUBS || ! USE_TK_STUBS) */ +/*###################################################*/ + +static int open_tcl_dll = 0; +static int call_tk_stubs_init = 0; + +int +ruby_open_tcl_dll(appname) + char *appname; +{ + if (appname) { + Tcl_FindExecutable(appname); + } else { + Tcl_FindExecutable("ruby"); + } + open_tcl_dll = 1; + + return TCLTK_STUBS_OK; +} + +int ruby_open_tk_dll() +{ + if (!open_tcl_dll) { + ruby_open_tcl_dll(RSTRING(rb_argv0)->ptr); + } + + return TCLTK_STUBS_OK; +} + +int ruby_open_tcltk_dll(appname) + char *appname; +{ + return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() ); +} + +int +tcl_stubs_init_p() +{ + return 1; +} + +int +tk_stubs_init_p() +{ + return call_tk_stubs_init; +} + +Tcl_Interp * +ruby_tcl_create_ip_and_stubs_init(st) + int *st; +{ + Tcl_Interp *tcl_ip; + + if (!open_tcl_dll) { + ruby_open_tcl_dll(RSTRING(rb_argv0)->ptr); + } + + if (st) *st = 0; + tcl_ip = Tcl_CreateInterp(); + if (!tcl_ip) { + if (st) *st = FAIL_CreateInterp; + return (Tcl_Interp*)NULL; + } + return tcl_ip; +} + +int +ruby_tcl_stubs_init() +{ + return TCLTK_STUBS_OK; +} + +int +ruby_tk_stubs_init(tcl_ip) + Tcl_Interp *tcl_ip; +{ + if (Tk_Init(tcl_ip) == TCL_ERROR) + return FAIL_Tk_Init; + + if (!call_tk_stubs_init) { +#ifdef __MACOS__ + _macinit(); +#endif + call_tk_stubs_init = 1; + } + + return TCLTK_STUBS_OK; +} + +int +ruby_tk_stubs_safeinit(tcl_ip) + Tcl_Interp *tcl_ip; +{ +#if TCL_MAJOR_VERSION >= 8 + if (Tk_SafeInit(tcl_ip) == TCL_ERROR) + return FAIL_Tk_Init; + + if (!call_tk_stubs_init) { +#ifdef __MACOS__ + _macinit(); +#endif + call_tk_stubs_init = 1; + } + + return TCLTK_STUBS_OK; + +#else /* TCL_MAJOR_VERSION < 8 */ + + return FAIL_Tk_Init; +#endif +} + +int +ruby_tcltk_stubs() +{ + Tcl_FindExecutable(RSTRING(rb_argv0)->ptr); + return 0; +} + #endif diff --git a/ext/tk/stubs.h b/ext/tk/stubs.h new file mode 100644 index 0000000000..7c913fb393 --- /dev/null +++ b/ext/tk/stubs.h @@ -0,0 +1,33 @@ +#include <tcl.h> + +extern int ruby_open_tcl_dll(char *); +extern int ruby_open_tk_dll(); +extern int ruby_open_tcltk_dll(char *); +extern int tcl_stubs_init_p(); +extern int tk_stubs_init_p(); +extern Tcl_Interp *ruby_tcl_create_ip_and_stubs_init(int*); +extern int ruby_tcl_stubs_init(); +extern int ruby_tk_stubs_init(Tcl_Interp*); +extern int ruby_tk_stubs_safeinit(Tcl_Interp*); +extern int ruby_tcltk_stubs(); + +/* no error */ +#define TCLTK_STUBS_OK (0) + +/* return value of ruby_open_tcl_dll() */ +#define NO_TCL_DLL (1) +#define NO_FindExecutable (2) + +/* return value of ruby_open_tk_dll() */ +#define NO_TK_DLL (-1) + +/* status value of ruby_tcl_create_ip_and_stubs_init(st) */ +#define NO_CreateInterp (3) +#define NO_DeleteInterp (4) +#define FAIL_CreateInterp (5) +#define FAIL_Tcl_InitStubs (6) + +/* return value of ruby_tk_stubs_init() */ +#define NO_Tk_Init (7) +#define FAIL_Tk_Init (8) +#define FAIL_Tk_InitStubs (9) diff --git a/ext/tk/tcltklib.c b/ext/tk/tcltklib.c index d1e5f9d0d0..8f55491d1b 100644 --- a/ext/tk/tcltklib.c +++ b/ext/tk/tcltklib.c @@ -4,7 +4,7 @@ * Oct. 24, 1997 Y. Matsumoto */ -#define TCLTKLIB_RELEASE_DATE "2005-07-22" +#define TCLTKLIB_RELEASE_DATE "2005-07-28" #include "ruby.h" #include "rubysig.h" @@ -22,17 +22,14 @@ #include <tcl.h> #include <tk.h> +#include "stubs.h" + #ifndef TCL_ALPHA_RELEASE #define TCL_ALPHA_RELEASE 0 #define TCL_BETA_RELEASE 1 #define TCL_FINAL_RELEASE 2 #endif -#ifdef __MACOS__ -# include <tkMac.h> -# include <Quickdraw.h> -#endif - #if TCL_MAJOR_VERSION >= 8 # ifndef CONST84 # if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 4 /* Tcl8.0.x -- 8.4b1 */ @@ -81,6 +78,7 @@ static char *finalize_hook_name = "INTERP_FINALIZE_HOOK"; static void ip_finalize _((Tcl_Interp*)); + /* for callback break & continue */ static VALUE eTkCallbackReturn; static VALUE eTkCallbackBreak; @@ -114,7 +112,6 @@ static VALUE ip_invoke _((int, VALUE*, VALUE)); static VALUE tk_funcall _((VALUE(), int, VALUE*, VALUE)); - /* safe Tcl_Eval and Tcl_GlobalEval */ static int tcl_eval(interp, cmd) @@ -549,6 +546,128 @@ rbtk_release_ip(ptr) } +static VALUE +#ifdef HAVE_STDARG_PROTOTYPES +create_ip_exc(VALUE interp, VALUE exc, const char *fmt, ...) +#else +create_ip_exc(interp, exc, fmt, va_alist) + VALUE interp: + VALUE exc; + const char *fmt; + va_dcl +#endif +{ + va_list args; + char buf[BUFSIZ]; + VALUE einfo; + struct tcltkip *ptr = get_ip(interp); + + va_init_list(args,fmt); + vsnprintf(buf, BUFSIZ, fmt, args); + buf[BUFSIZ - 1] = '\0'; + va_end(args); + einfo = rb_exc_new2(exc, buf); + rb_ivar_set(einfo, ID_at_interp, interp); + if (ptr) { + Tcl_ResetResult(ptr->ip); + } + + return einfo; +} + + +/* stub status */ +static void +tcl_stubs_check() +{ + if (!tcl_stubs_init_p()) { + int st = ruby_tcl_stubs_init(); + 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 to call Tcl_InitStubs()"); + 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_stubs_init()", st); + } + } +} + + +static VALUE +tcltkip_init_tk(interp) + VALUE interp; +{ + struct tcltkip *ptr = get_ip(interp); + +#if TCL_MAJOR_VERSION >= 8 + int st; + + if (Tcl_IsSafe(ptr->ip)) { + DUMP1("Tk_SafeInit"); + st = ruby_tk_stubs_safeinit(ptr->ip); + switch(st) { + case TCLTK_STUBS_OK: + break; + case NO_Tk_Init: + return rb_exc_new2(rb_eLoadError, + "tcltklib: can't find Tk_SafeInit()"); + case FAIL_Tk_Init: + return create_ip_exc(interp, rb_eRuntimeError, + "tcltklib: fail to Tk_SafeInit(). %s", + Tcl_GetStringResult(ptr->ip)); + case FAIL_Tk_InitStubs: + return create_ip_exc(interp, rb_eRuntimeError, + "tcltklib: fail to Tk_InitStubs(). %s", + Tcl_GetStringResult(ptr->ip)); + default: + return create_ip_exc(interp, rb_eRuntimeError, + "tcltklib: unknown error(%d) on ruby_tk_stubs_safeinit", st); + } + } else { + DUMP1("Tk_Init"); + st = ruby_tk_stubs_init(ptr->ip); + switch(st) { + case TCLTK_STUBS_OK: + break; + case NO_Tk_Init: + return rb_exc_new2(rb_eLoadError, + "tcltklib: can't find Tk_Init()"); + case FAIL_Tk_Init: + return create_ip_exc(interp, rb_eRuntimeError, + "tcltklib: fail to Tk_Init(). %s", + Tcl_GetStringResult(ptr->ip)); + case FAIL_Tk_InitStubs: + return create_ip_exc(interp, rb_eRuntimeError, + "tcltklib: fail to Tk_InitStubs(). %s", + Tcl_GetStringResult(ptr->ip)); + default: + return create_ip_exc(interp, rb_eRuntimeError, + "tcltklib: unknown error(%d) on ruby_tk_stubs_init", st); + } + } + +#else /* TCL_MAJOR_VERSION < 8 */ + DUMP1("Tk_Init"); + if (ruby_tk_stubs_init(ptr->ip) != TCLTK_STUBS_OK) { + return rb_exc_new2(rb_eRuntimeError, ptr->ip->result); + } +#endif + + return Qnil; +} + + /* treat excetiopn on Tcl side */ static VALUE rbtk_pending_exception; static int rbtk_eventloop_depth = 0; @@ -645,7 +764,8 @@ call_original_exit(ptr, state) char **argv; argv = (char **)ALLOC_N(char *, 3); argv[0] = "exit"; - argv[1] = Tcl_GetString(state_obj); + /* argv[1] = Tcl_GetString(state_obj); */ + argv[1] = Tcl_GetStringFromObj(state_obj, (int*)NULL); argv[2] = (char *)NULL; ptr->return_value = (*(info->proc))(info->clientData, ptr->ip, @@ -694,13 +814,13 @@ _timer_for_tcl(clientData) thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; - Tk_DeleteTimerHandler(timer_token); + Tcl_DeleteTimerHandler(timer_token); run_timer_flag = 1; if (timer_tick > 0) { - timer_token = Tk_CreateTimerHandler(timer_tick, _timer_for_tcl, - (ClientData)0); + timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl, + (ClientData)0); } else { timer_token = (Tcl_TimerToken)NULL; } @@ -730,13 +850,13 @@ set_eventloop_tick(self, tick) rb_thread_critical = Qtrue; /* delete old timer callback */ - Tk_DeleteTimerHandler(timer_token); + Tcl_DeleteTimerHandler(timer_token); timer_tick = req_timer_tick = ttick; if (timer_tick > 0) { /* start timer callback */ - timer_token = Tk_CreateTimerHandler(timer_tick, _timer_for_tcl, - (ClientData)0); + timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl, + (ClientData)0); } else { timer_token = (Tcl_TimerToken)NULL; } @@ -995,7 +1115,11 @@ static VALUE lib_num_of_mainwindows(self) VALUE self; { - return INT2FIX(Tk_GetNumMainWindows()); + if (tk_stubs_init_p()) { + return INT2FIX(Tk_GetNumMainWindows()); + } else { + return INT2FIX(0); + } } @@ -1060,13 +1184,13 @@ lib_eventloop_core(check_root, update_flag, check_var) t.tv_sec = (time_t)0; t.tv_usec = (time_t)(no_event_wait*1000.0); - Tk_DeleteTimerHandler(timer_token); + Tcl_DeleteTimerHandler(timer_token); run_timer_flag = 0; if (timer_tick > 0) { thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; - timer_token = Tk_CreateTimerHandler(timer_tick, _timer_for_tcl, - (ClientData)0); + timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl, + (ClientData)0); rb_thread_critical = thr_crit_bup; } else { timer_token = (Tcl_TimerToken)NULL; @@ -1085,9 +1209,9 @@ lib_eventloop_core(check_root, update_flag, check_var) if (timer_tick == 0 && update_flag == 0) { timer_tick = NO_THREAD_INTERRUPT_TIME; - timer_token = Tk_CreateTimerHandler(timer_tick, - _timer_for_tcl, - (ClientData)0); + timer_token = Tcl_CreateTimerHandler(timer_tick, + _timer_for_tcl, + (ClientData)0); } if (check_var != (int *)NULL) { @@ -1166,7 +1290,7 @@ lib_eventloop_core(check_root, update_flag, check_var) } DUMP1("check Root Widget"); - if (check_root && Tk_GetNumMainWindows() == 0) { + if (check_root && tk_stubs_init_p() && Tk_GetNumMainWindows() == 0) { run_timer_flag = 0; if (rb_trap_pending) { if (rb_prohibit_interrupt || check_var != (int*)NULL) { @@ -1341,7 +1465,7 @@ lib_eventloop_core(check_root, update_flag, check_var) } DUMP1("check Root Widget"); - if (check_root && Tk_GetNumMainWindows() == 0) { + if (check_root && tk_stubs_init_p() && Tk_GetNumMainWindows() == 0) { run_timer_flag = 0; if (rb_trap_pending) { if (rb_prohibit_interrupt || check_var != (int*)NULL) { @@ -1457,7 +1581,7 @@ lib_eventloop_ensure(args) } if (NIL_P(eventloop_thread)) { - Tk_DeleteTimerHandler(timer_token); + Tcl_DeleteTimerHandler(timer_token); timer_token = (Tcl_TimerToken)NULL; break; @@ -1487,6 +1611,8 @@ lib_eventloop_launcher(check_root, update_flag, check_var) int depth = rbtk_eventloop_depth; struct evloop_params *args = ALLOC(struct evloop_params); + tcl_stubs_check(); + eventloop_thread = rb_thread_current(); if (ruby_debug) { @@ -1624,7 +1750,7 @@ lib_watchdog_core(check_rootwidget) } /* rb_thread_schedule(); */ } - } while(!check || Tk_GetNumMainWindows() != 0); + } while(!check || !tk_stubs_init_p() || Tk_GetNumMainWindows() != 0); return Qnil; } @@ -1795,6 +1921,8 @@ lib_do_one_event_core(argc, argv, self, is_ip) rb_raise(rb_eRuntimeError, "eventloop is already running"); } + tcl_stubs_check(); + if (rb_scan_args(argc, argv, "01", &vflags) == 0) { flags = TCL_ALL_EVENTS | TCL_DONT_WAIT; } else { @@ -2776,6 +2904,7 @@ ip_InterpExitCommand(clientData, interp, argc, argv) char *argv[]; #endif { + DUMP1("start ip_InterpExitCommand"); if (interp != (Tcl_Interp*)NULL && !Tcl_InterpDeleted(interp) #if TCL_NAMESPACE_DEBUG @@ -2810,8 +2939,11 @@ ip_RubyExitCommand(clientData, interp, argc, argv) int state; char *cmd, *param; + DUMP1("start ip_RubyExitCommand"); + #if TCL_MAJOR_VERSION >= 8 - cmd = Tcl_GetString(argv[0]); + /* cmd = Tcl_GetString(argv[0]); */ + cmd = Tcl_GetStringFromObj(argv[0], (int*)NULL); #else /* TCL_MAJOR_VERSION < 8 */ char *endptr; @@ -2864,7 +2996,8 @@ ip_RubyExitCommand(clientData, interp, argc, argv) if (Tcl_GetIntFromObj(interp, argv[1], &state) == TCL_ERROR) { return TCL_ERROR; } - param = Tcl_GetString(argv[1]); + /* param = Tcl_GetString(argv[1]); */ + param = Tcl_GetStringFromObj(argv[1], (int*)NULL); #else /* TCL_MAJOR_VERSION < 8 */ state = (int)strtol(argv[1], &endptr, 0); if (*endptr) { @@ -3601,13 +3734,16 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv) thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; - if (Tk_MainWindow(interp) == (Tk_Window)NULL) { + if (!tk_stubs_init_p() || Tk_MainWindow(interp) == (Tk_Window)NULL) { window = NULL; } else { window = Tk_NameToWindow(interp, nameString, tkwin); } if (window == NULL) { + Tcl_AppendResult(interp, "tkwait: ", + "no main-window (not Tk application?)", + (char*)NULL); rb_thread_critical = thr_crit_bup; #if TCL_MAJOR_VERSION >= 8 Tcl_DecrRefCount(objv[2]); @@ -3695,7 +3831,7 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv) thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; - if (Tk_MainWindow(interp) == (Tk_Window)NULL) { + if (!tk_stubs_init_p() || Tk_MainWindow(interp) == (Tk_Window)NULL) { window = NULL; } else { window = Tk_NameToWindow(interp, nameString, tkwin); @@ -3706,6 +3842,9 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv) #endif if (window == NULL) { + Tcl_AppendResult(interp, "tkwait: ", + "no main-window (not Tk application?)", + (char*)NULL); rb_thread_critical = thr_crit_bup; Tcl_Release(interp); return TCL_ERROR; @@ -4165,13 +4304,17 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv) thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; - if (Tk_MainWindow(interp) == (Tk_Window)NULL) { + if (!tk_stubs_init_p() || Tk_MainWindow(interp) == (Tk_Window)NULL) { window = NULL; } else { window = Tk_NameToWindow(interp, nameString, tkwin); } if (window == NULL) { + Tcl_AppendResult(interp, "thread_tkwait: ", + "no main-window (not Tk application?)", + (char*)NULL); + rb_thread_critical = thr_crit_bup; Tcl_Release(param); @@ -4250,7 +4393,7 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv) thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; - if (Tk_MainWindow(interp) == (Tk_Window)NULL) { + if (!tk_stubs_init_p() || Tk_MainWindow(interp) == (Tk_Window)NULL) { window = NULL; } else { window = Tk_NameToWindow(interp, nameString, tkwin); @@ -4261,6 +4404,10 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv) #endif if (window == NULL) { + Tcl_AppendResult(interp, "thread_tkwait: ", + "no main-window (not Tk application?)", + (char*)NULL); + rb_thread_critical = thr_crit_bup; Tcl_Release(param); @@ -4388,7 +4535,8 @@ delete_slaves(ip) if (elem == (Tcl_Obj*)NULL) continue; /* get slave */ - slave_name = Tcl_GetString(elem); + /* slave_name = Tcl_GetString(elem); */ + slave_name = Tcl_GetStringFromObj(elem, (int*)NULL); DUMP2("delete slave:'%s'", slave_name); Tcl_DecrRefCount(elem); @@ -4418,53 +4566,78 @@ ip_finalize(ip) { Tcl_CmdInfo info; int thr_crit_bup; + int rb_debug_bup; /* When ruby is exiting, printing debug messages in + some callback operations from Tcl-IP sometimes + cause SEGV. I don't know the reason. But I got + SEGV when calling "rb_io_write(rb_stdout, ...)". + So, in some part of this function, debug mode is + disabled. If you know the reason, please fix it. + -- Hidetoshi NAGAI (nagai@ai.kyutech.ac.jp) */ DUMP1("start ip_finalize"); if (ip == (Tcl_Interp*)NULL) { - DUMP1("ip is NULL"); - return; + DUMP1("ip is NULL"); + return; } #if TCL_NAMESPACE_DEBUG if (ip_null_namespace(ip)) { - DUMP2("ip(%lx) has null namespace", ip); - return; + DUMP2("ip(%lx) has null namespace", ip); + return; } #endif thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; + rb_debug_bup = ruby_debug; + Tcl_Preserve(ip); /* delete slaves */ delete_slaves(ip); /* delete root widget */ +#if 0 DUMP1("check `destroy'"); if (Tcl_GetCommandInfo(ip, "destroy", &info)) { DUMP1("call `destroy'"); Tcl_GlobalEval(ip, "destroy ."); } +#endif +#if 1 + DUMP1("destroy root widget"); + if (tk_stubs_init_p() && Tk_MainWindow(ip) != (Tk_Window)NULL) { + DUMP1("call Tk_DestroyWindow"); + ruby_debug = 0; + Tk_DestroyWindow(Tk_MainWindow(ip)); + ruby_debug = rb_debug_bup; + } +#endif /* call finalize-hook-proc */ DUMP1("check `finalize-hook-proc'"); if (Tcl_GetCommandInfo(ip, finalize_hook_name, &info)) { DUMP2("call finalize hook proc '%s'", finalize_hook_name); + ruby_debug = 0; Tcl_GlobalEval(ip, finalize_hook_name); + ruby_debug = rb_debug_bup; } DUMP1("check `foreach' & `after'"); if ( Tcl_GetCommandInfo(ip, "foreach", &info) && Tcl_GetCommandInfo(ip, "after", &info) ) { DUMP1("cancel after callbacks"); + ruby_debug = 0; Tcl_GlobalEval(ip, "foreach id [after info] {after cancel $id}"); + ruby_debug = rb_debug_bup; } Tcl_Release(ip); DUMP1("finish ip_finalize"); + ruby_debug = rb_debug_bup; rb_thread_critical = thr_crit_bup; } @@ -4629,7 +4802,8 @@ ip_rbNamespaceObjCmd(clientData, interp, objc, objv) argv = (char **)Tcl_Alloc(sizeof(char *) * (objc + 1)); for(i = 0; i < objc; i++) { - argv[i] = Tcl_GetString(objv[i]); + /* argv[i] = Tcl_GetString(objv[i]); */ + argv[i] = Tcl_GetStringFromObj(objv[i], (int*)NULL); } argv[objc] = (char *)NULL; @@ -4706,8 +4880,9 @@ ip_init(argc, argv, self) struct tcltkip *ptr; /* tcltkip data struct */ VALUE argv0, opts; int cnt; + int st; int with_tk = 1; - Tk_Window mainWin; + Tk_Window mainWin = (Tk_Window)NULL; /* security check */ if (ruby_safe_level >= 4) { @@ -4726,9 +4901,26 @@ ip_init(argc, argv, self) /* from Tk_Main() */ DUMP1("Tcl_CreateInterp"); - ptr->ip = Tcl_CreateInterp(); + ptr->ip = ruby_tcl_create_ip_and_stubs_init(&st); if (ptr->ip == NULL) { - rb_raise(rb_eRuntimeError, "fail to create a new Tk interpreter"); + 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 @@ -4790,13 +4982,32 @@ ip_init(argc, argv, self) /* from Tcl_AppInit() */ if (with_tk) { DUMP1("Tk_Init"); - if (Tk_Init(ptr->ip) == TCL_ERROR) { + 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: +#if TCL_MAJOR_VERSION >= 8 + rb_raise(rb_eRuntimeError, "tcltklib: fail to Tk_Init(). %s", + Tcl_GetStringResult(ptr->ip)); +#else /* TCL_MAJOR_VERSION < 8 */ + rb_raise(rb_eRuntimeError, "tcltklib: fail to Tk_Init(). %s", + ptr->ip->result); +#endif + case FAIL_Tk_InitStubs: #if TCL_MAJOR_VERSION >= 8 - rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip)); + rb_raise(rb_eRuntimeError, "tcltklib: fail to Tk_InitStubs(). %s", + Tcl_GetStringResult(ptr->ip)); #else /* TCL_MAJOR_VERSION < 8 */ - rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); + rb_raise(rb_eRuntimeError, "tcltklib: fail to Tk_InitStubs(). %s", + ptr->ip->result); #endif + 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); @@ -4804,11 +5015,11 @@ ip_init(argc, argv, self) Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL); #endif - } - /* get main window */ - mainWin = Tk_MainWindow(ptr->ip); - Tk_Preserve((ClientData)mainWin); + /* get main window */ + mainWin = Tk_MainWindow(ptr->ip); + Tk_Preserve((ClientData)mainWin); + } /* add ruby command to the interpreter */ #if TCL_MAJOR_VERSION >= 8 @@ -4865,7 +5076,9 @@ ip_init(argc, argv, self) /* set finalizer */ Tcl_CallWhenDeleted(ptr->ip, ip_CallWhenDeleted, (ClientData)mainWin); - Tk_Release((ClientData)mainWin); + if (mainWin != (Tk_Window)NULL) { + Tk_Release((ClientData)mainWin); + } return self; } @@ -4892,7 +5105,7 @@ ip_create_slave_core(interp, argc, argv) "deleted master cannot create a new slave"); } - name = argv[0]; + name = argv[0]; safemode = argv[1]; if (Tcl_IsSafe(master->ip) == 1) { @@ -4907,6 +5120,20 @@ ip_create_slave_core(interp, argc, argv) thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; +#if 0 + /* init Tk */ + if (RTEST(with_tk)) { + volatile VALUE exc; + if (!tk_stubs_init_p()) { + exc = tcltkip_init_tk(interp); + if (!NIL_P(exc)) { + rb_thread_critical = thr_crit_bup; + return exc; + } + } + } +#endif + /* create slave-ip */ slave->ref_count = 0; slave->allow_ruby_exit = 0; @@ -4929,7 +5156,7 @@ ip_create_slave_core(interp, argc, argv) = Tcl_GetCommandInfo(slave->ip, "exit", &(slave->orig_exit_info)); /* replace 'exit' command --> 'interp_exit' command */ - mainWin = Tk_MainWindow(slave->ip); + mainWin = (tk_stubs_init_p())? Tk_MainWindow(slave->ip): (Tk_Window)NULL; #if TCL_MAJOR_VERSION >= 8 DUMP1("Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\""); Tcl_CreateObjCommand(slave->ip, "exit", ip_InterpExitObjCmd, @@ -4974,7 +5201,7 @@ ip_create_slave(argc, argv, self) "deleted master cannot create a new slave interpreter"); } - /* safe-mode check */ + /* argument check */ if (rb_scan_args(argc, argv, "11", &name, &safemode) == 1) { safemode = Qfalse; } @@ -5020,11 +5247,14 @@ ip_create_console_core(interp, argc, argv) { struct tcltkip *ptr = get_ip(interp); + if (!tk_stubs_init_p()) { + tcltkip_init_tk(interp); + } + if (Tcl_GetVar(ptr->ip,"tcl_interactive",TCL_GLOBAL_ONLY) == (char*)NULL) { Tcl_SetVar(ptr->ip, "tcl_interactive", "0", TCL_GLOBAL_ONLY); } - #if TCL_MAJOR_VERSION > 8 \ || (TCL_MAJOR_VERSION == 8 \ && (TCL_MINOR_VERSION > 1 \ @@ -5101,7 +5331,7 @@ ip_make_safe_core(interp, argc, argv) ptr->allow_ruby_exit = 0; /* replace 'exit' command --> 'interp_exit' command */ - mainWin = Tk_MainWindow(ptr->ip); + mainWin = (tk_stubs_init_p())? Tk_MainWindow(ptr->ip): (Tk_Window)NULL; #if TCL_MAJOR_VERSION >= 8 DUMP1("Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\""); Tcl_CreateObjCommand(ptr->ip, "exit", ip_InterpExitObjCmd, @@ -5195,7 +5425,7 @@ ip_allow_ruby_exit_set(self, val) "insecure operation on a safe interpreter"); } - mainWin = Tk_MainWindow(ptr->ip); + mainWin = (tk_stubs_init_p())? Tk_MainWindow(ptr->ip): (Tk_Window)NULL; if (RTEST(val)) { ptr->allow_ruby_exit = 1; @@ -5301,7 +5531,7 @@ ip_has_mainwindow_p(self) struct tcltkip *ptr = get_ip(self); if (ptr == (struct tcltkip *)NULL || ptr->ip == (Tcl_Interp *)NULL - || Tcl_InterpDeleted(ptr->ip)) { + || Tcl_InterpDeleted(ptr->ip) || !tk_stubs_init_p()) { return Qnil; } else if (Tk_MainWindow(ptr->ip) == (Tk_Window)NULL) { return Qfalse; @@ -5310,36 +5540,6 @@ ip_has_mainwindow_p(self) } } - -static VALUE -#ifdef HAVE_STDARG_PROTOTYPES -create_ip_exc(VALUE interp, VALUE exc, const char *fmt, ...) -#else -create_ip_exc(interp, exc, fmt, va_alist) - VALUE interp: - VALUE exc; - const char *fmt; - va_dcl -#endif -{ - va_list args; - char buf[BUFSIZ]; - VALUE einfo; - struct tcltkip *ptr = get_ip(interp); - - va_init_list(args,fmt); - vsnprintf(buf, BUFSIZ, fmt, args); - buf[BUFSIZ - 1] = '\0'; - va_end(args); - einfo = rb_exc_new2(exc, buf); - rb_ivar_set(einfo, ID_at_interp, interp); - if (ptr) { - Tcl_ResetResult(ptr->ip); - } - - return einfo; -} - static VALUE ip_get_result_string_obj(interp) Tcl_Interp *interp; @@ -5657,26 +5857,33 @@ ip_eval_real(self, cmd_str, cmd_len) } if (pending_exception_check1(thr_crit_bup, ptr)) { + rbtk_release_ip(ptr); return rbtk_pending_exception; } if (ptr->return_value == TCL_ERROR) { - volatile VALUE exc; - - exc = create_ip_exc(self, rb_eRuntimeError, - "%s", Tcl_GetStringResult(ptr->ip)); - - /* Tcl_Release(ptr->ip); */ - rbtk_release_ip(ptr); - - rb_thread_critical = thr_crit_bup; - rb_exc_raise(exc); + if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->ip)) { + volatile VALUE exc; + exc = create_ip_exc(self, rb_eRuntimeError, + "%s", Tcl_GetStringResult(ptr->ip)); + rbtk_release_ip(ptr); + rb_thread_critical = thr_crit_bup; + return exc; + } else { + if (event_loop_abort_on_exc < 0) { + rb_warning("%s (ignore)", Tcl_GetStringResult(ptr->ip)); + } else { + rb_warn("%s (ignore)", Tcl_GetStringResult(ptr->ip)); + } + Tcl_ResetResult(ptr->ip); + rbtk_release_ip(ptr); + rb_thread_critical = thr_crit_bup; + return rb_tainted_str_new2(""); + } } - DUMP2("(TCL_Eval result) %d", ptr->return_value); /* pass back the result (as string) */ ret = ip_get_result_string_obj(ptr->ip); - /* Tcl_Release(ptr->ip); */ rbtk_release_ip(ptr); rb_thread_critical = thr_crit_bup; return ret; @@ -5702,6 +5909,7 @@ ip_eval_real(self, cmd_str, cmd_len) } if (pending_exception_check1(thr_crit_bup, ptr)) { + rbtk_release_ip(ptr); return rbtk_pending_exception; } @@ -5710,15 +5918,13 @@ ip_eval_real(self, cmd_str, cmd_len) exc = create_ip_exc(self, rb_eRuntimeError, "%s", ptr->ip->result); - /* Tcl_Release(ptr->ip); */ rbtk_release_ip(ptr); - rb_exc_raise(exc); + return exc; } DUMP2("(TCL_Eval result) %d", ptr->return_value); /* pass back the result (as string) */ ret = ip_get_result_string_obj(ptr->ip); - /* Tcl_Release(ptr->ip); */ rbtk_release_ip(ptr); return ret; #endif @@ -5894,9 +6100,12 @@ lib_restart_core(interp, argc, argv) volatile VALUE exc; struct tcltkip *ptr = get_ip(interp); int thr_crit_bup; + int st; /* rb_secure(4); */ /* already checked */ + /* tcl_stubs_check(); */ /* already checked */ + /* ip is deleted? */ if (ptr == (struct tcltkip *)NULL || ptr->ip == (Tcl_Interp*)NULL || Tcl_InterpDeleted(ptr->ip) @@ -5934,36 +6143,13 @@ lib_restart_core(interp, argc, argv) DUMP2("(TCL_Eval result) %d", ptr->return_value); Tcl_ResetResult(ptr->ip); - /* execute Tk_Init of Tk_SafeInit */ -#if TCL_MAJOR_VERSION >= 8 - if (Tcl_IsSafe(ptr->ip)) { - DUMP1("Tk_SafeInit"); - if (Tk_SafeInit(ptr->ip) == TCL_ERROR) { - exc = rb_exc_new2(rb_eRuntimeError, Tcl_GetStringResult(ptr->ip)); - /* Tcl_Release(ptr->ip); */ - rbtk_release_ip(ptr); - rb_thread_critical = thr_crit_bup; - return exc; - } - } else { - DUMP1("Tk_Init"); - if (Tk_Init(ptr->ip) == TCL_ERROR) { - exc = rb_exc_new2(rb_eRuntimeError, Tcl_GetStringResult(ptr->ip)); - /* Tcl_Release(ptr->ip); */ - rbtk_release_ip(ptr); - rb_thread_critical = thr_crit_bup; - return exc; - } - } -#else /* TCL_MAJOR_VERSION < 8 */ - DUMP1("Tk_Init"); - if (Tk_Init(ptr->ip) == TCL_ERROR) { - exc = rb_exc_new2(rb_eRuntimeError, ptr->ip->result); - /* Tcl_Release(ptr->ip); */ + /* execute Tk_Init or Tk_SafeInit */ + exc = tcltkip_init_tk(interp); + if (!NIL_P(exc)) { + rb_thread_critical = thr_crit_bup; rbtk_release_ip(ptr); return exc; } -#endif /* Tcl_Release(ptr->ip); */ rbtk_release_ip(ptr); @@ -5984,6 +6170,8 @@ lib_restart(self) rb_secure(4); + tcl_stubs_check(); + /* ip is deleted? */ if (ptr == (struct tcltkip *)NULL || ptr->ip == (Tcl_Interp*)NULL || Tcl_InterpDeleted(ptr->ip) @@ -6007,6 +6195,8 @@ ip_restart(self) rb_secure(4); + tcl_stubs_check(); + /* ip is deleted? */ if (ptr == (struct tcltkip *)NULL || ptr->ip == (Tcl_Interp*)NULL || Tcl_InterpDeleted(ptr->ip)) { @@ -6039,6 +6229,8 @@ lib_toUTF8_core(ip_obj, src, encodename) int thr_crit_bup; #endif + tcl_stubs_check(); + if (NIL_P(src)) { return rb_str_new2(""); } @@ -6192,6 +6384,8 @@ lib_fromUTF8_core(ip_obj, src, encodename) int thr_crit_bup; #endif + tcl_stubs_check(); + if (NIL_P(src)) { return rb_str_new2(""); } @@ -6347,6 +6541,8 @@ lib_UTF_backslash_core(self, str, all_bs) int taint_flag = OBJ_TAINTED(str); int thr_crit_bup; + tcl_stubs_check(); + StringValue(str); if (!RSTRING(str)->len) { return str; @@ -6404,6 +6600,7 @@ lib_get_system_encoding(self) VALUE self; { #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0) + tcl_stubs_check(); return rb_str_new2(Tcl_GetEncodingName((Tcl_Encoding)NULL)); #else return Qnil; @@ -6416,7 +6613,9 @@ lib_set_system_encoding(self, enc_name) VALUE enc_name; { #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0) - if NIL_P(enc_name) { + tcl_stubs_check(); + + if (NIL_P(enc_name)) { Tcl_SetSystemEncoding((Tcl_Interp *)NULL, (CONST char *)NULL); return lib_get_system_encoding(self); } @@ -8053,6 +8252,8 @@ lib_split_tklist_core(ip_obj, list_str) int result; VALUE old_gc; + tcl_stubs_check(); + if (NIL_P(ip_obj)) { interp = (Tcl_Interp *)NULL; } else if (get_ip(ip_obj) == (struct tcltkip *)NULL) { @@ -8250,6 +8451,8 @@ lib_merge_tklist(argc, argv, obj) if (argc == 0) return rb_str_new2(""); + tcl_stubs_check(); + thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; old_gc = rb_gc_disable(); @@ -8314,6 +8517,8 @@ lib_conv_listelement(self, src) int taint_flag = OBJ_TAINTED(src); int thr_crit_bup; + tcl_stubs_check(); + thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; @@ -8341,15 +8546,6 @@ lib_conv_listelement(self, src) } -#ifdef __MACOS__ -static void -_macinit() -{ - tcl_macQdPtr = &qd; /* setup QuickDraw globals */ - Tcl_MacSetEventProc(TkMacConvertEvent); /* setup event handler */ -} -#endif - static VALUE tcltklib_compile_info() { @@ -8410,12 +8606,12 @@ tcltklib_compile_info() return ret; } - /*---- initialization ----*/ void Init_tcltklib() { int thr_crit_bup; + int ret; VALUE lib = rb_define_module("TclTkLib"); VALUE ip = rb_define_class("TclTkIp", rb_cObject); @@ -8425,16 +8621,6 @@ Init_tcltklib() /* --------------------------------------------------------------- */ -#if defined USE_TCL_STUBS && defined USE_TK_STUBS - extern int ruby_tcltk_stubs(); - int ret = ruby_tcltk_stubs(); - - if (ret) - rb_raise(rb_eLoadError, "tcltklib: tcltk_stubs init error(%d)", ret); -#endif - - /* --------------------------------------------------------------- */ - rb_global_variable(&eTkCallbackReturn); rb_global_variable(&eTkCallbackBreak); rb_global_variable(&eTkCallbackContinue); @@ -8641,13 +8827,17 @@ Init_tcltklib() /* --------------------------------------------------------------- */ -#ifdef __MACOS__ - _macinit(); -#endif - - /* from Tk_Main() */ - DUMP1("Tcl_FindExecutable"); - Tcl_FindExecutable(RSTRING(rb_argv0)->ptr); + ret = ruby_open_tcl_dll(RSTRING(rb_argv0)->ptr); + switch(ret) { + 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"); + default: + rb_raise(rb_eLoadError, "tcltklib: unknown error(%d) on ruby_open_tcl_dll", ret); + } /* --------------------------------------------------------------- */ } diff --git a/ext/tk/tkutil/tkutil.c b/ext/tk/tkutil/tkutil.c index 496649f8c5..f191eb1627 100644 --- a/ext/tk/tkutil/tkutil.c +++ b/ext/tk/tkutil/tkutil.c @@ -8,7 +8,7 @@ ************************************************/ -#define TKUTIL_RELEASE_DATE "2005-07-22" +#define TKUTIL_RELEASE_DATE "2005-07-28" #include "ruby.h" #include "rubysig.h" @@ -246,16 +246,20 @@ ary2list(ary, enc_flag, self) volatile VALUE sys_enc, dst_enc, str_enc; sys_enc = rb_funcall(cTclTkLib, ID_encoding, 0, 0); - if NIL_P(sys_enc) { + if (NIL_P(sys_enc)) { sys_enc = rb_funcall(cTclTkLib, ID_encoding_system, 0, 0); + sys_enc = rb_funcall(sys_enc, ID_to_s, 0, 0); } if NIL_P(enc_flag) { dst_enc = sys_enc; req_chk_flag = 1; - } else { + } else if (TYPE(enc_flag) == T_TRUE || TYPE(enc_flag) == T_FALSE) { dst_enc = enc_flag; req_chk_flag = 0; + } else { + dst_enc = rb_funcall(enc_flag, ID_to_s, 0, 0); + req_chk_flag = 0; } /* size = RARRAY(ary)->len; */ @@ -280,7 +284,7 @@ ary2list(ary, enc_flag, self) if (req_chk_flag) { str_enc = rb_ivar_get(str_val, ID_at_enc); - if NIL_P(str_enc) { + if (!NIL_P(str_enc)) { str_enc = rb_funcall(str_enc, ID_to_s, 0, 0); } else { str_enc = sys_enc; @@ -327,7 +331,7 @@ ary2list(ary, enc_flag, self) if (req_chk_flag) { str_enc = rb_ivar_get(str_val, ID_at_enc); - if NIL_P(str_enc) { + if (!NIL_P(str_enc)) { str_enc = rb_funcall(str_enc, ID_to_s, 0, 0); } else { str_enc = sys_enc; @@ -347,7 +351,7 @@ ary2list(ary, enc_flag, self) if (req_chk_flag) { str_enc = rb_ivar_get(str_val, ID_at_enc); - if NIL_P(str_enc) { + if (!NIL_P(str_enc)) { str_enc = rb_funcall(str_enc, ID_to_s, 0, 0); } else { str_enc = sys_enc; @@ -398,14 +402,18 @@ ary2list2(ary, enc_flag, self) sys_enc = rb_funcall(cTclTkLib, ID_encoding, 0, 0); if NIL_P(sys_enc) { sys_enc = rb_funcall(cTclTkLib, ID_encoding_system, 0, 0); + sys_enc = rb_funcall(sys_enc, ID_to_s, 0, 0); } if NIL_P(enc_flag) { dst_enc = sys_enc; req_chk_flag = 1; - } else { + } else if (TYPE(enc_flag) == T_TRUE || TYPE(enc_flag) == T_FALSE) { dst_enc = enc_flag; req_chk_flag = 0; + } else { + dst_enc = rb_funcall(enc_flag, ID_to_s, 0, 0); + req_chk_flag = 0; } size = RARRAY(ary)->len; @@ -438,7 +446,7 @@ ary2list2(ary, enc_flag, self) if (req_chk_flag) { str_enc = rb_ivar_get(str_val, ID_at_enc); - if NIL_P(str_enc) { + if (!NIL_P(str_enc)) { str_enc = rb_funcall(str_enc, ID_to_s, 0, 0); } else { str_enc = sys_enc; @@ -884,7 +892,7 @@ tk_get_eval_enc_str(self, obj) static VALUE tk_conv_args(argc, argv, self) int argc; - VALUE *argv; + VALUE *argv; /* [0]:base_array, [1]:enc_mode, [2]..[n]:args */ VALUE self; { int idx, size; |