summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
Diffstat (limited to 'ext')
-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;
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-18 07:33:00 +0000