ruby-changes:16152
From: nagai <ko1@a...>
Date: Mon, 31 May 2010 23:51:54 +0900 (JST)
Subject: [ruby-changes:16152] Ruby:r28112 (ruby_1_8): * ext/tk/extconf.rb: use tclConfig.sh/tkConfig.sh when frameworks
nagai 2010-05-31 23:51:41 +0900 (Mon, 31 May 2010) New Revision: 28112 http://svn.ruby-lang.org/cgi-bin/viewvc.cgi?view=rev&revision=28112 Log: * ext/tk/extconf.rb: use tclConfig.sh/tkConfig.sh when frameworks are enabled on MacOS X. * ext/tk/stubs.c: dirty hack for frameworks and stubs on MacOS X. * ext/tk/lib/tk.rb: stop creating a dummy Tcl/Tk interpreter. And hide a root window before starting eventloop. (for ruby 1.9) * ext/tk/tcltklib.c: add codes to support Ruby/Tk-Kit (Rubykit). Modified files: branches/ruby_1_8/ChangeLog branches/ruby_1_8/ext/tk/extconf.rb branches/ruby_1_8/ext/tk/lib/tk.rb branches/ruby_1_8/ext/tk/stubs.c branches/ruby_1_8/ext/tk/tcltklib.c Index: ruby_1_8/ext/tk/stubs.c =================================================================== --- ruby_1_8/ext/tk/stubs.c (revision 28111) +++ ruby_1_8/ext/tk/stubs.c (revision 28112) @@ -46,7 +46,7 @@ return; } - /* If the variable "tcl_platform(threaded)" exists, + /* If the variable "tcl_platform(threaded)" exists, then the Tcl interpreter was compiled with threads enabled. */ if (Tcl_GetVar2(ip, "tcl_platform", "threaded", TCL_GLOBAL_ONLY) != (char*)NULL) { #ifdef HAVE_NATIVETHREAD @@ -92,6 +92,10 @@ # define TK_INDEX 7 # define TCL_NAME "libtcl8.9%s" # define TK_NAME "libtk8.9%s" +# if defined(__APPLE__) && defined(__MACH__) /* Mac OS X */ +# undef DLEXT +# define DLEXT ".dylib" +# endif #endif static DL_HANDLE tcl_dll = (DL_HANDLE)0; @@ -195,13 +199,13 @@ return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() ); } -int +int tcl_stubs_init_p() { return(tclStubsPtr != (TclStubs*)NULL); } -int +int tk_stubs_init_p() { return(tkStubsPtr != (TkStubs*)NULL); @@ -246,14 +250,14 @@ } } - p_Tcl_CreateInterp + 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 + p_Tcl_DeleteInterp = (Tcl_Interp *(*)())DL_SYM(tcl_dll, "Tcl_DeleteInterp"); if (!p_Tcl_DeleteInterp) { if (st) *st = NO_DeleteInterp; @@ -321,6 +325,22 @@ if (!p_Tk_Init) return NO_Tk_Init; +#if defined USE_TK_STUBS && defined TK_FRAMEWORK && defined(__APPLE__) && defined(__MACH__) + /* + FIX ME : dirty hack for Mac OS X frameworks. + With stubs, fails to find Resource/Script directory of Tk.framework. + So, teach it to a Tcl interpreter by an environment variable. + e.g. when $tcl_library == + /Library/Frameworks/Tcl.framwwork/8.5/Resources/Scripts + ==> /Library/Frameworks/Tk.framwwork/8.5/Resources/Scripts + */ + if (Tcl_Eval(tcl_ip, + "if {[array get env TK_LIBRARY] == {}} { set env(TK_LIBRARY) [regsub -all -nocase {(t)cl} $tcl_library {\\1k}] }" + ) != TCL_OK) { + return FAIL_Tk_Init; + } +#endif + if ((*p_Tk_Init)(tcl_ip) == TCL_ERROR) return FAIL_Tk_Init; @@ -444,7 +464,7 @@ return TCLTK_STUBS_OK; } -int +int ruby_open_tk_dll() { if (!open_tcl_dll) { @@ -455,7 +475,7 @@ return TCLTK_STUBS_OK; } -int +int #ifdef HAVE_PROTOTYPES ruby_open_tcltk_dll(char *appname) #else @@ -466,13 +486,13 @@ return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() ); } -int +int tcl_stubs_init_p() { return 1; } -int +int tk_stubs_init_p() { return call_tk_stubs_init; @@ -505,13 +525,13 @@ return tcl_ip; } -int +int ruby_tcl_stubs_init() { return TCLTK_STUBS_OK; } -int +int #ifdef HAVE_PROTOTYPES ruby_tk_stubs_init(Tcl_Interp *tcl_ip) #else @@ -559,7 +579,7 @@ #endif } -int +int ruby_tcltk_stubs() { /* Tcl_FindExecutable(RSTRING_PTR(rb_argv0)); */ Index: ruby_1_8/ext/tk/tcltklib.c =================================================================== --- ruby_1_8/ext/tk/tcltklib.c (revision 28111) +++ ruby_1_8/ext/tk/tcltklib.c (revision 28112) @@ -4,7 +4,8 @@ * Oct. 24, 1997 Y. Matsumoto */ -#define TCLTKLIB_RELEASE_DATE "2010-03-26" +#define TCLTKLIB_RELEASE_DATE "2010-05-31" +/* #define CREATE_RUBYTK_KIT */ #include "ruby.h" @@ -56,6 +57,20 @@ #define va_init_list(a,b) va_start(a) #endif #include <string.h> + +#if !defined HAVE_VSNPRINTF && !defined vsnprintf +# ifdef WIN32 + /* In Win32, vsnprintf is available as the "non-ANSI" _vsnprintf. */ +# define vsnprintf _vsnprintf +# else +# ifdef HAVE_RUBY_RUBY_H +# include "ruby/missing.h" +# else +# include "missing.h" +# endif +# endif +#endif + #include <tcl.h> #include <tk.h> @@ -68,10 +83,15 @@ #ifndef HAVE_RB_ERRINFO #define rb_errinfo() (ruby_errinfo+0) /* cannot be l-value */ +#else +VALUE rb_errinfo(void); #endif #ifndef HAVE_RB_SAFE_LEVEL -#define rb_safe_level() (ruby_safe_level+0) /* cannot be l-value */ +#define rb_safe_level() (ruby_safe_level+0) #endif +#ifndef HAVE_RB_SOURCEFILE +#define rb_sourcefile() (ruby_sourcefile+0) +#endif #include "stubs.h" @@ -93,9 +113,9 @@ { if (tcltk_version.major) return; - Tcl_GetVersion(&(tcltk_version.major), - &(tcltk_version.minor), - &(tcltk_version.patchlevel), + Tcl_GetVersion(&(tcltk_version.major), + &(tcltk_version.minor), + &(tcltk_version.patchlevel), &(tcltk_version.type)); } @@ -412,7 +432,7 @@ VALUE thread; }; -void +void invoke_queue_mark(struct invoke_queue *q) { rb_gc_mark(q->interp); @@ -420,7 +440,7 @@ rb_gc_mark(q->thread); } -void +void eval_queue_mark(struct eval_queue *q) { rb_gc_mark(q->interp); @@ -428,7 +448,7 @@ rb_gc_mark(q->thread); } -void +void call_queue_mark(struct call_queue *q) { int i; @@ -455,7 +475,7 @@ Tcl_Interp *current_interp; -/* thread control strategy */ +/* thread control strategy */ /* multi-tk works with the following settings only ??? : CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE 1 : USE_TOGGLE_WINDOW_MODE_FOR_IDLE 0 @@ -475,11 +495,11 @@ static int have_rb_thread_waiting_for_value = 0; #endif -/* - * 'event_loop_max' is a maximum events which the eventloop processes in one - * term of thread scheduling. 'no_event_tick' is the count-up value when - * there are no event for processing. - * 'timer_tick' is a limit of one term of thread scheduling. +/* + * 'event_loop_max' is a maximum events which the eventloop processes in one + * term of thread scheduling. 'no_event_tick' is the count-up value when + * there are no event for processing. + * 'timer_tick' is a limit of one term of thread scheduling. * If 'timer_tick' == 0, then not use the timer for thread scheduling. */ #ifdef RUBY_USE_NATIVE_THREAD @@ -529,7 +549,6 @@ VALUE args; }; - /*----------------------------*/ /* use Tcl internal functions */ /*----------------------------*/ @@ -837,7 +856,196 @@ return einfo; } +/*-------------------------------------------------------*/ +#if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT +/* Tcl/Tk stubs may work, but probably it is meaningless. */ +#if defined USE_TCL_STUBS || defined USE_TK_STUBS +# error Not support Tcl/Tk stubs with Ruby/Tk-Kit or Rubykit. +#endif + +#ifndef KIT_INCLUDES_TK +# define KIT_INCLUDES_TK 1 +#endif +/* #define KIT_INCLUDES_ITCL 1 */ +/* #define KIT_INCLUDES_THREAD 1 */ + +#ifdef KIT_INCLUDES_ITCL +Tcl_AppInitProc Itcl_Init; +#endif +Tcl_AppInitProc Mk4tcl_Init, Vfs_Init, Rechan_Init, Zlib_Init; +#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85 +Tcl_AppInitProc Pwb_Init; +#endif +#if defined TCL_THREADS && defined KIT_INCLUDES_THREAD +Tcl_AppInitProc Thread_Init; +#endif +#ifdef _WIN32 +Tcl_AppInitProc Dde_Init, Registry_Init; +#endif + +static const char *tcltklib_filepath = "[info nameofexecutable]"; +static char *rubytkkit_preInitCmd = (char *)NULL; +static const char *rubytkkit_preInitCmd_head = "set ::rubytkkit_exe [list "; +static const char *rubytkkit_preInitCmd_tail = +"]\n" +/*=== following init scripts are quoted from kitInit.c of Tclkit ===*/ +/* Tclkit license terms --- + LICENSE + + The Tclkit-specific sources are license free, they just have a copyright. + Hold the author(s) harmless and any lawful use is permitted. + + This does *not* apply to any of the sources of the other major Open Source + Software used in Tclkit, which each have very liberal BSD/MIT-like licenses: + Tcl/Tk, Incrtcl, Metakit, TclVFS, Zlib +*/ +#ifdef _WIN32_WCE +/* silly hack to get wince port to launch, some sort of std{in,out,err} problem +*/ +"open /kitout.txt a; open /kitout.txt a; open /kitout.txt a\n" +/* this too seems to be needed on wince - it appears to be related to the above +*/ +"catch {rename source ::tcl::source}\n" +"proc source file {\n" + "set old [info script]\n" + "info script $file\n" + "set fid [open $file]\n" + "set data [read $fid]\n" + "close $fid\n" + "set code [catch {uplevel 1 $data} res]\n" + "info script $old\n" + "if {$code == 2} { set code 0 }\n" + "return -code $code $res\n" +"}\n" +#endif +"proc tclKitInit {} {\n" + "rename tclKitInit {}\n" + "load {} Mk4tcl\n" +#if defined KIT_VFS_WRITABLE && !defined CREATE_RUBYKIT + /* running command cannot open itself for writing */ + "mk::file open exe $::rubytkkit_exe\n" +#else + "mk::file open exe $::rubytkkit_exe -readonly\n" +#endif + "set n [mk::select exe.dirs!0.files name boot.tcl]\n" + "if {$n != \"\"} {\n" + "set s [mk::get exe.dirs!0.files!$n contents]\n" + "if {![string length $s]} { error \"empty boot.tcl\" }\n" + "catch {load {} zlib}\n" + "if {[mk::get exe.dirs!0.files!$n size] != [string length $s]} {\n" + "set s [zlib decompress $s]\n" + "}\n" + "} else {\n" + "set f [open setup.tcl]\n" + "set s [read $f]\n" + "close $f\n" + "}\n" + "uplevel #0 $s\n" +#ifdef _WIN32 + "package ifneeded dde 1.3.1 {load {} dde}\n" + "package ifneeded registry 1.1.5 {load {} registry}\n" +#endif +"}\n" +"tclKitInit" +; + +#if 0 +/* Not use this script. + It's a memo to support an initScript for Tcl interpreters in the future. */ +static const char initScript[] = +"if {[file isfile [file join $::rubytkkit_exe main.tcl]]} {\n" + "if {[info commands console] != {}} { console hide }\n" + "set tcl_interactive 0\n" + "incr argc\n" + "set argv [linsert $argv 0 $argv0]\n" + "set argv0 [file join $::rubytkkit_exe main.tcl]\n" +"} else continue\n" +; +#endif + +#if !defined(TclSetPreInitScript) && !defined(TclSetPreInitScript_TCL_DECLARED) +EXTERN char* TclSetPreInitScript _((char *)); +#endif +static char* +setup_preInitCmd(const char *path) +{ + int head_len, path_len, tail_len; + char *ptr; + + head_len = strlen(rubytkkit_preInitCmd_head); + path_len = strlen(path); + tail_len = strlen(rubytkkit_preInitCmd_tail); + + rubytkkit_preInitCmd = ALLOC_N(char, head_len + path_len + tail_len + 1); + + ptr = rubytkkit_preInitCmd; + memcpy(ptr, rubytkkit_preInitCmd_head, head_len); + + ptr += head_len; + memcpy(ptr, path, path_len); + + ptr += path_len; + memcpy(ptr, rubytkkit_preInitCmd_tail, tail_len); + + ptr += tail_len; + *ptr = '\0'; + + return TclSetPreInitScript(rubytkkit_preInitCmd); +} + +static void +init_static_tcltk_packages() +{ +#ifdef KIT_INCLUDES_ITCL + Tcl_StaticPackage(0, "Itcl", Itcl_Init, NULL); +#endif + Tcl_StaticPackage(0, "Mk4tcl", Mk4tcl_Init, NULL); +#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85 + Tcl_StaticPackage(0, "pwb", Pwb_Init, NULL); +#endif + Tcl_StaticPackage(0, "rechan", Rechan_Init, NULL); + Tcl_StaticPackage(0, "vfs", Vfs_Init, NULL); + Tcl_StaticPackage(0, "zlib", Zlib_Init, NULL); +#if defined TCL_THREADS && defined KIT_INCLUDES_THREAD + Tcl_StaticPackage(0, "Thread", Thread_Init, NULL); +#endif +#ifdef _WIN32 + Tcl_StaticPackage(0, "dde", Dde_Init, NULL); + Tcl_StaticPackage(0, "registry", Registry_Init, NULL); +#endif +#ifdef KIT_INCLUDES_TK + Tcl_StaticPackage(0, "Tk", Tk_Init, Tk_SafeInit); +#endif +} + +/* SetExecName -- Hack to get around Tcl bug 1224888. */ +void SetExecName(Tcl_Interp *interp) { + /* dummy */ +} +#endif /* defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT */ + +static int +call_tclkit_init_script(Tcl_Interp *interp) +{ +#if 0 + /* Currently, nothing do in this function. + It's a memo (quoted from kitInit.c of Tclkit) + to support an initScript for Tcl interpreters in the future. */ + if (Tcl_Eval(interp, initScript) == TCL_OK) { + Tcl_Obj* path = TclGetStartupScriptPath(); + TclSetStartupScriptPath(Tcl_GetObjResult(interp)); + if (path == NULL) + Tcl_Eval(interp, "incr argc -1; set argv [lrange $argv 1 end]"); + } +#endif + + return 1; +} + + +/**********************************************************************/ + /* stub status */ static void tcl_stubs_check() @@ -882,18 +1090,18 @@ case TCLTK_STUBS_OK: break; case NO_Tk_Init: - return rb_exc_new2(rb_eLoadError, + 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", + 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", + 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, + return create_ip_exc(interp, rb_eRuntimeError, "tcltklib: unknown error(%d) on ruby_tk_stubs_safeinit", st); } } else { @@ -903,18 +1111,18 @@ case TCLTK_STUBS_OK: break; case NO_Tk_Init: - return rb_exc_new2(rb_eLoadError, + 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", + 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", + 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, + return create_ip_exc(interp, rb_eRuntimeError, "tcltklib: unknown error(%d) on ruby_tk_stubs_init", st); } } @@ -947,7 +1155,7 @@ if (!NIL_P(exc) && rb_obj_is_kind_of(exc, rb_eException)) { DUMP1("find a pending exception"); - if (rbtk_eventloop_depth > 0 + if (rbtk_eventloop_depth > 0 || rbtk_internal_eventloop_handler > 0 ) { return 1; /* pending */ @@ -1015,7 +1223,7 @@ /* call original 'exit' command */ -static void +static void call_original_exit(ptr, state) struct tcltkip *ptr; int state; @@ -1060,7 +1268,7 @@ argv[1] = state_obj; argv[2] = (Tcl_Obj *)NULL; - ptr->return_value + ptr->return_value = (*(info->objProc))(info->objClientData, ptr->ip, 2, argv); Tcl_DecrRefCount(cmd_obj); @@ -1136,7 +1344,7 @@ argv[1] = RSTRING_PTR(rb_fix2str(INT2NUM(state), 10)); argv[2] = (char *)NULL; - ptr->return_value = (*(info->proc))(info->clientData, ptr->ip, + ptr->return_value = (*(info->proc))(info->clientData, ptr->ip, 2, argv); #if USE_RUBY_ALLOC @@ -1185,7 +1393,7 @@ run_timer_flag = 1; if (timer_tick > 0) { - timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl, + timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl, (ClientData)0); } else { timer_token = (Tcl_TimerToken)NULL; @@ -1255,7 +1463,7 @@ rb_secure(4); if (ttick < 0) { - rb_raise(rb_eArgError, + rb_raise(rb_eArgError, "timer-tick parameter must be 0 or positive number"); } @@ -1268,7 +1476,7 @@ timer_tick = req_timer_tick = ttick; if (timer_tick > 0) { /* start timer callback */ - timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl, + timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl, (ClientData)0); } else { timer_token = (Tcl_TimerToken)NULL; @@ -1322,7 +1530,7 @@ rb_secure(4); if (t_wait <= 0) { - rb_raise(rb_eArgError, + rb_raise(rb_eArgError, "no_event_wait parameter must be positive number"); } @@ -1445,7 +1653,7 @@ default: { VALUE tmp = rb_funcall(time, ID_inspect, 0, 0); - rb_raise(rb_eArgError, "invalid value for time: '%s'", + rb_raise(rb_eArgError, "invalid value for time: '%s'", StringValuePtr(tmp)); } } @@ -1715,7 +1923,7 @@ check_eventloop_interp() { DUMP1("check eventloop_interp"); - if (eventloop_interp != (Tcl_Interp*)NULL + if (eventloop_interp != (Tcl_Interp*)NULL && Tcl_InterpDeleted(eventloop_interp)) { DUMP2("eventloop_interp(%p) was deleted", eventloop_interp); return 1; @@ -1752,7 +1960,7 @@ if (timer_tick > 0) { thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; - timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl, + timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl, (ClientData)0); rb_thread_critical = thr_crit_bup; } else { @@ -1784,8 +1992,8 @@ if (timer_tick == 0 && update_flag == 0) { timer_tick = NO_THREAD_INTERRUPT_TIME; - timer_token = Tcl_CreateTimerHandler(timer_tick, - _timer_for_tcl, + timer_token = Tcl_CreateTimerHandler(timer_tick, + _timer_for_tcl, (ClientData)0); } @@ -1793,7 +2001,7 @@ if (*check_var || !found_event) { return found_event; } - if (interp != (Tcl_Interp*)NULL + if (interp != (Tcl_Interp*)NULL && Tcl_InterpDeleted(interp)) { /* IP for check_var is deleted */ return 0; @@ -1801,13 +2009,13 @@ } /* found_event = Tcl_DoOneEvent(event_flag); */ - found_event = RTEST(rb_protect(call_DoOneEvent, - INT2FIX(event_flag), &status)); + found_event = RTEST(rb_protect(call_DoOneEvent, + INT2FIX(event_flag), &status)); if (status) { switch (status) { case TAG_RAISE: if (NIL_P(rb_errinfo())) { - rbtk_pending_exception + rbtk_pending_exception = rb_exc_new2(rb_eException, "unknown exception"); } else { rbtk_pending_exception = rb_errinfo(); @@ -1834,7 +2042,7 @@ } if (depth != rbtk_eventloop_depth) { - DUMP2("DoOneEvent(1) abnormal exit!! %d", + DUMP2("DoOneEvent(1) abnormal exit!! %d", rbtk_eventloop_depth); } @@ -1894,7 +2102,7 @@ if (*check_var || !found_event) { return found_event; } - if (interp != (Tcl_Interp*)NULL + if (interp != (Tcl_Interp*)NULL && Tcl_InterpDeleted(interp)) { /* IP for check_var is deleted */ return 0; @@ -1906,12 +2114,12 @@ int status; #ifdef RUBY_USE_NATIVE_THREAD if (update_flag) { - st = RTEST(rb_protect(call_DoOneEvent, - INT2FIX(event_flag), &status)); + st = RTEST(rb_protect(call_DoOneEvent, + INT2FIX(event_flag), &status)); } else { - st = RTEST(rb_protect(call_DoOneEvent, - INT2FIX(event_flag & window_event_mode), - &status)); + st = RTEST(rb_protect(call_DoOneEvent, + INT2FIX(event_flag & window_event_mode), + &status)); #if USE_TOGGLE_WINDOW_MODE_FOR_IDLE if (!st) { if (toggle_eventloop_window_mode_for_idle()) { @@ -1926,8 +2134,8 @@ } #else /* st = Tcl_DoOneEvent(event_flag); */ - st = RTEST(rb_protect(call_DoOneEvent, - INT2FIX(event_flag), &status)); + st = RTEST(rb_protect(call_DoOneEvent, + INT2FIX(event_flag), &status)); #endif #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE @@ -1941,8 +2149,8 @@ switch (status) { case TAG_RAISE: if (NIL_P(rb_errinfo())) { - rbtk_pending_exception - = rb_exc_new2(rb_eException, + rbtk_pending_exception + = rb_exc_new2(rb_eException, "unknown exception"); } else { rbtk_pending_exception = rb_errinfo(); @@ -1969,14 +2177,14 @@ } if (depth != rbtk_eventloop_depth) { - DUMP2("DoOneEvent(2) abnormal exit!! %d", + DUMP2("DoOneEvent(2) abnormal exit!! %d", rbtk_eventloop_depth); return 0; } TRAP_CHECK(); - if (check_var != (int*)NULL + if (check_var != (int*)NULL && !NIL_P(rbtk_pending_exception)) { DUMP1("exception on wait"); return 0; @@ -2005,8 +2213,8 @@ switch (status) { case TAG_RAISE: if (NIL_P(rb_errinfo())) { - rbtk_pending_exception - = rb_exc_new2(rb_eException, + rbtk_pending_exception + = rb_exc_new2(rb_eException, "unknown exception"); } else { rbtk_pending_exception = rb_errinfo(); @@ -2025,7 +2233,7 @@ case TAG_FATAL: if (NIL_P(rb_errinfo())) { - rb_exc_raise(rb_exc_new2(rb_eFatal, + rb_exc_raise(rb_exc_new2(rb_eFatal, "FATAL")); } else { rb_exc_raise(rb_errinfo()); @@ -2101,9 +2309,9 @@ check_rootwidget_flag = params->check_root; - if (lib_eventloop_core(params->check_root, - params->update_flag, - params->check_var, + if (lib_eventloop_core(params->check_root, + params->update_flag, + params->check_var, params->interp)) { return Qtrue; } else { @@ -2126,7 +2334,7 @@ switch (status) { case TAG_RAISE: if (NIL_P(rb_errinfo())) { - rbtk_pending_exception + rbtk_pending_exception = rb_exc_new2(rb_eException, "unknown exception"); } else { rbtk_pending_exception = rb_errinfo(); @@ -2167,7 +2375,7 @@ } while((eventloop_thread = rb_ary_pop(eventloop_stack))) { - DUMP2("eventloop-ensure: new eventloop-thread -> %lx", + DUMP2("eventloop-ensure: new eventloop-thread -> %lx", eventloop_thread); if (eventloop_thread == current_evloop) { @@ -2180,7 +2388,7 @@ Tcl_DeleteTimerHandler(timer_token); timer_token = (Tcl_TimerToken)NULL; - break; + break; } #ifdef RUBY_VM @@ -2244,7 +2452,7 @@ rb_ary_push(eventloop_stack, parent_evloop); - DUMP3("tcltklib: eventloop-thread : %lx -> %lx\n", + DUMP3("tcltklib: eventloop-thread : %lx -> %lx\n", parent_evloop, eventloop_thread); args->check_root = check_root; @@ -2256,10 +2464,10 @@ rb_thread_critical = Qfalse; #if 0 - return rb_ensure(lib_eventloop_main, (VALUE)args, + return rb_ensure(lib_eventloop_main, (VALUE)args, lib_eventloop_ensure, (VALUE)args); #endif - return rb_ensure(lib_eventloop_main_core, (VALUE)args, + return rb_ensure(lib_eventloop_main_core, (VALUE)args, lib_eventloop_ensure, (VALUE)args); } @@ -2280,7 +2488,7 @@ check_rootwidget = Qfalse; } - return lib_eventloop_launcher(RTEST(check_rootwidget), 0, + return lib_eventloop_launcher(RTEST(check_rootwidget), 0, (int*)NULL, (Tcl_Interp*)NULL); } @@ -2314,7 +2522,7 @@ watchdog_evloop_launcher(check_rootwidget) VALUE check_rootwidget; { - return lib_eventloop_launcher(RTEST(check_rootwidget), 0, + return lib_eventloop_launcher(RTEST(check_rootwidget), 0, (int*)NULL, (Tcl_Interp*)NULL); } @@ -2350,9 +2558,9 @@ if (NIL_P(eventloop_thread) || (loop_counter == prev_val && chance >= EVLOOP_WAKEUP_CHANCE)) { /* start new eventloop thread */ - DUMP2("eventloop thread %lx is sleeping or dead", + DUMP2("eventloop thread %lx is sleeping or dead", eventloop_thread); - evloop = rb_thread_create(watchdog_evloop_launcher, + evloop = rb_thread_create(watchdog_evloop_launcher, (void*)&check_rootwidget); DUMP2("create new eventloop thread %lx", evloop); loop_counter = -1; @@ -2397,7 +2605,7 @@ VALUE check_rootwidget; #ifdef RUBY_VM - rb_raise(rb_eNotImpError, + rb_raise(rb_eNotImpError, "eventloop_watchdog is not implemented on Ruby VM."); #endif @@ -2409,7 +2617,7 @@ check_rootwidget = Qfalse; } - return rb_ensure(lib_watchdog_core, check_rootwidget, + return rb_ensure(lib_watchdog_core, check_rootwidget, lib_watchdog_ensure, Qnil); } @@ -2440,7 +2648,7 @@ int *done; }; -void +void _thread_call_proc_arg_mark(struct thread_call_proc_arg *q) { rb_gc_mark(q->proc); @@ -2469,7 +2677,7 @@ { struct thread_call_proc_arg *q = (struct thread_call_proc_arg*)arg; - return rb_ensure(_thread_call_proc_core, (VALUE)q, + return rb_ensure(_thread_call_proc_core, (VALUE)q, _thread_call_proc_ensure, (VALUE)q); } @@ -2511,7 +2719,7 @@ rb_thread_schedule(); /* start sub-eventloop */ - foundEvent = RTEST(lib_eventloop_launcher(/* not check root-widget */0, 0, + foundEvent = RTEST(lib_eventloop_launcher(/* not check root-widget */0, 0, q->done, (Tcl_Interp*)NULL)); #ifdef RUBY_VM @@ -2928,7 +3136,7 @@ #if TCL_MAJOR_VERSION >= 8 ip_ruby_eval(clientData, interp, argc, argv) ClientData clientData; - Tcl_Interp *interp; + Tcl_Interp *interp; int argc; Tcl_Obj *CONST argv[]; #else /* TCL_MAJOR_VERSION < 8 */ @@ -2944,7 +3152,7 @@ int code; if (interp == (Tcl_Interp*)NULL) { - rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, + rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, "IP is deleted"); return TCL_ERROR; } @@ -2952,15 +3160,15 @@ /* ruby command has 1 arg. */ if (argc != 2) { #if 0 - rb_raise(rb_eArgError, + rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)", argc - 1); #else char buf[sizeof(int)*8 + 1]; Tcl_ResetResult(interp); sprintf(buf, "%d", argc-1); - Tcl_AppendResult(interp, "wrong number of arguments (", + Tcl_AppendResult(interp, "wrong number of arguments (", buf, " for 1)", (char *)NULL); - rbtk_pending_exception = rb_exc_new2(rb_eArgError, + rbtk_pending_exception = rb_exc_new2(rb_eArgError, Tcl_GetStringResult(interp)); return TCL_ERROR; #endif @@ -3056,7 +3264,7 @@ /* has '::' at head ? */ if (*head == ':') head += 2; - tail = head; + tail = head; /* search */ while(*tail) { @@ -3119,7 +3327,7 @@ #if TCL_MAJOR_VERSION >= 8 ip_ruby_cmd(clientData, interp, argc, argv) ClientData clientData; - Tcl_Interp *interp; + Tcl_Interp *interp; int argc; Tcl_Obj *CONST argv[]; #else /* TCL_MAJOR_VERSION < 8 */ @@ -3142,7 +3350,7 @@ int code; if (interp == (Tcl_Interp*)NULL) { - rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, + rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, "IP is deleted"); return TCL_ERROR; } @@ -3153,7 +3361,7 @@ #else Tcl_ResetResult(interp); Tcl_AppendResult(interp, "too few arguments", (char *)NULL); - rbtk_pending_exception = rb_exc_new2(rb_eArgError, + rbtk_pending_exception = rb_exc_new2(rb_eArgError, Tcl_GetStringResult(interp)); return TCL_ERROR; #endif @@ -3175,13 +3383,13 @@ receiver = ip_ruby_cmd_receiver_get(str); if (NIL_P(receiver)) { #if 0 - rb_raise(rb_eArgError, + rb_raise(rb_eArgError, "unknown class/module/global-variable '%s'", str); #else Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "unknown class/module/global-variable '", + Tcl_AppendResult(interp, "unknown class/module/global-variable '", str, "'", (char *)NULL); - rbtk_pending_exception = rb_exc_new2(rb_eArgError, + rbtk_pending_exception = rb_exc_new2(rb_eArgError, Tcl_GetStringResult(interp)); if (old_gc == Qfalse) rb_gc_enable(); return TCL_ERROR; @@ -3242,12 +3450,12 @@ static int #if TCL_MAJOR_VERSION >= 8 #ifdef HAVE_PROTOTYPES -ip_InterpExitObjCmd(ClientData clientData, Tcl_Interp *interp, +ip_InterpExitObjCmd(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST argv[]) #else ip_InterpExitObjCmd(clientData, interp, argc, argv) ClientData clientData; - Tcl_Interp *interp; + Tcl_Interp *interp; int argc; Tcl_Obj *CONST argv[]; #endif @@ -3265,7 +3473,7 @@ #endif { DUMP1("start ip_InterpExitCommand"); - if (interp != (Tcl_Interp*)NULL + if (interp != (Tcl_Interp*)NULL && !Tcl_InterpDeleted(interp) #if TCL_NAMESPACE_DEBUG && !ip_null_namespace(interp) @@ -3292,7 +3500,7 @@ #else ip_RubyExitObjCmd(clientData, interp, argc, argv) ClientData clientData; - Tcl_Interp *interp; + Tcl_Interp *interp; int argc; Tcl_Obj *CONST argv[]; #endif @@ -3325,8 +3533,8 @@ if (argc < 1 || argc > 2) { /* arguemnt error */ - Tcl_AppendResult(interp, - "wrong number of arguments: should be \"", + Tcl_AppendResult(interp, + "wrong number of arguments: should be \"", cmd, " ?returnCode?\"", (char *)NULL); return TCL_ERROR; } @@ -3348,10 +3556,10 @@ switch(argc) { case 1: /* rb_exit(0); */ /* not return if succeed */ - Tcl_AppendResult(interp, + Tcl_AppendResult(interp, "fail to call \"", cmd, "\"", (char *)NULL); - rbtk_pending_exception = rb_exc_new2(rb_eSystemExit, + rbtk_pending_exception = rb_exc_new2(rb_eSystemExit, Tcl_GetStringResult(interp)); rb_iv_set(rbtk_pending_exception, "status", INT2FIX(0)); @@ -3367,8 +3575,8 @@ #else /* TCL_MAJOR_VERSION < 8 */ state = (int)strtol(argv[1], &endptr, 0); if (*endptr) { - Tcl_AppendResult(interp, - "expected integer but got \"", + Tcl_AppendResult(interp, + "expected integer but got \"", argv[1], "\"", (char *)NULL); return TCL_ERROR; } @@ -3376,10 +3584,10 @@ #endif /* rb_exit(state); */ /* not return if succeed */ - Tcl_AppendResult(interp, "fail to call \"", cmd, " ", + Tcl_AppendResult(interp, "fail to call \"", cmd, " ", param, "\"", (char *)NULL); - rbtk_pending_exception = rb_exc_new2(rb_eSystemExit, + rbtk_pending_exception = rb_exc_new2(rb_eSystemExit, Tcl_GetStringResult(interp)); rb_iv_set(rbtk_pending_exception, "status", INT2FIX(state)); @@ -3387,8 +3595,8 @@ default: /* arguemnt error */ - Tcl_AppendResult(interp, - "wrong number of arguments: should be \"", + Tcl_AppendResult(interp, + "wrong number of arguments: should be \"", cmd, " ?returnCode?\"", (char *)NULL); return TCL_ERROR; } @@ -3408,7 +3616,7 @@ static int ip_rbUpdateObjCmd(clientData, interp, objc, objv) ClientData clientData; - Tcl_Interp *interp; + Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; #else /* TCL_MAJOR_VERSION < 8 */ @@ -3429,7 +3637,7 @@ DUMP1("Ruby's 'update' is called"); if (interp == (Tcl_Interp*)NULL) { - rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, + rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, "IP is deleted"); return TCL_ERROR; } @@ -3476,8 +3684,8 @@ # if TCL_MAJOR_VERSION >= 8 int dummy; Tcl_AppendResult(interp, "wrong number of arguments: should be \"", - Tcl_GetStringFromObj(objv[0], &dummy), - " [ idletasks ]\"", + Tcl_GetStringFromObj(objv[0], &dummy), + " [ idletasks ]\"", (char *) NULL); # else /* TCL_MAJOR_VERSION < 8 */ Tcl_AppendResult(interp, "wrong number of arguments: should be \"", @@ -3542,7 +3750,7 @@ }; static void rb_threadUpdateProc _((ClientData)); -static void +static void rb_threadUpdateProc(clientData) ClientData clientData; /* Pointer to integer to set to 1. */ { @@ -3561,7 +3769,7 @@ static int ip_rb_threadUpdateObjCmd(clientData, interp, objc, objv) ClientData clientData; - Tcl_Interp *interp; + Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; #else /* TCL_MAJOR_VERSION < 8 */ @@ -3585,7 +3793,7 @@ DUMP1("Ruby's 'thread_update' is called"); if (interp == (Tcl_Interp*)NULL) { - rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, + rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, "IP is deleted"); return TCL_ERROR; } @@ -3597,7 +3805,7 @@ #endif #endif - if (rb_thread_alone() + if (rb_thread_alone() || NIL_P(eventloop_thread) || eventloop_thread == current_thread) { #if TCL_MAJOR_VERSION >= 8 DUMP1("call ip_rbUpdateObjCmd"); @@ -3645,8 +3853,8 @@ # if TCL_MAJOR_VERSION >= 8 int dummy; Tcl_AppendResult(interp, "wrong number of arguments: should be \"", - Tcl_GetStringFromObj(objv[0], &dummy), - " [ idletasks ]\"", + Tcl_GetStringFromObj(objv[0], &dummy), + " [ idletasks ]\"", (char *) NULL); # else /* TCL_MAJOR_VERSION < 8 */ Tcl_AppendResult(interp, "wrong number of arguments: should be \"", @@ -3720,7 +3928,7 @@ #endif #if TCL_MAJOR_VERSION >= 8 -static char *VwaitVarProc _((ClientData, Tcl_Interp *, +static char *VwaitVarProc _((ClientData, Tcl_Interp *, CONST84 char *,CONST84 char *, int)); static char * VwaitVarProc(clientData, interp, name1, name2, flags) @@ -3750,7 +3958,7 @@ static int ip_rbVwaitObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Not used */ - Tcl_Interp *interp; + Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; #else /* TCL_MAJOR_VERSION < 8 */ @@ -3769,13 +3977,13 @@ DUMP1("Ruby's 'vwait' is called"); if (interp == (Tcl_Interp*)NULL) { - rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, + rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, "IP is deleted"); return TCL_ERROR; } #if 0 - if (!rb_thread_alone() + if (!rb_thread_alone() && eventloop_thread != Qnil && eventloop_thread != rb_thread_current()) { #if TCL_MAJOR_VERSION >= 8 @@ -3833,7 +4041,7 @@ nameString = objv[1]; #endif - /* + /* if (Tcl_TraceVar(interp, nameString, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, (ClientData) &done) != TCL_OK) { @@ -3856,7 +4064,7 @@ done = 0; - foundEvent = RTEST(lib_eventloop_launcher(/* not check root-widget */0, + foundEvent = RTEST(lib_eventloop_launcher(/* not check root-widget */0, 0, &done, interp)); thr_crit_bup = rb_thread_critical; @@ -3934,7 +4142,7 @@ /* based on tkCmd.c */ /**************************/ #if TCL_MAJOR_VERSION >= 8 -static char *WaitVariableProc _((ClientData, Tcl_Interp *, +static char *WaitVariableProc _((ClientData, Tcl_Interp *, CONST84 char *,CONST84 char *, int)); static char * WaitVariableProc(clientData, interp, name1, name2, flags) @@ -3944,7 +4152,7 @@ CONST84 char *name2; /* Second part of variable name. */ int flags; /* Information about what happened. */ #else /* TCL_MAJOR_VERSION < 8 */ -static char *WaitVariableProc _((ClientData, Tcl_Interp *, +static char *WaitVariableProc _((ClientData, Tcl_Interp *, char *, char *, int)); static char * WaitVariableProc(clientData, interp, name1, name2, flags) @@ -3994,7 +4202,7 @@ static int ip_rbTkWaitObjCmd(clientData, interp, objc, objv) ClientData clientData; - Tcl_Interp *interp; + Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; #else /* TCL_MAJOR_VERSION < 8 */ @@ -4018,13 +4226,13 @@ DUMP1("Ruby's 'tkwait' is called"); if (interp == (Tcl_Interp*)NULL) { - rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, + rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, "IP is deleted"); return TCL_ERROR; } #if 0 - if (!rb_thread_alone() + if (!rb_thread_alone() && eventloop_thread != Qnil && eventloop_thread != rb_thread_current()) { #if TCL_MAJOR_VERSION >= 8 @@ -4049,12 +4257,12 @@ #if TCL_MAJOR_VERSION >= 8 Tcl_AppendResult(interp, "wrong number of arguments: should be \"", - Tcl_GetStringFromObj(objv[0], &dummy), - " variable|visibility|window name\"", + Tcl_GetStringFromObj(objv[0], &dummy), + " variable|visibility|window name\"", (char *) NULL); #else /* TCL_MAJOR_VERSION < 8 */ Tcl_AppendResult(interp, "wrong number of arguments: should be \"", - objv[0], " variable|visibility|window name\"", + objv[0], " variable|visibility|window name\"", (char *) NULL); #endif @@ -4070,14 +4278,14 @@ rb_thread_critical = Qtrue; /* - if (Tcl_GetIndexFromObj(interp, objv[1], - (CONST84 char **)optionStrings, + if (Tcl_GetIndexFromObj(interp, objv[1], + (CONST84 char **)optionStrings, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } */ - ret = Tcl_GetIndexFromObj(interp, objv[1], - (CONST84 char **)optionStrings, + ret = Tcl_GetIndexFromObj(interp, objv[1], + (CONST84 char **)optionStrings, "option", 0, &index); rb_thread_critical = thr_crit_bup; @@ -4101,7 +4309,7 @@ index = TKWAIT_WINDOW; } else { Tcl_AppendResult(interp, "bad option \"", objv[1], - "\": must be variable, visibility, or window", + "\": must be variable, visibility, or window", (char *) NULL); Tcl_Release(interp); return TCL_ERROR; @@ -4204,8 +4412,8 @@ } if (window == NULL) { - Tcl_AppendResult(interp, ": tkwait: ", - "no main-window (not Tk application?)", + Tcl_AppendResult(interp, ": tkwait: ", + "no main-window (not Tk application?)", (char*)NULL); rb_thread_critical = thr_crit_bup; #if TCL_MAJOR_VERSION >= 8 @@ -4310,8 +4518,8 @@ #endif if (window == NULL) { - Tcl_AppendResult(interp, ": tkwait: ", - "no main-window (not Tk application?)", + Tcl_AppendResult(interp, ": tkwait: ", + "no main-window (not Tk application?)", (char*)NULL); rb_thread_critical = thr_crit_bup; Tcl_Release(interp); @@ -4379,7 +4587,7 @@ }; #if TCL_MAJOR_VERSION >= 8 -static char *rb_threadVwaitProc _((ClientData, Tcl_Interp *, +static char *rb_threadVwaitProc _((ClientData, Tcl_Interp *, CONST84 char *,CONST84 char *, int)); static char * rb_threadVwaitProc(clientData, interp, name1, name2, flags) @@ -4389,7 +4597,7 @@ CONST84 char *name2; /* Second part of variable name. */ int flags; /* Information about what happened. */ #else /* TCL_MAJOR_VERSION < 8 */ -static char *rb_threadVwaitProc _((ClientData, Tcl_Interp *, +static char *rb_threadVwaitProc _((ClientData, Tcl_Interp *, char *, char *, int)); static char * rb_threadVwaitProc(clientData, interp, name1, name2, flags) @@ -4450,7 +4658,7 @@ static int ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv) ClientData clientData; - Tcl_Interp *interp; + Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; #else /* TCL_MAJOR_VERSION < 8 */ @@ -4471,7 +4679,7 @@ DUMP1("Ruby's 'thread_vwait' is called"); if (interp == (Tcl_Interp*)NULL) { - rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, + rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, "IP is deleted"); return TCL_ERROR; } @@ -4607,7 +4815,7 @@ static int ip_rb_threadTkWaitObjCmd(clientData, interp, objc, objv) ClientData clientData; - Tcl_Interp *interp; + Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; #else /* TCL_MAJOR_VERSION < 8 */ @@ -4634,7 +4842,7 @@ DUMP1("Ruby's 'thread_tkwait' is called"); if (interp == (Tcl_Interp*)NULL) { - rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, + rbtk_pending_exception = rb_exc_new2(rb_eRuntimeError, "IP is deleted"); return TCL_ERROR; } @@ -4665,12 +4873,12 @@ #if TCL_MAJOR_VERSION >= 8 Tcl_AppendResult(interp, "wrong number of arguments: should be \"", - Tcl_GetStringFromObj(objv[0], &dummy), - " variable|visibility|window name\"", + Tcl_GetStringFromObj(objv[0], &dummy), + " variable|visibility|window name\"", (char *) NULL); #else /* TCL_MAJOR_VERSION < 8 */ Tcl_AppendResult(interp, "wrong number of arguments: should be \"", - objv[0], " variable|visibility|window name\"", + objv[0], " variable|visibility|window name\"", (char *) NULL); #endif @@ -4686,14 +4894,14 @@ thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; /* - if (Tcl_GetIndexFromObj(interp, objv[1], - (CONST84 char **)optionStrings, + if (Tcl_GetIndexFromObj(interp, objv[1], + (CONST84 char **)optionStrings, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } */ - ret = Tcl_GetIndexFromObj(interp, objv[1], - (CONST84 char **)optionStrings, + ret = Tcl_GetIndexFromObj(interp, objv[1], + (CONST84 char **)optionStrings, "option", 0, &index); rb_thread_critical = thr_crit_bup; @@ -4718,7 +4926,7 @@ index = TKWAIT_WINDOW; } else { Tcl_AppendResult(interp, "bad option \"", objv[1], - "\": must be variable, visibility, or window", + "\": must be variable, visibility, or window", (char *) NULL); Tcl_Release(tkwin); Tcl_Release(interp); @@ -4752,7 +4960,7 @@ case TKWAIT_VARIABLE: thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; - /* + /* if (Tcl_TraceVar(interp, nameString, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, rb_threadVwaitProc, (ClientData) param) != TCL_OK) { @@ -4840,8 +5048,8 @@ #endif if (window == NULL) { - Tcl_AppendResult(interp, ": thread_tkwait: ", - "no main-window (not Tk application?)", + Tcl_AppendResult(interp, ": thread_tkwait: ", + "no main-window (not Tk application?)", (char*)NULL); rb_thread_critical = thr_crit_bup; @@ -4892,7 +5100,7 @@ if (param->done != TKWAIT_MODE_DESTROY) { Tk_DeleteEventHandler(window, VisibilityChangeMask|StructureNotifyMask, - rb_threadWaitVisibilityProc, + rb_threadWaitVisibilityProc, (ClientData) param); } @@ -4965,8 +5173,8 @@ #endif if (window == NULL) { - Tcl_AppendResult(interp, ": thread_tkwait: ", - "no main-window (not Tk application?)", + Tcl_AppendResult(interp, ": thread_tkwait: ", + "no main-window (not Tk application?)", (char*)NULL); rb_thread_critical = thr_crit_bup; @@ -5147,7 +5355,7 @@ if (!Tcl_InterpDeleted(ip) && Tcl_Eval(ip, "interp slaves") == TCL_OK) { slave_list = ip->result; - if (Tcl_SplitList((Tcl_Interp*)NULL, + if (Tcl_SplitList((Tcl_Interp*)NULL, slave_list, &argc, &argv) == TCL_OK) { for(i = 0; i < argc; i++) { slave_name = argv[i]; @@ -5192,7 +5400,7 @@ #else ip_null_proc(clientData, interp, argc, argv) ClientData clientData; - Tcl_Interp *interp; + Tcl_Interp *interp; int argc; Tcl_Obj *CONST argv[]; #endif @@ -5220,10 +5428,10 @@ int thr_crit_bup; VALUE rb_debug_bup, rb_verbose_bup; - /* When ruby is exiting, printing debug messages in some callback - operations from Tcl-IP sometimes cause SEGV. I don't know the + /* 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 and verbose mode + So, in some part of this function, debug mode and verbose mode are disabled. If you know the reason, please fix it. -- Hidetoshi NAGAI (nagai@a...) */ @@ -5259,33 +5467,33 @@ /* shut off some connections from Tcl-proc to Ruby */ if (at_exit) { - /* NOTE: Only when at exit. - Because, ruby removes objects, which depends on the deleted - interpreter, on some callback operations. + /* NOTE: Only when at exit. + Because, ruby removes objects, which depends on the deleted + interpreter, on some callback operations. It is important for GC. */ #if TCL_MAJOR_VERSION >= 8 - Tcl_CreateObjCommand(ip, "ruby", ip_null_proc, + Tcl_CreateObjCommand(ip, "ruby", ip_null_proc, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); - Tcl_CreateObjCommand(ip, "ruby_eval", ip_null_proc, + Tcl_CreateObjCommand(ip, "ruby_eval", ip_null_proc, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); - Tcl_CreateObjCommand(ip, "ruby_cmd", ip_null_proc, + Tcl_CreateObjCommand(ip, "ruby_cmd", ip_null_proc, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); #else /* TCL_MAJOR_VERSION < 8 */ - Tcl_CreateCommand(ip, "ruby", ip_null_proc, + Tcl_CreateCommand(ip, "ruby", ip_null_proc, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); - Tcl_CreateCommand(ip, "ruby_eval", ip_null_proc, + Tcl_CreateCommand(ip, "ruby_eval", ip_null_proc, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); - Tcl_CreateCommand(ip, "ruby_cmd", ip_null_proc, + Tcl_CreateCommand(ip, "ruby_cmd", ip_null_proc, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); #endif - /* + /* rb_thread_critical = thr_crit_bup; return; */ } /* delete root widget */ -#ifdef RUBY_VM +#ifdef RUBY_VM /* cause SEGV on Ruby 1.9 */ #else DUMP1("check `destroy'"); @@ -5298,13 +5506,13 @@ DUMP1("destroy root widget"); if (tk_stubs_init_p() && Tk_MainWindow(ip) != (Tk_Window)NULL) { /* - * On Ruby VM, this code piece may be not called, because - * Tk_MainWindow() returns NULL on a native thread except + * On Ruby VM, this code piece may be not called, because + * Tk_MainWindow() returns NULL on a native thread except * the thread which initialize Tk environment. * Of course, that is a problem. But maybe not so serious. * All widgets are destroyed when the Tcl interp is deleted. - * At then, Ruby may raise exceptions on the delete hook - * callbacks which registered for the deleted widgets, and + * At then, Ruby may raise exceptions on the delete hook + * callbacks which registered for the deleted widgets, and * may fail to clear objects which depends on the widgets. * Although it is the problem, it is possibly avoidable by * rescuing exceptions and the finalize hook of the interp. @@ -5365,13 +5573,13 @@ thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; - if ( ptr->ip != (Tcl_Interp*)NULL + if ( ptr->ip != (Tcl_Interp*)NULL && !Tcl_InterpDeleted(ptr->ip) - && Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL + && Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL && !Tcl_InterpDeleted(Tcl_GetMaster(ptr->ip)) ) { - DUMP2("parent IP(%lx) is not deleted", + DUMP2("parent IP(%lx) is not deleted", (unsigned long)Tcl_GetMaster(ptr->ip)); - DUMP2("slave IP(%lx) should not be deleted", + DUMP2("slave IP(%lx) should not be deleted", (unsigned long)ptr->ip); xfree(ptr); /* ckfree((char*)ptr); */ @@ -5390,8 +5598,8 @@ if (!Tcl_InterpDeleted(ptr->ip)) { ip_finalize(ptr->ip); - Tcl_DeleteInterp(ptr->ip); - Tcl_Release(ptr->ip); + Tcl_DeleteInterp(ptr->ip); + Tcl_Release(ptr->ip); } ptr->ip = (Tcl_Interp*)NULL; @@ -5422,66 +5630,66 @@ /* replace 'vwait' command */ #if TCL_MAJOR_VERSION >= 8 DUMP1("Tcl_CreateObjCommand(\"vwait\")"); - Tcl_CreateObjCommand(interp, "vwait", ip_rbVwaitObjCmd, + Tcl_CreateObjCommand(interp, "vwait", ip_rbVwaitObjCmd, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); #else /* TCL_MAJOR_VERSION < 8 */ DUMP1("Tcl_CreateCommand(\"vwait\")"); - Tcl_CreateCommand(interp, "vwait", ip_rbVwaitCommand, + Tcl_CreateCommand(interp, "vwait", ip_rbVwaitCommand, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); #endif /* replace 'tkwait' command */ #if TCL_MAJOR_VERSION >= 8 DUMP1("Tcl_CreateObjCommand(\"tkwait\")"); - Tcl_CreateObjCommand(interp, "tkwait", ip_rbTkWaitObjCmd, + Tcl_CreateObjCommand(interp, "tkwait", ip_rbTkWaitObjCmd, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #else /* TCL_MAJOR_VERSION < 8 */ DUMP1("Tcl_CreateCommand(\"tkwait\")"); - Tcl_CreateCommand(interp, "tkwait", ip_rbTkWaitCommand, + Tcl_CreateCommand(interp, "tkwait", ip_rbTkWaitCommand, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #endif /* add 'thread_vwait' command */ #if TCL_MAJOR_VERSION >= 8 DUMP1("Tcl_CreateObjCommand(\"thread_vwait\")"); - Tcl_CreateObjCommand(interp, "thread_vwait", ip_rb_threadVwaitObjCmd, + Tcl_CreateObjCommand(interp, "thread_vwait", ip_rb_threadVwaitObjCmd, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); #else /* TCL_MAJOR_VERSION < 8 */ DUMP1("Tcl_CreateCommand(\"thread_vwait\")"); - Tcl_CreateCommand(interp, "thread_vwait", ip_rb_threadVwaitCommand, + Tcl_CreateCommand(interp, "thread_vwait", ip_rb_threadVwaitCommand, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); #endif /* add 'thread_tkwait' command */ #if TCL_MAJOR_VERSION >= 8 DUMP1("Tcl_CreateObjCommand(\"thread_tkwait\")"); - Tcl_CreateObjCommand(interp, "thread_tkwait", ip_rb_threadTkWaitObjCmd, + Tcl_CreateObjCommand(interp, "thread_tkwait", ip_rb_threadTkWaitObjCmd, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #else /* TCL_MAJOR_VERSION < 8 */ DUMP1("Tcl_CreateCommand(\"thread_tkwait\")"); - Tcl_CreateCommand(interp, "thread_tkwait", ip_rb_threadTkWaitCommand, + Tcl_CreateCommand(interp, "thread_tkwait", ip_rb_threadTkWaitCommand, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #endif /* replace 'update' command */ #if TCL_MAJOR_VERSION >= 8 DUMP1("Tcl_CreateObjCommand(\"update\")"); - Tcl_CreateObjCommand(interp, "update", ip_rbUpdateObjCmd, + Tcl_CreateObjCommand(interp, "update", ip_rbUpdateObjCmd, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #else /* TCL_MAJOR_VERSION < 8 */ DUMP1("Tcl_CreateCommand(\"update\")"); - Tcl_CreateCommand(interp, "update", ip_rbUpdateCommand, + Tcl_CreateCommand(interp, "update", ip_rbUpdateCommand, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #endif /* add 'thread_update' command */ #if TCL_MAJOR_VERSION >= 8 DUMP1("Tcl_CreateObjCommand(\"thread_update\")"); - Tcl_CreateObjCommand(interp, "thread_update", ip_rb_threadUpdateObjCmd, + Tcl_CreateObjCommand(interp, "thread_update", ip_rb_threadUpdateObjCmd, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #else /* TCL_MAJOR_VERSION < 8 */ DUMP1("Tcl_CreateCommand(\"thread_update\")"); - Tcl_CreateCommand(interp, "thread_update", ip_rb_threadUpdateCommand, + Tcl_CreateCommand(interp, "thread_update", ip_rb_threadUpdateCommand, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #endif } @@ -5491,7 +5699,7 @@ static int ip_rb_replaceSlaveTkCmdsObjCmd(clientData, interp, objc, objv) ClientData clientData; - Tcl_Interp *interp; + Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; #else /* TCL_MAJOR_VERSION < 8 */ @@ -5530,7 +5738,7 @@ slave = Tcl_GetSlave(interp, slave_name); if (slave == NULL) { - Tcl_AppendResult(interp, "cannot find slave \"", + Tcl_AppendResult(interp, "cannot find slave \"", slave_name, "\"", (char *)NULL); return TCL_ERROR; } @@ -5539,11 +5747,11 @@ /* replace 'exit' command --> 'interp_exit' command */ #if TCL_MAJOR_VERSION >= 8 DUMP1("Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\""); - Tcl_CreateObjCommand(slave, "exit", ip_InterpExitObjCmd, + Tcl_CreateObjCommand(slave, "exit", ip_InterpExitObjCmd, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #else /* TCL_MAJOR_VERSION < 8 */ DUMP1("Tcl_CreateCommand(\"exit\") --> \"interp_exit\""); - Tcl_CreateCommand(slave, "exit", ip_InterpExitCommand, + Tcl_CreateCommand(slave, "exit", ip_InterpExitCommand, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #endif @@ -5560,7 +5768,7 @@ static int ip_rbNamespaceObjCmd(clientData, interp, objc, objv) ClientData clientData; - Tcl_Interp *interp; + Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; { @@ -5569,7 +5777,7 @@ if (!Tcl_GetCommandInfo(interp, "__orig_namespace_command__", &(info))) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, + Tcl_AppendResult(interp, "invalid command name \"namespace\"", (char*)NULL); return TCL_ERROR; } @@ -5596,7 +5804,7 @@ } argv[objc] = (char *)NULL; - ret = (*(info.proc))(info.clientData, interp, + ret = (*(info.proc))(info.clientData, interp, objc, (CONST84 char **)argv); #if 0 /* use Tcl_EventuallyFree */ @@ -5620,7 +5828,7 @@ static void ip_wrap_namespace_command(interp) - Tcl_Interp *interp; + Tcl_Interp *interp; { #if TCL_MAJOR_VERSION >= 8 Tcl_CmdInfo orig_info; @@ -5630,16 +5838,16 @@ } if (orig_info.isNativeObjectProc) { - Tcl_CreateObjCommand(interp, "__orig_namespace_command__", - orig_info.objProc, orig_info.objClientData, + Tcl_CreateObjCommand(interp, "__orig_namespace_command__", + orig_info.objProc, orig_info.objClientData, orig_info.deleteProc); } else { - Tcl_CreateCommand(interp, "__orig_namespace_command__", - orig_info.proc, orig_info.clientData, + Tcl_CreateCommand(interp, "__orig_namespace_command__", + orig_info.proc, orig_info.clientData, orig_info.deleteProc); } - Tcl_CreateObjCommand(interp, "namespace", ip_rbNamespaceObjCmd, + Tcl_CreateObjCommand(interp, "namespace", ip_rbNamespaceObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *)NULL); #endif } @@ -5668,6 +5876,30 @@ rb_thread_critical = thr_crit_bup; } +/*--------------------------------------------------------*/ + +#ifdef __WIN32__ +/* #include <tkWinInt.h> *//* conflict definition of struct timezone */ +/* #include <tkIntPlatDecls.h> */ +/* #include <windows.h> */ +EXTERN void TkWinSetHINSTANCE(HINSTANCE hInstance); +void rbtk_win32_SetHINSTANCE(const char *module_name) +{ + /* TCHAR szBuf[256]; */ + HINSTANCE hInst; + + /* hInst = GetModuleHandle(NULL); */ + /* hInst = GetModuleHandle("tcltklib.so"); */ + hInst = GetModuleHandle(module_name); + TkWinSetHINSTANCE(hInst); + + /* GetModuleFileName(hInst, szBuf, sizeof(szBuf) / sizeof(TCHAR)); */ + /* MessageBox(NULL, szBuf, TEXT("OK"), MB_OK); */ +} +#endif + +/*--------------------------------------------------------*/ + /* initialize interpreter */ static VALUE ip_init(argc, argv, self) @@ -5684,8 +5916,8 @@ /* security check */ if (rb_safe_level() >= 4) { - rb_raise(rb_eSecurityError, - "Cannot create a TclTkIp object at level %d", + rb_raise(rb_eSecurityError, + "Cannot create a TclTkIp object at level %d", rb_safe_level()); } @@ -5728,7 +5960,7 @@ #if TCL_MAJOR_VERSION >= 8 #if TCL_NAMESPACE_DEBUG DUMP1("get current namespace"); - if ((ptr->default_ns = Tcl_GetCurrentNamespace(ptr->ip)) + if ((ptr->default_ns = Tcl_GetCurrentNamespace(ptr->ip)) == (Tcl_Namespace*)NULL) { rb_raise(rb_eRuntimeError, "a new Tk interpreter has a NULL namespace"); } @@ -5739,7 +5971,9 @@ DUMP2("IP ref_count = %d", ptr->ref_count); current_interp = ptr->ip; - ptr->has_orig_exit + call_tclkit_init_script(current_interp); + + ptr->has_orig_exit = Tcl_GetCommandInfo(ptr->ip, "exit", &(ptr->orig_exit_info)); /* from Tcl_AppInit() */ @@ -5768,7 +6002,7 @@ 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_SetVar(ptr->ip, "argv0", StringValuePtr(argv0), TCL_GLOBAL_ONLY); } } @@ -5788,10 +6022,10 @@ 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", + 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", + 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); @@ -5840,23 +6074,23 @@ /* 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, + 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, + 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, + 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, + 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, + 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, + Tcl_CreateCommand(ptr->ip, "exit", ip_RubyExitCommand, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #endif @@ -5868,12 +6102,12 @@ /* define command to replace commands which depend on slave's MainWindow */ #if TCL_MAJOR_VERSION >= 8 - Tcl_CreateObjCommand(ptr->ip, "__replace_slave_tk_commands__", - ip_rb_replaceSlaveTkCmdsObjCmd, + Tcl_CreateObjCommand(ptr->ip, "__replace_slave_tk_commands__", + ip_rb_replaceSlaveTkCmdsObjCmd, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); #else /* TCL_MAJOR_VERSION < 8 */ - Tcl_CreateCommand(ptr->ip, "__replace_slave_tk_commands__", - ip_rb_replaceSlaveTkCmdsCommand, + Tcl_CreateCommand(ptr->ip, "__replace_slave_tk_commands__", + ip_rb_replaceSlaveTkCmdsCommand, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); #endif @@ -5904,7 +6138,7 @@ /* ip is deleted? */ if (deleted_ip(master)) { - return rb_exc_new2(rb_eRuntimeError, + return rb_exc_new2(rb_eRuntimeError, "deleted master cannot create a new slave"); } @@ -5949,7 +6183,7 @@ slave->ip = Tcl_CreateSlave(master->ip, StringValuePtr(name), safe); if (slave->ip == NULL) { rb_thread_critical = thr_crit_bup; - return rb_exc_new2(rb_eRuntimeError, + return rb_exc_new2(rb_eRuntimeError, "fail to create the new slave interpreter"); } #if TCL_MAJOR_VERSION >= 8 @@ -5959,18 +6193,18 @@ #endif rbtk_preserve_ip(slave); - slave->has_orig_exit + slave->has_orig_exit = Tcl_GetCommandInfo(slave->ip, "exit", &(slave->orig_exit_info)); /* replace 'exit' command --> 'interp_exit' command */ 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, + Tcl_CreateObjCommand(slave->ip, "exit", ip_InterpExitObjCmd, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #else /* TCL_MAJOR_VERSION < 8 */ DUMP1("Tcl_CreateCommand(\"exit\") --> \"interp_exit\""); - Tcl_CreateCommand(slave->ip, "exit", ip_InterpExitCommand, + Tcl_CreateCommand(slave->ip, "exit", ip_InterpExitCommand, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #endif @@ -5982,12 +6216,12 @@ /* define command to replace cmds which depend on slave-slave's MainWin */ #if TCL_MAJOR_VERSION >= 8 - Tcl_CreateObjCommand(slave->ip, "__replace_slave_tk_commands__", - ip_rb_replaceSlaveTkCmdsObjCmd, + Tcl_CreateObjCommand(slave->ip, "__replace_slave_tk_commands__", + ip_rb_replaceSlaveTkCmdsObjCmd, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); #else /* TCL_MAJOR_VERSION < 8 */ - Tcl_CreateCommand(slave->ip, "__replace_slave_tk_commands__", - ip_rb_replaceSlaveTkCmdsCommand, + Tcl_CreateCommand(slave->ip, "__replace_slave_tk_commands__", + ip_rb_replaceSlaveTkCmdsCommand, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); #endif @@ -6012,7 +6246,7 @@ /* ip is deleted? */ if (deleted_ip(master)) { - rb_raise(rb_eRuntimeError, + rb_raise(rb_eRuntimeError, "deleted master cannot create a new slave interpreter"); } @@ -6121,7 +6355,7 @@ VALUE self; { struct tcltkip *ptr = get_ip(self); - + /* ip is deleted? */ if (deleted_ip(ptr)) { rb_raise(rb_eRuntimeError, "interpreter is deleted"); @@ -6139,16 +6373,16 @@ { struct tcltkip *ptr = get_ip(interp); Tk_Window mainWin; - + /* ip is deleted? */ if (deleted_ip(ptr)) { return rb_exc_new2(rb_eRuntimeError, "interpreter is deleted"); } if (Tcl_MakeSafe(ptr->ip) == TCL_ERROR) { - /* return rb_exc_new2(rb_eRuntimeError, + /* return rb_exc_new2(rb_eRuntimeError, Tcl_GetStringResult(ptr->ip)); */ - return create_ip_exc(interp, rb_eRuntimeError, + return create_ip_exc(interp, rb_eRuntimeError, Tcl_GetStringResult(ptr->ip)); } @@ -6158,11 +6392,11 @@ 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, + 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, + Tcl_CreateCommand(ptr->ip, "exit", ip_InterpExitCommand, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #endif @@ -6174,7 +6408,7 @@ VALUE self; { struct tcltkip *ptr = get_ip(self); - + /* ip is deleted? */ if (deleted_ip(ptr)) { rb_raise(rb_eRuntimeError, "interpreter is deleted"); @@ -6189,7 +6423,7 @@ VALUE self; { struct tcltkip *ptr = get_ip(self); - + /* ip is deleted? */ if (deleted_ip(ptr)) { rb_raise(rb_eRuntimeError, "interpreter is deleted"); @@ -6208,7 +6442,7 @@ VALUE self; { struct tcltkip *ptr = get_ip(self); - + /* ip is deleted? */ if (deleted_ip(ptr)) { rb_raise(rb_eRuntimeError, "interpreter is deleted"); @@ -6237,14 +6471,14 @@ } if (Tcl_IsSafe(ptr->ip)) { - rb_raise(rb_eSecurityError, + rb_raise(rb_eSecurityError, "insecure operation on a safe interpreter"); } /* - * Because of cross-threading, the following line may fail to find + * Because of cross-threading, the following line may fail to find * the MainWindow, even if the Tcl/Tk interpreter has one or more. - * But it has no problem. Current implementation of both type of + * But it has no problem. Current implementation of both type of * the "exit" command don't need maiinWin token. */ mainWin = (tk_stubs_init_p())? Tk_MainWindow(ptr->ip): (Tk_Window)NULL; @@ -6253,11 +6487,11 @@ ptr->allow_ruby_exit = 1; #if TCL_MAJOR_VERSION >= 8 DUMP1("Tcl_CreateObjCommand(\"exit\") --> \"ruby_exit\""); - Tcl_CreateObjCommand(ptr->ip, "exit", ip_RubyExitObjCmd, + 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, + Tcl_CreateCommand(ptr->ip, "exit", ip_RubyExitCommand, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #endif return Qtrue; @@ -6266,11 +6500,11 @@ ptr->allow_ruby_exit = 0; #if TCL_MAJOR_VERSION >= 8 DUMP1("Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\""); - Tcl_CreateObjCommand(ptr->ip, "exit", ip_InterpExitObjCmd, + 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, + Tcl_CreateCommand(ptr->ip, "exit", ip_InterpExitCommand, (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL); #endif return Qfalse; @@ -6517,7 +6751,7 @@ if (RTEST(rb_funcall(thread, ID_alive_p, 0)) && ! RTEST(rb_funcall(thread, ID_stop_p, 0))) { #else - if (RTEST(rb_thread_alive_p(thread)) + if (RTEST(rb_thread_alive_p(thread)) && ! RTEST(rb_funcall(thread, ID_stop_p, 0))) { #endif DUMP1("caller is not yet ready to receive the result -> pending"); @@ -6541,7 +6775,7 @@ if (rb_safe_level() != q->safe_level) { /* q_dat = Data_Wrap_Struct(rb_cData,0,-1,q); */ q_dat = Data_Wrap_Struct(rb_cData,call_queue_mark,-1,q); - ret = rb_funcall(rb_proc_new(callq_safelevel_handler, q_dat), + ret = rb_funcall(rb_proc_new(callq_safelevel_handler, q_dat), ID_call, 0); rb_gc_force_recycle(q_dat); q_dat = (VALUE)NULL; @@ -6622,11 +6856,11 @@ #ifdef RUBY_USE_NATIVE_THREAD if (ptr) { /* on Tcl interpreter */ - is_tk_evloop_thread = (ptr->tk_thread_id == (Tcl_ThreadId) 0 + is_tk_evloop_thread = (ptr->tk_thread_id == (Tcl_ThreadId) 0 || ptr->tk_thread_id == Tcl_GetCurrentThread()); } else { /* on Tcl/Tk library */ - is_tk_evloop_thread = (tk_eventloop_thread_id == (Tcl_ThreadId) 0 + is_tk_evloop_thread = (tk_eventloop_thread_id == (Tcl_ThreadId) 0 || tk_eventloop_thread_id == Tcl_GetCurrentThread()); } #else @@ -6697,15 +6931,15 @@ DUMP1("add handler"); #ifdef RUBY_USE_NATIVE_THREAD if (ptr && ptr->tk_thread_id) { - /* Tcl_ThreadQueueEvent(ptr->tk_thread_id, + /* Tcl_ThreadQueueEvent(ptr->tk_thread_id, &(callq->ev), TCL_QUEUE_HEAD); */ - Tcl_ThreadQueueEvent(ptr->tk_thread_id, + Tcl_ThreadQueueEvent(ptr->tk_thread_id, (Tcl_Event*)callq, TCL_QUEUE_HEAD); Tcl_ThreadAlert(ptr->tk_thread_id); } else if (tk_eventloop_thread_id) { - /* Tcl_ThreadQueueEvent(tk_eventloop_thread_id, + /* Tcl_ThreadQueueEvent(tk_eventloop_thread_id, &(callq->ev), TCL_QUEUE_HEAD); */ - Tcl_ThreadQueueEvent(tk_eventloop_thread_id, + Tcl_ThreadQueueEvent(tk_eventloop_thread_id, (Tcl_Event*)callq, TCL_QUEUE_HEAD); Tcl_ThreadAlert(tk_eventloop_thread_id); } else { @@ -6779,7 +7013,7 @@ if (rb_obj_is_kind_of(ret, rb_eException)) { DUMP1("raise exception"); /* rb_exc_raise(ret); */ - rb_exc_raise(rb_exc_new3(rb_obj_class(ret), + rb_exc_raise(rb_exc_new3(rb_obj_class(ret), rb_funcall(ret, ID_to_s, 0, 0))); } @@ -6856,7 +7090,7 @@ switch(status) { case TAG_RAISE: if (NIL_P(rb_errinfo())) { - rbtk_pending_exception = rb_exc_new2(rb_eException, + rbtk_pending_exception = rb_exc_new2(rb_eException, "unknown exception"); } else { rbtk_pending_exception = rb_errinfo(); @@ -6889,18 +7123,18 @@ switch (ptr->return_value) { case TCL_RETURN: - exc = create_ip_exc(self, eTkCallbackReturn, + exc = create_ip_exc(self, eTkCallbackReturn, "ip_eval_real receives TCL_RETURN"); case TCL_BREAK: - exc = create_ip_exc(self, eTkCallbackBreak, + exc = create_ip_exc(self, eTkCallbackBreak, "ip_eval_real receives TCL_BREAK"); case TCL_CONTINUE: - exc = create_ip_exc(self, eTkCallbackContinue, + exc = create_ip_exc(self, eTkCallbackContinue, "ip_eval_real receives TCL_CONTINUE"); default: - exc = create_ip_exc(self, rb_eRuntimeError, "%s", + exc = create_ip_exc(self, rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip)); - } + } rbtk_release_ip(ptr); rb_thread_critical = thr_crit_bup; @@ -6949,17 +7183,17 @@ switch (ptr->return_value) { case TCL_RETURN: - exc = create_ip_exc(self, eTkCallbackReturn, + exc = create_ip_exc(self, eTkCallbackReturn, "ip_eval_real receives TCL_RETURN"); case TCL_BREAK: - exc = create_ip_exc(self, eTkCallbackBreak, + exc = create_ip_exc(self, eTkCallbackBreak, "ip_eval_real receives TCL_BREAK"); case TCL_CONTINUE: - exc = create_ip_exc(self, eTkCallbackContinue, + exc = create_ip_exc(self, eTkCallbackContinue, "ip_eval_real receives TCL_CONTINUE"); default: exc = create_ip_exc(self, rb_eRuntimeError, "%s", ptr->ip->result); - } + } rbtk_release_ip(ptr); return exc; @@ -7013,7 +7247,7 @@ if (RTEST(rb_funcall(thread, ID_alive_p, 0)) && ! RTEST(rb_funcall(thread, ID_stop_p, 0))) { #else - if (RTEST(rb_thread_alive_p(thread)) + if (RTEST(rb_thread_alive_p(thread)) && ! RTEST(rb_funcall(thread, ID_stop_p, 0))) { #endif DUMP1("caller is not yet ready to receive the result -> pending"); @@ -7044,7 +7278,7 @@ #endif /* q_dat = Data_Wrap_Struct(rb_cData,0,-1,q); */ q_dat = Data_Wrap_Struct(rb_cData,eval_queue_mark,-1,q); - ret = rb_funcall(rb_proc_new(evq_safelevel_handler, q_dat), + ret = rb_funcall(rb_proc_new(evq_safelevel_handler, q_dat), ID_call, 0); rb_gc_force_recycle(q_dat); q_dat = (VALUE)NULL; @@ -7130,7 +7364,7 @@ if ( #ifdef RUBY_USE_NATIVE_THREAD (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread()) - && + && #endif (NIL_P(eventloop_thread) || current == eventloop_thread) ) { @@ -7198,7 +7432,7 @@ Tcl_ThreadAlert(ptr->tk_thread_id); } else if (tk_eventloop_thread_id) { Tcl_ThreadQueueEvent(tk_eventloop_thread_id, (Tcl_Event*)evq, position); - /* Tcl_ThreadQueueEvent(tk_eventloop_thread_id, + /* Tcl_ThreadQueueEvent(tk_eventloop_thread_id, &(evq->ev), position); */ Tcl_ThreadAlert(tk_eventloop_thread_id); } else { @@ -7265,7 +7499,7 @@ if (rb_obj_is_kind_of(ret, rb_eException)) { DUMP1("raise exception"); /* rb_exc_raise(ret); */ - rb_exc_raise(rb_exc_new3(rb_obj_class(ret), + rb_exc_raise(rb_exc_new3(rb_obj_class(ret), rb_funcall(ret, ID_to_s, 0, 0))); } @@ -7280,7 +7514,7 @@ int flag; { #if TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 6) - rb_raise(rb_eNotImpError, + rb_raise(rb_eNotImpError, "cancel_eval is supported Tcl/Tk8.6 or later."); #else Tcl_Obj *msg_obj; @@ -7506,7 +7740,7 @@ if (!RSTRING_LEN(enc)) { encoding = (Tcl_Encoding)NULL; } else { - encoding = Tcl_GetEncoding((Tcl_Interp*)NULL, + encoding = Tcl_GetEncoding((Tcl_Interp*)NULL, RSTRING_PTR(enc)); if (encoding == (Tcl_Encoding)NULL) { rb_warning("Tk-interp has unknown encoding information (@encoding:'%s')", RSTRING_PTR(enc)); @@ -7525,7 +7759,7 @@ return str; } /* encoding = Tcl_GetEncoding(interp, RSTRING_PTR(enc)); */ - encoding = Tcl_GetEncoding((Tcl_Interp*)NULL, + encoding = Tcl_GetEncoding((Tcl_Interp*)NULL, RSTRING_PTR(enc)); if (encoding == (Tcl_Encoding)NULL) { rb_warning("string has unknown encoding information (@encoding:'%s')", RSTRING_PTR(enc)); @@ -7548,10 +7782,10 @@ encoding = Tcl_GetEncoding((Tcl_Interp*)NULL, RSTRING_PTR(encodename)); if (encoding == (Tcl_Encoding)NULL) { /* - rb_warning("unknown encoding name '%s'", + rb_warning("unknown encoding name '%s'", RSTRING_PTR(encodename)); */ - rb_raise(rb_eArgError, "unknown encoding name '%s'", + rb_raise(rb_eArgError, "unknown encoding name '%s'", RSTRING_PTR(encodename)); } } @@ -7697,7 +7931,7 @@ if (!RSTRING_LEN(enc)) { encoding = (Tcl_Encoding)NULL; } else { - encoding = Tcl_GetEncoding((Tcl_Interp*)NULL, + encoding = Tcl_GetEncoding((Tcl_Interp*)NULL, RSTRING_PTR(enc)); if (encoding == (Tcl_Encoding)NULL) { rb_warning("Tk-interp has unknown encoding information (@encoding:'%s')", RSTRING_PTR(enc)); @@ -7735,12 +7969,12 @@ /* encoding = Tcl_GetEncoding(interp, RSTRING_PTR(encodename)); */ encoding = Tcl_GetEncoding((Tcl_Interp*)NULL, RSTRING_PTR(encodename)); if (encoding == (Tcl_Encoding)NULL) { - /* - rb_warning("unknown encoding name '%s'", + /* + rb_warning("unknown encoding name '%s'", RSTRING_PTR(encodename)); encodename = Qnil; */ - rb_raise(rb_eArgError, "unknown encoding name '%s'", + rb_raise(rb_eArgError, "unknown encoding name '%s'", RSTRING_PTR(encodename)); } } @@ -7948,9 +8182,9 @@ } enc_name = rb_funcall(enc_name, ID_to_s, 0, 0); - if (Tcl_SetSystemEncoding((Tcl_Interp *)NULL, + if (Tcl_SetSystemEncoding((Tcl_Interp *)NULL, StringValuePtr(enc_name)) != TCL_OK) { - rb_raise(rb_eArgError, "unknown encoding name '%s'", + rb_raise(rb_eArgError, "unknown encoding name '%s'", RSTRING_PTR(enc_name)); } @@ -8010,16 +8244,16 @@ /* Invoke the C procedure */ #if TCL_MAJOR_VERSION >= 8 if (inf->cmdinfo.isNativeObjectProc) { - inf->ptr->return_value - = (*(inf->cmdinfo.objProc))(inf->cmdinfo.objClientData, + inf->ptr->return_value + = (*(inf->cmdinfo.objProc))(inf->cmdinfo.objClientData, inf->ptr->ip, inf->objc, inf->objv); } else #endif { #if TCL_MAJOR_VERSION >= 8 - inf->ptr->return_value - = (*(inf->cmdinfo.proc))(inf->cmdinfo.clientData, inf->ptr->ip, + inf->ptr->return_value + = (*(inf->cmdinfo.proc))(inf->cmdinfo.clientData, inf->ptr->ip, argc, (CONST84 char **)argv); #if 0 /* use Tcl_EventuallyFree */ @@ -8034,8 +8268,8 @@ #endif #else /* TCL_MAJOR_VERSION < 8 */ - inf->ptr->return_value - = (*(inf->cmdinfo.proc))(inf->cmdinfo.clientData, inf->ptr->ip, + inf->ptr->return_value + = (*(inf->cmdinfo.proc))(inf->cmdinfo.clientData, inf->ptr->ip, inf->argc, inf->argv); #endif } @@ -8103,11 +8337,11 @@ if (!Tcl_GetCommandInfo(ptr->ip, cmd, &info)) { DUMP1("error Tcl_GetCommandInfo"); DUMP1("try auto_load (call 'unknown' command)"); - if (!Tcl_GetCommandInfo(ptr->ip, + if (!Tcl_GetCommandInfo(ptr->ip, #if TCL_MAJOR_VERSION >= 8 - "::unknown", + "::unknown", #else - "unknown", + "unknown", #endif &info)) { DUMP1("fail to get 'unknown' command"); @@ -8116,7 +8350,7 @@ /* Tcl_Release(ptr->ip); */ rbtk_release_ip(ptr); /*rb_ip_raise(obj,rb_eNameError,"invalid command name `%s'",cmd);*/ - return create_ip_exc(interp, rb_eNameError, + return create_ip_exc(interp, rb_eNameError, "invalid command name `%s'", cmd); } else { if (event_loop_abort_on_exc < 0) { @@ -8184,13 +8418,13 @@ switch(status) { case TAG_RAISE: if (NIL_P(rb_errinfo())) { - rbtk_pending_exception = rb_exc_new2(rb_eException, + rbtk_pending_exception = rb_exc_new2(rb_eException, "unknown exception"); } else { rbtk_pending_exception = rb_errinfo(); } break; - + case TAG_FATAL: if (NIL_P(rb_errinfo())) { rbtk_pending_exception = rb_exc_new2(rb_eFatal, "FATAL"); @@ -8224,7 +8458,7 @@ /* Invoke the C procedure */ #if TCL_MAJOR_VERSION >= 8 if (info.isNativeObjectProc) { - ptr->return_value = (*info.objProc)(info.objClientData, ptr->ip, + ptr->return_value = (*info.objProc)(info.objClientData, ptr->ip, objc, objv); #if 0 /* get the string value from the result object */ @@ -8237,7 +8471,7 @@ #endif { #if TCL_MAJOR_VERSION >= 8 - ptr->return_value = (*info.proc)(info.clientData, ptr->ip, + ptr->return_value = (*info.proc)(info.clientData, ptr->ip, argc, (CONST84 char **)argv); #if 0 /* use Tcl_EventuallyFree */ @@ -8252,7 +8486,7 @@ #endif #else /* TCL_MAJOR_VERSION < 8 */ - ptr->return_value = (*info.proc)(info.clientData, ptr->ip, + ptr->return_value = (*info.proc)(info.clientData, ptr->ip, argc, argv); #endif } @@ -8300,18 +8534,18 @@ if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->ip)) { switch (ptr->return_value) { case TCL_RETURN: - return create_ip_exc(interp, eTkCallbackReturn, + return create_ip_exc(interp, eTkCallbackReturn, "ip_invoke_core receives TCL_RETURN"); case TCL_BREAK: - return create_ip_exc(interp, eTkCallbackBreak, + return create_ip_exc(interp, eTkCallbackBreak, "ip_invoke_core receives TCL_BREAK"); case TCL_CONTINUE: - return create_ip_exc(interp, eTkCallbackContinue, + return create_ip_exc(interp, eTkCallbackContinue, "ip_invoke_core receives TCL_CONTINUE"); default: - return create_ip_exc(interp, rb_eRuntimeError, "%s", + return create_ip_exc(interp, rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip)); - } + } } else { if (event_loop_abort_on_exc < 0) { @@ -8503,7 +8737,7 @@ if (RTEST(rb_funcall(thread, ID_alive_p, 0)) && ! RTEST(rb_funcall(thread, ID_stop_p, 0))) { #else - if (RTEST(rb_thread_alive_p(thread)) + if (RTEST(rb_thread_alive_p(thread)) && ! RTEST(rb_funcall(thread, ID_stop_p, 0))) { #endif DUMP1("caller is not yet ready to receive the result -> pending"); @@ -8527,7 +8761,7 @@ if (rb_safe_level() != q->safe_level) { /* q_dat = Data_Wrap_Struct(rb_cData,0,0,q); */ q_dat = Data_Wrap_Struct(rb_cData,invoke_queue_mark,-1,q); - ret = rb_funcall(rb_proc_new(ivq_safelevel_handler, q_dat), + ret = rb_funcall(rb_proc_new(ivq_safelevel_handler, q_dat), ID_call, 0); rb_gc_force_recycle(q_dat); q_dat = (VALUE)NULL; @@ -8620,7 +8854,7 @@ if ( #ifdef RUBY_USE_NATIVE_THREAD (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread()) - && + && #endif (NIL_P(eventloop_thread) || current == eventloop_thread) ) { @@ -8680,9 +8914,9 @@ Tcl_ThreadQueueEvent(ptr->tk_thread_id, (Tcl_Event*)ivq, position); Tcl_ThreadAlert(ptr->tk_thread_id); } else if (tk_eventloop_thread_id) { - /* Tcl_ThreadQueueEvent(tk_eventloop_thread_id, + /* Tcl_ThreadQueueEvent(tk_eventloop_thread_id, &(ivq->ev), position); */ - Tcl_ThreadQueueEvent(tk_eventloop_thread_id, + Tcl_ThreadQueueEvent(tk_eventloop_thread_id, (Tcl_Event*)ivq, position); Tcl_ThreadAlert(tk_eventloop_thread_id); } else { @@ -8746,7 +8980,7 @@ if (rb_obj_is_kind_of(ret, rb_eException)) { DUMP1("raise exception"); /* rb_exc_raise(ret); */ - rb_exc_raise(rb_exc_new3(rb_obj_class(ret), + rb_exc_raise(rb_exc_new3(rb_obj_class(ret), rb_funcall(ret, ID_to_s, 0, 0))); } @@ -8809,7 +9043,7 @@ index = argv[1]; flag = argv[2]; - /* + /* StringValue(varname); if (!NIL_P(index)) StringValue(index); */ @@ -8836,9 +9070,9 @@ if (ret == (Tcl_Obj*)NULL) { volatile VALUE exc; - /* exc = rb_exc_new2(rb_eRuntimeError, + /* exc = rb_exc_new2(rb_eRuntimeError, Tcl_GetStringResult(ptr->ip)); */ - exc = create_ip_exc(interp, rb_eRuntimeError, + exc = create_ip_exc(interp, rb_eRuntimeError, Tcl_GetStringResult(ptr->ip)); /* Tcl_Release(ptr->ip); */ rbtk_release_ip(ptr); @@ -8867,7 +9101,7 @@ } else { /* Tcl_Preserve(ptr->ip); */ rbtk_preserve_ip(ptr); - ret = Tcl_GetVar2(ptr->ip, RSTRING_PTR(varname), + ret = Tcl_GetVar2(ptr->ip, RSTRING_PTR(varname), NIL_P(index) ? NULL : RSTRING_PTR(index), FIX2INT(flag)); } @@ -8975,9 +9209,9 @@ if (ret == (Tcl_Obj*)NULL) { volatile VALUE exc; - /* exc = rb_exc_new2(rb_eRuntimeError, + /* exc = rb_exc_new2(rb_eRuntimeError, Tcl_GetStringResult(ptr->ip)); */ - exc = create_ip_exc(interp, rb_eRuntimeError, + exc = create_ip_exc(interp, rb_eRuntimeError, Tcl_GetStringResult(ptr->ip)); /* Tcl_Release(ptr->ip); */ rbtk_release_ip(ptr); @@ -9007,8 +9241,8 @@ } else { /* Tcl_Preserve(ptr->ip); */ rbtk_preserve_ip(ptr); - ret = Tcl_SetVar2(ptr->ip, RSTRING_PTR(varname), - NIL_P(index) ? NULL : RSTRING_PTR(index), + ret = Tcl_SetVar2(ptr->ip, RSTRING_PTR(varname), + NIL_P(index) ? NULL : RSTRING_PTR(index), RSTRING_PTR(value), FIX2INT(flag)); } @@ -9079,7 +9313,7 @@ index = argv[1]; flag = argv[2]; - /* + /* StringValue(varname); if (!NIL_P(index)) StringValue(index); */ @@ -9089,15 +9323,15 @@ return Qtrue; } - ptr->return_value = Tcl_UnsetVar2(ptr->ip, RSTRING_PTR(varname), + ptr->return_value = Tcl_UnsetVar2(ptr->ip, RSTRING_PTR(varname), NIL_P(index) ? NULL : RSTRING_PTR(index), FIX2INT(flag)); if (ptr->return_value == TCL_ERROR) { if (FIX2INT(flag) & TCL_LEAVE_ERR_MSG) { - /* return rb_exc_new2(rb_eRuntimeError, + /* return rb_exc_new2(rb_eRuntimeError, Tcl_GetStringResult(ptr->ip)); */ - return create_ip_exc(interp, rb_eRuntimeError, + return create_ip_exc(interp, rb_eRuntimeError, Tcl_GetStringResult(ptr->ip)); } return Qfalse; @@ -9145,7 +9379,7 @@ VALUE self; VALUE varname; { - return ip_get_variable(self, varname, + return ip_get_variable(self, varname, INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); } @@ -9155,7 +9389,7 @@ VALUE varname; VALUE index; { - return ip_get_variable2(self, varname, index, + return ip_get_variable2(self, varname, index, INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); } @@ -9165,7 +9399,7 @@ VALUE varname; VALUE value; { - return ip_set_variable(self, varname, value, + return ip_set_variable(self, varname, value, INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); } @@ -9176,7 +9410,7 @@ VALUE index; VALUE value; { - return ip_set_variable2(self, varname, index, value, + return ip_set_variable2(self, varname, index, value, INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); } @@ -9185,7 +9419,7 @@ VALUE self; VALUE varname; { - return ip_unset_variable(self, varname, + return ip_unset_variable(self, varname, INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); } @@ -9195,7 +9429,7 @@ VALUE varname; VALUE index; { - return ip_unset_variable2(self, varname, index, + return ip_unset_variable2(self, varname, index, INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); } @@ -9302,7 +9536,7 @@ int argc; char **argv; - if (Tcl_SplitList(interp, RSTRING_PTR(list_str), + if (Tcl_SplitList(interp, RSTRING_PTR(list_str), &argc, &argv) == TCL_ERROR) { if (interp == (Tcl_Interp*)NULL) { rb_raise(rb_eRuntimeError, "can't get elements from list"); @@ -9387,7 +9621,7 @@ if (OBJ_TAINTED(argv[num])) taint_flag = 1; dst = StringValuePtr(argv[num]); #if TCL_MAJOR_VERSION >= 8 - len += Tcl_ScanCountedElement(dst, RSTRING_LEN(argv[num]), + len += Tcl_ScanCountedElement(dst, RSTRING_LEN(argv[num]), &flagPtr[num]) + 1; #else /* TCL_MAJOR_VERSION < 8 */ len += Tcl_ScanElement(dst, &flagPtr[num]) + 1; @@ -9403,8 +9637,8 @@ dst = result; for(num = 0; num < argc; num++) { #if TCL_MAJOR_VERSION >= 8 - len = Tcl_ConvertCountedElement(RSTRING_PTR(argv[num]), - RSTRING_LEN(argv[num]), + len = Tcl_ConvertCountedElement(RSTRING_PTR(argv[num]), + RSTRING_LEN(argv[num]), dst, flagPtr[num]); #else /* TCL_MAJOR_VERSION < 8 */ len = Tcl_ConvertElement(RSTRING_PTR(argv[num]), dst, flagPtr[num]); @@ -9468,10 +9702,10 @@ StringValue(src); #if TCL_MAJOR_VERSION >= 8 - len = Tcl_ScanCountedElement(RSTRING_PTR(src), RSTRING_LEN(src), + len = Tcl_ScanCountedElement(RSTRING_PTR(src), RSTRING_LEN(src), &scan_flag); dst = rb_str_new(0, len + 1); - len = Tcl_ConvertCountedElement(RSTRING_PTR(src), RSTRING_LEN(src), + len = Tcl_ConvertCountedElement(RSTRING_PTR(src), RSTRING_LEN(src), RSTRING_PTR(dst), scan_flag); #else /* TCL_MAJOR_VERSION < 8 */ len = Tcl_ScanElement(RSTRING_PTR(src), &scan_flag); @@ -9493,9 +9727,9 @@ { set_tcltk_version(); - return rb_ary_new3(4, INT2NUM(tcltk_version.major), - INT2NUM(tcltk_version.minor), - INT2NUM(tcltk_version.type), + return rb_ary_new3(4, INT2NUM(tcltk_version.major), + INT2NUM(tcltk_version.minor), + INT2NUM(tcltk_version.type), INT2NUM(tcltk_version.patchlevel)); } @@ -9523,7 +9757,7 @@ { volatile VALUE ret; int size; - char form[] + char form[] = "tcltklib %s :: Ruby%s (%s) %s pthread :: Tcl%s(%s)/Tk%s(%s) %s"; char *info; @@ -9531,31 +9765,31 @@ + strlen(TCLTKLIB_RELEASE_DATE) + strlen(RUBY_VERSION) + strlen(RUBY_RELEASE_DATE) - + strlen("without") + + strlen("without") + strlen(TCL_PATCH_LEVEL) + strlen("without stub") + strlen(TK_PATCH_LEVEL) - + strlen("without stub") + + strlen("without stub") + strlen("unknown tcl_threads"); info = ALLOC_N(char, size); /* info = ckalloc(sizeof(char) * size); */ /* SEGV */ sprintf(info, form, - TCLTKLIB_RELEASE_DATE, - RUBY_VERSION, RUBY_RELEASE_DATE, + TCLTKLIB_RELEASE_DATE, + RUBY_VERSION, RUBY_RELEASE_DATE, #ifdef HAVE_NATIVETHREAD "with", #else "without", #endif - TCL_PATCH_LEVEL, + TCL_PATCH_LEVEL, #ifdef USE_TCL_STUBS "with stub", #else "without stub", #endif - TK_PATCH_LEVEL, + TK_PATCH_LEVEL, #ifdef USE_TK_STUBS "with stub", #else @@ -9598,7 +9832,7 @@ #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1) if (Tcl_GetEncoding((Tcl_Interp*)NULL, RSTRING_PTR(name)) == (Tcl_Encoding)NULL) { if (RTEST(error_mode)) { - rb_raise(rb_eArgError, "invalid Tk encoding name '%s'", + rb_raise(rb_eArgError, "invalid Tk encoding name '%s'", RSTRING_PTR(name)); } else { return Qnil; @@ -9657,7 +9891,7 @@ enc_list = Tcl_GetObjResult(ptr->ip); Tcl_IncrRefCount(enc_list); - if (Tcl_ListObjGetElements(ptr->ip, enc_list, + if (Tcl_ListObjGetElements(ptr->ip, enc_list, &objc, &objv) != TCL_OK) { Tcl_DecrRefCount(enc_list); /* rb_raise(rb_eRuntimeError, "failt to get Tcl's encoding names");*/ @@ -9804,7 +10038,7 @@ { volatile VALUE obj = Qnil; - obj = rb_hash_lookup(table, + obj = rb_hash_lookup(table, encoding_table_get_name_core(table, enc, error_mode)); if (RTEST(rb_obj_is_kind_of(obj, cRubyEncoding))) { return obj; @@ -9878,7 +10112,7 @@ } /* update check */ - if (update_encoding_table(table, rb_ivar_get(table, ID_at_interp), + if (update_encoding_table(table, rb_ivar_get(table, ID_at_interp), error_mode)) { /* add new relations to the table */ /* RETRY: registered Ruby encoding? */ @@ -9962,8 +10196,8 @@ encobj = rb_enc_from_encoding(rb_enc_from_index(ENCODING_INDEX_BINARY)); rb_hash_aset(table, ENCODING_NAME_BINARY, encobj); rb_hash_aset(table, encobj, ENCODING_NAME_BINARY); - + /* Tcl stub check */ tcl_stubs_check(); @@ -10094,7 +10328,7 @@ create_encoding_table(interp) VALUE interp; { - return rb_funcall(rb_proc_new(create_encoding_table_core, interp), + return rb_funcall(rb_proc_new(create_encoding_table_core, interp), ID_call, 0); } @@ -10120,7 +10354,7 @@ /*###############################################*/ /* - * The following is based on tkMenu.[ch] + * The following is based on tkMenu.[ch] * of Tcl/Tk (Tk8.0 -- Tk8.5b1) source code. */ #if TCL_MAJOR_VERSION >= 8 @@ -10183,10 +10417,10 @@ #if 0 /* was available on Tk8.0 -- Tk8.4 */ menuRefPtr = TkFindMenuReferences(ptr->ip, RSTRING_PTR(menu_path)); #else /* based on Tk8.0 -- Tk8.5b1 */ - if ((menuTablePtr + if ((menuTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(ptr->ip, MENU_HASH_KEY, NULL)) != NULL) { - if ((hashEntryPtr + if ((hashEntryPtr = Tcl_FindHashEntry(menuTablePtr, RSTRING_PTR(menu_path))) != NULL) { menuRefPtr = (struct dummy_TkMenuRef *) Tcl_GetHashValue(hashEntryPtr); @@ -10199,12 +10433,12 @@ } if (menuRefPtr->menuPtr == (struct dummy_TkMenu *) NULL) { - rb_raise(rb_eRuntimeError, + rb_raise(rb_eRuntimeError, "invalid menu widget (maybe already destroyed)"); } if ((menuRefPtr->menuPtr)->menuType != MENUBAR) { - rb_raise(rb_eRuntimeError, + rb_raise(rb_eRuntimeError, "target menu widget must be a MENUBAR type"); } @@ -10223,7 +10457,7 @@ #if 0 /* was available on Tk8.0 -- Tk8.4 */ TkEventuallyRecomputeMenu(menuRefPtr->menuPtr); - TkEventuallyRedrawMenu(menuRefPtr->menuPtr, + TkEventuallyRedrawMenu(menuRefPtr->menuPtr, (struct dummy_TkMenuEntry *)NULL); #else /* based on Tk8.0 -- Tk8.5b1 */ memset((void *) &event, 0, sizeof(event)); @@ -10306,28 +10540,28 @@ rb_define_const(lib, "COMPILE_INFO", tcltklib_compile_info()); - rb_define_const(lib, "RELEASE_DATE", + rb_define_const(lib, "RELEASE_DATE", rb_obj_freeze(rb_str_new2(tcltklib_release_date))); - rb_define_const(lib, "FINALIZE_PROC_NAME", + rb_define_const(lib, "FINALIZE_PROC_NAME", rb_str_new2(finalize_hook_name)); /* --------------------------------------------------------------- */ #ifdef __WIN32__ -#define TK_WINDOWING_SYSTEM "win32" +# define TK_WINDOWING_SYSTEM "win32" #else -#ifdef MAC_TCL -#define TK_WINDOWING_SYSTEM "classic" -#else -#ifdef MAC_OSX_TK -#define TK_WINDOWING_SYSTEM "aqua" -#else -#define TK_WINDOWING_SYSTEM "x11" +# ifdef MAC_TCL +# define TK_WINDOWING_SYSTEM "classic" +# else +# ifdef MAC_OSX_TK +# define TK_WINDOWING_SYSTEM "aqua" +# else +# define TK_WINDOWING_SYSTEM "x11" +# endif +# endif #endif -#endif -#endif - rb_define_const(lib, "WINDOWING_SYSTEM", + rb_define_const(lib, "WINDOWING_SYSTEM", rb_obj_freeze(rb_str_new2(TK_WINDOWING_SYSTEM))); /* --------------------------------------------------------------- */ @@ -10361,7 +10595,7 @@ /* --------------------------------------------------------------- */ rb_define_module_function(lib, "get_version", lib_getversion, -1); - rb_define_module_function(lib, "get_release_type_name", + rb_define_module_function(lib, "get_release_type_name", lib_get_reltype_name, -1); rb_define_const(release_type, "ALPHA", INT2FIX(TCL_ALPHA_RELEASE)); @@ -10413,53 +10647,53 @@ /* --------------------------------------------------------------- */ rb_define_module_function(lib, "mainloop", lib_mainloop, -1); - rb_define_module_function(lib, "mainloop_thread?", + rb_define_module_function(lib, "mainloop_thread?", lib_evloop_thread_p, 0); - rb_define_module_function(lib, "mainloop_watchdog", + rb_define_module_function(lib, "mainloop_watchdog", lib_mainloop_watchdog, -1); - rb_define_module_function(lib, "do_thread_callback", + rb_define_module_function(lib, "do_thread_callback", lib_thread_callback, -1); rb_define_module_function(lib, "do_one_event", lib_do_one_event, -1); - rb_define_module_function(lib, "mainloop_abort_on_exception", + rb_define_module_function(lib, "mainloop_abort_on_exception", lib_evloop_abort_on_exc, 0); - rb_define_module_function(lib, "mainloop_abort_on_exception=", + rb_define_module_function(lib, "mainloop_abort_on_exception=", lib_evloop_abort_on_exc_set, 1); - rb_define_module_function(lib, "set_eventloop_window_mode", + rb_define_module_function(lib, "set_eventloop_window_mode", set_eventloop_window_mode, 1); - rb_define_module_function(lib, "get_eventloop_window_mode", + rb_define_module_function(lib, "get_eventloop_window_mode", get_eventloop_window_mode, 0); rb_define_module_function(lib, "set_eventloop_tick",set_eventloop_tick,1); rb_define_module_function(lib, "get_eventloop_tick",get_eventloop_tick,0); rb_define_module_function(lib, "set_no_event_wait", set_no_event_wait, 1); rb_define_module_function(lib, "get_no_event_wait", get_no_event_wait, 0); - rb_define_module_function(lib, "set_eventloop_weight", + rb_define_module_function(lib, "set_eventloop_weight", set_eventloop_weight, 2); rb_define_module_function(lib, "set_max_block_time", set_max_block_time,1); - rb_define_module_function(lib, "get_eventloop_weight", + rb_define_module_function(lib, "get_eventloop_weight", get_eventloop_weight, 0); - rb_define_module_function(lib, "num_of_mainwindows", + rb_define_module_function(lib, "num_of_mainwindows", lib_num_of_mainwindows, 0); /* --------------------------------------------------------------- */ rb_define_module_function(lib, "_split_tklist", lib_split_tklist, 1); rb_define_module_function(lib, "_merge_tklist", lib_merge_tklist, -1); - rb_define_module_function(lib, "_conv_listelement", + rb_define_module_function(lib, "_conv_listelement", lib_conv_listelement, 1); rb_define_module_function(lib, "_toUTF8", lib_toUTF8, -1); rb_define_module_function(lib, "_fromUTF8", lib_fromUTF8, -1); - rb_define_module_function(lib, "_subst_UTF_backslash", + rb_define_module_function(lib, "_subst_UTF_backslash", lib_UTF_backslash, 1); - rb_define_module_function(lib, "_subst_Tcl_backslash", + rb_define_module_function(lib, "_subst_Tcl_backslash", lib_Tcl_backslash, 1); - rb_define_module_function(lib, "encoding_system", + rb_define_module_function(lib, "encoding_system", lib_get_system_encoding, 0); - rb_define_module_function(lib, "encoding_system=", + rb_define_module_function(lib, "encoding_system=", lib_set_system_encoding, 1); - rb_define_module_function(lib, "encoding", + rb_define_module_function(lib, "encoding", lib_get_system_encoding, 0); - rb_define_module_function(lib, "encoding=", + rb_define_module_function(lib, "encoding=", lib_set_system_encoding, 1); /* --------------------------------------------------------------- */ @@ -10491,7 +10725,7 @@ /* --------------------------------------------------------------- */ - rb_define_method(ip, "create_dummy_encoding_for_tk", + rb_define_method(ip, "create_dummy_encoding_for_tk", create_dummy_encoding_for_tk, 1); rb_define_method(ip, "encoding_table", ip_get_encoding_table, 0); @@ -10525,9 +10759,9 @@ rb_define_method(ip, "mainloop", ip_mainloop, -1); rb_define_method(ip, "mainloop_watchdog", ip_mainloop_watchdog, -1); rb_define_method(ip, "do_one_event", ip_do_one_event, -1); - rb_define_method(ip, "mainloop_abort_on_exception", + rb_define_method(ip, "mainloop_abort_on_exception", ip_evloop_abort_on_exc, 0); - rb_define_method(ip, "mainloop_abort_on_exception=", + rb_define_method(ip, "mainloop_abort_on_exception=", ip_evloop_abort_on_exc_set, 1); rb_define_method(ip, "set_eventloop_tick", ip_set_eventloop_tick, 1); rb_define_method(ip, "get_eventloop_tick", ip_get_eventloop_tick, 0); @@ -10545,7 +10779,7 @@ #ifndef DEFAULT_EVENTLOOP_DEPTH #define DEFAULT_EVENTLOOP_DEPTH 7 -#endif +#endif eventloop_stack = rb_ary_new2(DEFAULT_EVENTLOOP_DEPTH); RbTk_OBJ_UNTRUST(eventloop_stack); @@ -10556,7 +10790,7 @@ /* --------------------------------------------------------------- */ #ifdef HAVE_NATIVETHREAD - /* if ruby->nativethread-supprt and tcltklib->doen't, + /* if ruby->nativethread-supprt and tcltklib->doen't, the following will cause link-error. */ ruby_native_thread_p(); #endif @@ -10581,6 +10815,19 @@ /* --------------------------------------------------------------- */ +#if defined CREATE_RUBYTK_KIT +#ifdef __WIN32__ + rbtk_win32_SetHINSTANCE("tcltklib.so"); +#endif + tcltklib_filepath = strdup(rb_sourcefile()); +#endif +#if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT + init_static_tcltk_packages(); + setup_preInitCmd(tcltklib_filepath); +#endif + + /* --------------------------------------------------------------- */ + /* Tcl stub check */ tcl_stubs_check(); Index: ruby_1_8/ext/tk/lib/tk.rb =================================================================== --- ruby_1_8/ext/tk/lib/tk.rb (revision 28111) +++ ruby_1_8/ext/tk/lib/tk.rb (revision 28112) @@ -1179,40 +1179,43 @@ unless self.const_defined? :RUN_EVENTLOOP_ON_MAIN_THREAD if WITH_RUBY_VM ### check Ruby 1.9 !!!!!!! # *** NEED TO FIX *** - ip = TclTkIp.new(name, opts) - if RUBY_PLATFORM =~ /cygwin/ + case RUBY_PLATFORM + when /cygwin/ RUN_EVENTLOOP_ON_MAIN_THREAD = true - INTERP = ip - elsif ip._invoke_without_enc('tk', 'windowingsystem') == 'aqua' && - (TclTkLib.get_version<=>[8,4,TclTkLib::RELEASE_TYPE::FINAL,6]) > 0 - # *** KNOWN BUG *** - # Main event loop thread of TkAqua (> Tk8.4.9) must be the main - # application thread. So, ruby1.9 users must call Tk.mainloop on - # the main application thread. - # - # *** ADD (2009/05/10) *** - # In some cases (I don't know the description of conditions), - # TkAqua 8.4.7 has a same kind of hang-up trouble. - # So, if 8.4.7 or later, set RUN_EVENTLOOP_ON_MAIN_THREAD to true. - # When you want to control this mode, please call the following - # (set true/false as you want) before "require 'tk'". - # ---------------------------------------------------------- - # module TkCore; RUN_EVENTLOOP_ON_MAIN_THREAD = true; end - # ---------------------------------------------------------- - # - RUN_EVENTLOOP_ON_MAIN_THREAD = true - INTERP = ip - else - unless self.const_defined? :RUN_EVENTLOOP_ON_MAIN_THREAD + when /darwin/ # MacOS X +=begin + ip = TclTkIp.new(name, opts) + if ip._invoke_without_enc('tk', 'windowingsystem') == 'aqua' && + (TclTkLib.get_version<=>[8,4,TclTkLib::RELEASE_TYPE::FINAL,6]) > 0 +=end + if TclTkLib::WINDOWING_SYSTEM == 'aqua' && + (TclTkLib.get_version<=>[8,4,TclTkLib::RELEASE_TYPE::FINAL,6]) > 0 + # *** KNOWN BUG *** + # Main event loop thread of TkAqua (> Tk8.4.9) must be the main + # application thread. So, ruby1.9 users must call Tk.mainloop on + # the main application thread. + # + # *** ADD (2009/05/10) *** + # In some cases (I don't know the description of conditions), + # TkAqua 8.4.7 has a same kind of hang-up trouble. + # So, if 8.4.7 or later, set RUN_EVENTLOOP_ON_MAIN_THREAD to true. + # When you want to control this mode, please call the following + # (set true/false as you want) before "require 'tk'". + # ---------------------------------------------------------- + # module TkCore; RUN_EVENTLOOP_ON_MAIN_THREAD = true; end + # ---------------------------------------------------------- + # + RUN_EVENTLOOP_ON_MAIN_THREAD = true + else RUN_EVENTLOOP_ON_MAIN_THREAD = false - end - if RUN_EVENTLOOP_ON_MAIN_THREAD - INTERP = ip - else +=begin ip.delete + ip = nil +=end end + else + RUN_EVENTLOOP_ON_MAIN_THREAD = false end - ip = nil else # Ruby 1.8.x RUN_EVENTLOOP_ON_MAIN_THREAD = false @@ -1243,6 +1246,30 @@ Thread.current[:status] = status #sleep + # like as 1.8, withdraw a root widget before calling Tk.mainloop + interp._eval <<EOS +rename wm __wm_orig__ +proc wm {subcmd win args} { + eval [list __wm_orig__ $subcmd $win] $args + if {[string equal $subcmd withdraw] && [string equal $win .]} { + rename wm {} + rename __wm_orig__ wm + } +} +proc __startup_rbtk_mainloop__ {args} { + rename __startup_rbtk_mainloop__ {} + if {[info command __wm_orig__] == "__wm_orig__"} { + rename wm {} + rename __wm_orig__ wm + if [string equal [wm state .] withdrawn] { + wm deiconify . + } + } +} +set __initial_state_of_rubytk__ 1 +trace add variable __initial_state_of_rubytk__ unset __startup_rbtk_mainloop__ +EOS + begin begin #TclTkLib.mainloop_abort_on_exception = false @@ -1808,6 +1835,9 @@ return TkCore::INTERP._thread_tkwait('window', '.') if check_root end + # like as 1.8, withdraw a root widget before calling Tk.mainloop + TkCore::INTERP._eval_without_enc('unset __initail_state_of_rubytk__') + begin TclTkLib.set_eventloop_window_mode(true) if check_root @@ -5663,7 +5693,7 @@ #Tk.freeze module Tk - RELEASE_DATE = '2010-02-01'.freeze + RELEASE_DATE = '2010-05-31'.freeze autoload :AUTO_PATH, 'tk/variable' autoload :TCL_PACKAGE_PATH, 'tk/variable' Index: ruby_1_8/ext/tk/extconf.rb =================================================================== --- ruby_1_8/ext/tk/extconf.rb (revision 28111) +++ ruby_1_8/ext/tk/extconf.rb (revision 28112) @@ -1,13 +1,14 @@ ############################################################## # extconf.rb for tcltklib -# release date: 2010-05-19 +# release date: 2010-05-31 ############################################################## require 'mkmf' TkLib_Config = {} TkLib_Config['search_versions'] = # %w[8.9 8.8 8.7 8.6 8.5 8.4 8.3 8.2 8.1 8.0 7.6 4.2] - %w[8.7 8.6 8.5 8.4 8.3 8.2 8.1 8.0] + # %w[8.7 8.6 8.5 8.4 8.3 8.2 8.1 8.0] + %w[8.7 8.6 8.5 8.4 8.0] # to shorten search steps ############################################################## @@ -178,7 +179,9 @@ path_dirs = [] if TkLib_Config["ActiveTcl"].kind_of?(String) # glob path - path_dirs.concat Dir.glob(TkLib_Config["ActiveTcl"], File::FNM_CASEFOLD).sort.reverse + # path_head << TkLib_Config["ActiveTcl"] + path_head.concat Dir.glob(TkLib_Config["ActiveTcl"], File::FNM_CASEFOLD).sort.reverse + # path_dirs.concat Dir.glob(File.join(TkLib_Config["ActiveTcl"], 'lib'), File::FNM_CASEFOLD).sort.reverse end if CROSS_COMPILING @@ -288,6 +291,7 @@ "/Library/Frameworks", "/Network/Library/Frameworks", "/System/Library/Frameworks" ] + paths.reverse! unless TkLib_Config["ActiveTcl"] # system has higher priority paths.map{|dir| dir.strip.chomp('/')}.each{|dir| next unless File.directory?(tcldir = File.join(dir, "Tcl.framework")) @@ -379,7 +383,7 @@ if TkLib_Config["ActiveTcl"] dirs = [] if TkLib_Config["ActiveTcl"].kind_of?(String) - dirs << TkLib_Config["ActiveTcl"] + dirs << File.join(TkLib_Config["ActiveTcl"], 'lib') end dirs.concat [ "c:/ActiveTcl*/lib", "c:/Tcl*/lib", @@ -411,13 +415,32 @@ config_dir.concat(dirs.zip(dirs)) - elsif framework = find_macosx_framework() - config_dir.unshift(framework) + else + if framework = find_macosx_framework() + config_dir.unshift(framework) + end - else if activeTcl = TkLib_Config['ActiveTcl'] # check latest version at first - config_dir.concat(Dir.glob(activeTcl, File::FNM_CASEFOLD).sort.reverse) + if is_macosx? + base = File.expand_path(activeTcl) + config_dir << [ + File.join(base, 'Tcl.framework'), File.join(base, 'Tk.framework') + ] + + config_dir << [ + File.join(base, 'Tcl.framework', 'Versions', 'Current'), + File.join(base, 'Tk.framework', 'Versions', 'Current') + ] + + Dir.glob(File.join(base, 'Tcl.framework', + 'Versions', '*')).sort.reverse.each{|dir| + next if dir =~ /Current/ + config_dir << [dir, dir.gsub(/Tcl/, 'Tk')] + } + else + config_dir.concat(Dir.glob(File.join(activeTcl, 'lib'), File::FNM_CASEFOLD).sort.reverse) + end end config_dir.concat [ @@ -448,27 +471,88 @@ } # for MacOS X - #config_dir << "~/Library/Tcl" - #config_dir.concat(Dir.glob("~/Library/Tcl/*", File::FNM_CASEFOLD).sort.reverse) - config_dir << "/Library/Tcl" - config_dir.concat(Dir.glob("/Library/Tcl/*", File::FNM_CASEFOLD).sort.reverse) - config_dir << "/Network/Library/Tcl" - config_dir.concat(Dir.glob("/Network/Library/Tcl/*", File::FNM_CASEFOLD).sort.reverse) - config_dir << "/System/Library/Tcl" - config_dir.concat(Dir.glob("/System/Library/Tcl/*", File::FNM_CASEFOLD).sort.reverse) - [ + paths = [ + #"~/Library/Tcl", + "/Library/Tcl", "/Network/Library/Tcl", "/System/Library/Tcl" + ] + paths.reverse! unless TkLib_Config["ActiveTcl"] + + paths.each{|path| + config_dir << path + config_dir.concat(Dir.glob(File.join(path, '{tcl,tk}*'), File::FNM_CASEFOLD).sort.reverse.find_all{|d| File.directory?(d)}) + } + + paths = [ #"~/Library/Frameworks", "/Library/Frameworks", "/Network/Library/Frameworks", "/System/Library/Frameworks" - ].each{|framework| - config_dir << [File.expand_path(File.join(framework, 'Tcl.framework')), - File.expand_path(File.join(framework, 'Tk.framework'))] + ] + paths.reverse! unless TkLib_Config["ActiveTcl"] + + paths.each{|framework| + base = File.expand_path(framework) + config_dir << [ + File.join(base, 'Tcl.framework'), File.join(base, 'Tk.framework') + ] + + config_dir << [ + File.join(base, 'Tcl.framework', 'Versions', 'Current'), + File.join(base, 'Tk.framework', 'Versions', 'Current') + ] + + Dir.glob(File.join(base, 'Tcl.framework', + 'Versions', '*')).sort.reverse.each{|dir| + next if dir =~ /Current/ + config_dir << [dir, dir.gsub(/Tcl/, 'Tk')] + } } end config_dir end +def libcheck_for_tclConfig(dir, tclconf, tkconf) + tcllib_ok = tklib_ok = false + + if TkLib_Config["tcltk-stubs"] + stub = "stub" + tclfunc = "Tcl_InitStubs" + tkfunc = "Tk_InitStubs" + else + stub = "" + tclfunc = "Tcl_FindExecutable" + tkfunc = "Tk_Init" + end + + libpath = $LIBPATH + tcllibs = nil + + begin + tcllib_ok ||= Dir.glob(File.join(dir, "*tcl#{stub}#{tclconf['TCL_MAJOR_VERSION']}{.,}#{tclconf['TCL_MINOR_VERSION']}*.*"), File::FNM_CASEFOLD).find{|file| + if file =~ /^.*(tcl#{stub}#{tclconf['TCL_MAJOR_VERSION']}(\.|)#{tclconf['TCL_MINOR_VERSION']}.*)\.[^.]*$/ + #puts "check #{file} #{$1} #{tclfunc} #{dir}" + #find_library($1, tclfunc, dir) + tcllibs = append_library($libs, $1) + $LIBPATH = libpath | [dir] + try_func(tclfunc, tcllibs) + end + } + tklib_ok ||= Dir.glob(File.join(dir, "*tk#{stub}#{tkconf['TK_MAJOR_VERSION']}{.,}#{tkconf['TK_MINOR_VERSION']}*.*"), File::FNM_CASEFOLD).find{|file| + if file =~ /^.*(tk#{stub}#{tkconf['TK_MAJOR_VERSION']}(\.|)#{tkconf['TK_MINOR_VERSION']}.*)\.[^.]*$/ + #puts "check #{file} #{$1} #{tkfunc} #{dir}" + # find_library($1, tkfunc, dir) + tklibs = append_library(tcllibs, $1) + $LIBPATH = libpath | [dir] + try_func(tkfunc, tklibs) + end + } + ensure + $LIBPATH = libpath + end + + [tcllib_ok, tklib_ok] +end + def search_tclConfig(*paths) # libdir list or [tcl-libdir|file, tk-libdir|file] TkLib_Config["tclConfig_paths"] = [] @@ -518,7 +602,7 @@ if File.file?(tkdir) tkcfg_files = [tkdir] * tails.length else - tkcfg_files = tails.map{|f| File.join(tcldir, 'tk' << f)} + tkcfg_files = tails.map{|f| File.join(tkdir, 'tk' << f)} end tclcfg_files.zip(tkcfg_files).uniq.each{|tclpath, tkpath| @@ -532,7 +616,7 @@ # nativethread check if !TkLib_Config["ruby_with_thread"] && tclconf['TCL_THREADS'] == '1' - puts "WARNING: found #{tclpath.inspect}, but it WITH nativethread-support under ruby WITHOUT nativethread-support. So, ignore it." + puts "\nWARNING: found #{tclpath.inspect}, but it WITH nativethread-support under ruby WITHOUT nativethread-support. So, ignore it." TkLib_Config["tcltk-NG-path"] << File.dirname(tclpath) next end @@ -541,43 +625,54 @@ conf = [tclconf, tkconf] unless conf # check Tcl library - if TkLib_Config["tcltk-stubs"] - stub = "stub" - tclfunc = "Tcl_InitStubs" - tkfunc = "Tk_InitStubs" + if is_macosx? && TkLib_Config["tcltk-framework"] + # if use framework, not check (believe it is installed properly) + tcllib_ok = tklib_ok = true else - stub = "" - tclfunc = "Tcl_FindExecutable" - tkfunc = "Tk_Init" + tcllib_ok, tklib_ok = libcheck_for_tclConfig(File.dirname(tclpath), + tclconf, tkconf) +=begin + tcllib_ok = tklib_ok = false + if TkLib_Config["tcltk-stubs"] + stub = "stub" + tclfunc = "Tcl_InitStubs" + tkfunc = "Tk_InitStubs" + else + stub = "" + tclfunc = "Tcl_FindExecutable" + tkfunc = "Tk_Init" + end + dir = File.dirname(tclpath) + libpath = $LIBPATH + tcllibs = nil + + begin + tcllib_ok ||= Dir.glob(File.join(dir, "*tcl#{stub}#{tclconf['TCL_MAJOR_VERSION']}{.,}#{tclconf['TCL_MINOR_VERSION']}*.*"), File::FNM_CASEFOLD).find{|file| + if file =~ /^.*(tcl#{stub}#{tclconf['TCL_MAJOR_VERSION']}(\.|)#{tclconf['TCL_MINOR_VERSION']}.*)\.[^.]*$/ + #puts "check #{file} #{$1} #{tclfunc} #{dir}" + #find_library($1, tclfunc, dir) + tcllibs = append_library($libs, $1) + $LIBPATH = libpath | [dir] + try_func(tclfunc, tcllibs) + end + } + tklib_ok ||= Dir.glob(File.join(dir, "*tk#{stub}#{tkconf['TK_MAJOR_VERSION']}{.,}#{tkconf['TK_MINOR_VERSION']}*.*"), File::FNM_CASEFOLD).find{|file| + if file =~ /^.*(tk#{stub}#{tkconf['TK_MAJOR_VERSION']}(\.|)#{tkconf['TK_MINOR_VERSION']}.*)\.[^.]*$/ + #puts "check #{file} #{$1} #{tkfunc} #{dir}" + # find_library($1, tkfunc, dir) + tklibs = append_library(tcllibs, $1) + $LIBPATH = libpath | [dir] + try_func(tkfunc, tklibs) + end + } + ensure + $LIBPATH = libpath + end +=end end - dir = File.dirname(tclpath) - libpath = $LIBPATH - tcllibs = nil - begin - tcllib_ok = Dir.glob(File.join(dir, "*tcl#{stub}#{tclconf['TCL_MAJOR_VERSION']}{.,}#{tclconf['TCL_MINOR_VERSION']}*.*"), File::FNM_CASEFOLD).find{|file| - if file =~ /^.*(tcl#{stub}#{tclconf['TCL_MAJOR_VERSION']}(\.|)#{tclconf['TCL_MINOR_VERSION']}.*)\.[^.]*$/ - #puts "check #{file} #{$1} #{tclfunc} #{dir}" - #find_library($1, tclfunc, dir) - tcllibs = append_library($libs, $1) - $LIBPATH = libpath | [dir] - try_func(tclfunc, tcllibs) - end - } - tklib_ok = Dir.glob(File.join(dir, "*tk#{stub}#{tkconf['TK_MAJOR_VERSION']}{.,}#{tkconf['TK_MINOR_VERSION']}*.*"), File::FNM_CASEFOLD).find{|file| - if file =~ /^.*(tk#{stub}#{tkconf['TK_MAJOR_VERSION']}(\.|)#{tkconf['TK_MINOR_VERSION']}.*)\.[^.]*$/ - #puts "check #{file} #{$1} #{tkfunc} #{dir}" - # find_library($1, tkfunc, dir) - tklibs = append_library(tcllibs, $1) - $LIBPATH = libpath | [dir] - try_func(tkfunc, tklibs) - end - } - ensure - $LIBPATH = libpath - end unless tcllib_ok && tklib_ok - puts "WARNING: found #{tclpath.inspect}, but cannot find valid Tcl/Tk libraries on the same directory. So, ignore it." + puts "\nWARNING: found #{tclpath.inspect}, but cannot find valid Tcl/Tk libraries on the same directory. So, ignore it." TkLib_Config["tcltk-NG-path"] << File.dirname(tclpath) next end @@ -590,6 +685,13 @@ # print("\n"); } + if is_macosx? && TkLib_Config["tcltk-stubs"] + CONFIG['LDSHARED'] << " -Xlinker -bind_at_load" + if config_string('LDSHAREDXX') + config_string('LDSHAREDXX') << " -Xlinker -bind_at_load" + end + end + if TkLib_Config["tclConfig_paths"].empty? [nil, nil] else @@ -691,6 +793,10 @@ else dirs = [] + if Dir.glob(head, File::FNM_CASEFOLD).find{|dir| dir == head} + dirs << head + "/lib" + end + if !Dir.glob(head + "-*", File::FNM_CASEFOLD).empty? dirs << head + "-#{ver}/lib" if !Dir.glob(head + "-[89].*", File::FNM_CASEFOLD).empty? dirs << head + "-#{ver.delete('.')}/lib" if !Dir.glob(head + "-[89][0-9]*", File::FNM_CASEFOLD).empty? @@ -718,7 +824,7 @@ path_list = check_NG_path(path_list) path_list.map!{|path| path.strip} - if !CROSS_COMPILING and is_win32? + if !CROSS_COMPILING and (is_win32? || is_macosx?) # exist-dir only path_list.delete_if{|path| Dir.glob(File.join(path, "*.{a,so,dll,lib}")).empty?} end @@ -1031,29 +1137,52 @@ have_tcl_h && have_tk_h end -def setup_for_macosx_framework - # search directory of header files - if File.exist?(dir = File.join(TkLib_Config["tcltk-framework"], - 'Tcl.framework', 'Headers')) - TclConfig_Info['TCL_INCLUDE_SPEC'] = "-I#{dir} " - TkConfig_Info['TK_INCLUDE_SPEC'] = "-I#{File.join(TkLib_Config['tcltk-framework'], 'Tk.framework', 'Headers')} " - else - dir = Dir.glob(File.join(TkLib_Config["tcltk-framework"], - 'Tcl.framework', '*', 'Headers'), - File::FNM_CASEFOLD) - TclConfig_Info['TCL_INCLUDE_SPEC'] = "-I#{dir[0]} " unless dir.empty? - TkConfig_Info['TK_INCLUDE_SPEC'] = "-I#{Dir.glob(File.join(TkLib_Config['tcltk-framework'], 'Tk.framework', '*', 'Headers'), File::FNM_CASEFOLD)[0]} " +def setup_for_macosx_framework(tclver, tkver) + # use framework, but no tclConfig.sh + unless $LDFLAGS.include?('-framework') + $LDFLAGS << ' -framework Tk -framework Tcl' end - $LDFLAGS << ' -framework Tk -framework Tcl' + if TkLib_Config["tcl-framework-header"] + TclConfig_Info['TCL_INCLUDE_SPEC'] << + "-I#{TkLib_Config["tcl-framework-header"].quote} " + else + TclConfig_Info['TCL_INCLUDE_SPEC'] = "" - if TkLib_Config["tcl-framework-header"] - TclConfig_Info['TCL_INCLUDE_SPEC'] = - "-I#{TkLib_Config["tcl-framework-header"]} " + tcl_base = File.join(TkLib_Config["tcltk-framework"], 'Tcl.framework') + if tclver + TclConfig_Info['TCL_INCLUDE_SPEC'] << + "-I#{File.join(tcl_base, 'Versions', tclver, 'Headers').quote} " + end + + TclConfig_Info['TCL_INCLUDE_SPEC'] << File.join(tcl_base, 'Headers') + + unless tclver + dir = Dir.glob(File.join(tcl_base, 'Versions', '*', 'Headers'), + File::FNM_CASEFOLD).sort.reverse[0] + TclConfig_Info['TCL_INCLUDE_SPEC'] << "-I#{dir.quote} " if dir + end end + if TkLib_Config["tk-framework-header"] TkConfig_Info['TK_INCLUDE_SPEC'] = - "-I#{TkLib_Config["tk-framework-header"]} " + "-I#{TkLib_Config["tk-framework-header"].quote} " + else + TkConfig_Info['TK_INCLUDE_SPEC'] = "" + + tk_base = File.join(TkLib_Config["tcltk-framework"], 'Tk.framework') + if tkver + TkConfig_Info['TK_INCLUDE_SPEC'] << + "-I#{File.join(tk_base, 'Versions', tkver, 'Headers').quote} " + end + + TkConfig_Info['TK_INCLUDE_SPEC'] << File.join(tk_base, 'Headers') + + unless tkver + dir = Dir.glob(File.join(tk_base, 'Versions', '*', 'Headers'), + File::FNM_CASEFOLD).sort.reverse[0] + TkConfig_Info['TK_INCLUDE_SPEC'] << "-I#{dir.quote} " if dir + end end end @@ -1320,7 +1449,17 @@ #if activeTcl = with_config("ActiveTcl") if activeTcl = with_config("ActiveTcl", true) puts("Use ActiveTcl libraries (if available).") - activeTcl = '/opt/ActiveTcl*/lib' unless activeTcl.kind_of? String + unless activeTcl.kind_of? String + # set default ActiveTcl path + if CROSS_COMPILING + elsif is_win32? + activeTcl = 'c:/Tcl*' + elsif is_macosx? + activeTcl = '/Library/Frameworks' + else + activeTcl = '/opt/ActiveTcl*' + end + end end TkLib_Config["ActiveTcl"] = activeTcl @@ -1379,7 +1518,6 @@ tk_ldir_list = [tk_ldir, tk_cfg_dir] tcl_ldir_list = [tcl_ldir, tcl_cfg_dir] - # check tk_shlib_search_path check_shlib_search_path(with_config('tk-shlib-search-path')) @@ -1391,7 +1529,25 @@ # MacOS X Frameworks? if TkLib_Config["tcltk-framework"] puts("Use MacOS X Frameworks.") - setup_for_macosx_framework + if tcl_cfg_dir + $INCFLAGS << ' ' << TclConfig_Info['TCL_INCLUDE_SPEC'] + $LDFLAGS << ' ' << TclConfig_Info['TCL_LIBS'] + if stubs + $LDFLAGS << ' ' << TclConfig_Info['TCL_STUB_LIB_SPEC'] + else + $LDFLAGS << ' ' << TclConfig_Info['TCL_LIB_SPEC'] + end + end + if tk_cfg_dir + $INCFLAGS << ' ' << TkConfig_Info['TK_INCLUDE_SPEC'] + $LDFLAGS << ' ' << TkConfig_Info['TK_LIBS'] + if stubs + $LDFLAGS << ' ' << TkConfig_Info['TK_STUB_LIB_SPEC'] + else + $LDFLAGS << ' ' << TkConfig_Info['TK_LIB_SPEC'] + end + end + setup_for_macosx_framework(tclver, tkver) if tcl_cfg_dir && tk_cfg_dir end # name of Tcl/Tk libraries Index: ruby_1_8/ChangeLog =================================================================== --- ruby_1_8/ChangeLog (revision 28111) +++ ruby_1_8/ChangeLog (revision 28112) @@ -1,3 +1,15 @@ +Mon May 31 23:44:22 2010 Hidetoshi NAGAI <nagai@a...> + + * ext/tk/extconf.rb: use tclConfig.sh/tkConfig.sh when frameworks + are enabled on MacOS X. + + * ext/tk/stubs.c: dirty hack for frameworks and stubs on MacOS X. + + * ext/tk/lib/tk.rb: stop creating a dummy Tcl/Tk interpreter. + And hide a root window before starting eventloop. (for ruby 1.9) + + * ext/tk/tcltklib.c: add codes to support Ruby/Tk-Kit (Rubykit). + Fri May 28 17:34:48 2010 URABE Shyouhei <shyouhei@r...> * array.c (rb_ary_product): Ensure arrays to be marked by GC. -- ML: ruby-changes@q... Info: http://www.atdot.net/~ko1/quickml/