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