summaryrefslogtreecommitdiff
path: root/ext/tk
diff options
context:
space:
mode:
authornagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>2009-08-03 19:01:03 +0000
committernagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>2009-08-03 19:01:03 +0000
commit4293a98596af89a882629e47e84da8e5c05e1459 (patch)
tree3160ddeb2ae6ae668b13922b4a53c2cc15cbf6cc /ext/tk
parent6b639283743fbae46db9fbe51960c674bb410ed2 (diff)
* ext/tk/lib/tcltklib.c: fix trouble on old-style C function
declarations [ruby-core:22871]. * ext/tk/lib/tcltklib.c: (ruby_1_8) fix warning about RUBY_RELEASE_DATE * ext/tk/lib/tk/multi-tk.rb: kill zombie threads. * ext/tk/lib/tk/fontchooser.rb: fix typo and support OptionObj. * ext/tk/lib/tk/canvas.rb, ext/tk/lib/tk/virtevent.rb, ext/tk/lib/tk/image.rb, , ext/tk/lib/tk/timer.rb: create unnecessary array. git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@24377 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
Diffstat (limited to 'ext/tk')
-rw-r--r--ext/tk/lib/multi-tk.rb65
-rw-r--r--ext/tk/lib/tk.rb2
-rw-r--r--ext/tk/lib/tk/canvas.rb2
-rw-r--r--ext/tk/lib/tk/fontchooser.rb20
-rw-r--r--ext/tk/lib/tk/image.rb2
-rw-r--r--ext/tk/lib/tk/timer.rb2
-rw-r--r--ext/tk/lib/tk/virtevent.rb2
-rw-r--r--ext/tk/tcltklib.c264
8 files changed, 293 insertions, 66 deletions
diff --git a/ext/tk/lib/multi-tk.rb b/ext/tk/lib/multi-tk.rb
index c491d0c7ba..dc8a31e2e8 100644
--- a/ext/tk/lib/multi-tk.rb
+++ b/ext/tk/lib/multi-tk.rb
@@ -118,6 +118,27 @@ MultiTkIp_OK.freeze
################################################
# methods for construction
class MultiTkIp
+ class Command_Queue < Queue
+ def initialize(interp)
+ @interp = interp
+ super()
+ end
+
+ def push(value)
+ if !@interp || @interp.deleted?
+ fail RuntimeError, "Tk interpreter is already deleted"
+ end
+ super(value)
+ end
+ alias << push
+ alias enq push
+
+ def close
+ @interp = nil
+ end
+ end
+ Command_Queue.freeze
+
BASE_DIR = File.dirname(__FILE__)
WITH_RUBY_VM = Object.const_defined?(:RubyVM) && ::RubyVM.class == Class
@@ -692,15 +713,29 @@ class MultiTkIp
begin
loop do
sleep 1
- receiver.kill if @interp.deleted?
+ if @interp.deleted?
+ receiver.kill
+ @cmd_queue.close
+ end
break unless receiver.alive?
end
rescue Exception
# ignore all kind of Exception
end
+
# receiver is dead
+ retry_count = 3
loop do
- thread, cmd, *args = @cmd_queue.deq
+ Thread.pass
+ begin
+ thread, cmd, *args = @cmd_queue.deq(true) # non-block
+ rescue ThreadError
+ # queue is empty
+ retry_count -= 1
+ break if retry_count <= 0
+ sleep 0.5
+ retry
+ end
next unless thread
if thread.alive?
if @interp.deleted?
@@ -838,7 +873,7 @@ class MultiTkIp
@safe_level = [$SAFE]
- @cmd_queue = Queue.new
+ @cmd_queue = MultiTkIp::Command_Queue.new(@interp)
@cmd_receiver, @receiver_watchdog = _create_receiver_and_watchdog(@safe_level[0])
@@ -1228,6 +1263,7 @@ class MultiTkIp
@slave_ip_top[ip_name] = top_path
end
@interp._eval("::safe::loadTk #{ip_name} #{_keys2opts(tk_opts)}")
+ @interp._invoke('__replace_slave_tk_commands__', ip_name)
else
@slave_ip_top[ip_name] = nil
end
@@ -1259,6 +1295,7 @@ class MultiTkIp
slave_ip._invoke('set', 'argv0', name) if name.kind_of?(String)
slave_ip._invoke('set', 'argv', _keys2opts(keys))
@interp._invoke('load', '', 'Tk', ip_name)
+ @interp._invoke('__replace_slave_tk_commands__', ip_name)
@slave_ip_tbl[ip_name] = slave_ip
[slave_ip, ip_name]
end
@@ -1373,16 +1410,20 @@ class MultiTkIp
current[:status] = status
begin
- current[:status].value = interp.mainloop(true)
- rescue SystemExit=>e
- current[:status].value = e
- rescue Exception=>e
- current[:status].value = e
- retry if interp.has_mainwindow?
+ begin
+ current[:status].value = interp.mainloop(true)
+ rescue SystemExit=>e
+ current[:status].value = e
+ rescue Exception=>e
+ current[:status].value = e
+ retry if interp.has_mainwindow?
+ ensure
+ mutex.synchronize{ cond_var.broadcast }
+ end
+ current[:status].value = interp.mainloop(false)
ensure
- mutex.synchronize{ cond_var.broadcast }
+ interp.delete
end
- current[:status].value = interp.mainloop(false)
}
until @interp_thread[:interp]
Thread.pass
@@ -1456,7 +1497,7 @@ class MultiTkIp
@pseudo_toplevel = [false, nil]
- @cmd_queue = Queue.new
+ @cmd_queue = MultiTkIp::Command_Queue.new(@interp)
=begin
@cmd_receiver, @receiver_watchdog = _create_receiver_and_watchdog(@safe_level[0])
diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb
index f97c02dfad..7552abed91 100644
--- a/ext/tk/lib/tk.rb
+++ b/ext/tk/lib/tk.rb
@@ -5653,7 +5653,7 @@ TkWidget = TkWindow
#Tk.freeze
module Tk
- RELEASE_DATE = '2009-07-18'.freeze
+ RELEASE_DATE = '2009-08-04'.freeze
autoload :AUTO_PATH, 'tk/variable'
autoload :TCL_PACKAGE_PATH, 'tk/variable'
diff --git a/ext/tk/lib/tk/canvas.rb b/ext/tk/lib/tk/canvas.rb
index 1e24c0be97..602139e00a 100644
--- a/ext/tk/lib/tk/canvas.rb
+++ b/ext/tk/lib/tk/canvas.rb
@@ -172,7 +172,7 @@ class Tk::Canvas<TkWindow
alias canvas_y canvasy
def coords(tag, *args)
- if args == []
+ if args.empty?
tk_split_list(tk_send_without_enc('coords', tagid(tag)))
else
tk_send_without_enc('coords', tagid(tag), *(args.flatten))
diff --git a/ext/tk/lib/tk/fontchooser.rb b/ext/tk/lib/tk/fontchooser.rb
index f9f816be59..092ffc04bf 100644
--- a/ext/tk/lib/tk/fontchooser.rb
+++ b/ext/tk/lib/tk/fontchooser.rb
@@ -31,7 +31,7 @@ class << TkFont::Chooser
end
end
- def __conviginfo_value(key, val)
+ def __configinfo_value(key, val)
case key
when 'parent'
window(val)
@@ -51,7 +51,7 @@ class << TkFont::Chooser
val
end
end
- private :__conviginfo_value
+ private :__configinfo_value
def configinfo(option=nil)
if !option && TkComm::GET_CONFIGINFOwoRES_AS_ARRAY
@@ -59,7 +59,7 @@ class << TkFont::Chooser
ret = []
TkComm.slice_ary(lst, 2){|k, v|
k = k[1..-1]
- ret << [k, __conviginfo_value(k, v)]
+ ret << [k, __configinfo_value(k, v)]
}
ret
else
@@ -71,14 +71,14 @@ class << TkFont::Chooser
if option
opt = option.to_s
fail ArgumentError, "Invalid option `#{option.inspect}'" if opt.empty?
- __conviginfo_value(option.to_s, tk_call('tk','fontchooser',
+ __configinfo_value(option.to_s, tk_call('tk','fontchooser',
'configure',"-#{opt}"))
else
lst = tk_split_simplelist(tk_call('tk', 'fontchooser', 'configure'))
ret = {}
TkComm.slice_ary(lst, 2){|k, v|
k = k[1..-1]
- ret[k] = __conviginfo_value(k, v)
+ ret[k] = __configinfo_value(k, v)
}
ret
end
@@ -146,6 +146,16 @@ class << TkFont::Chooser
target.configure(TkFont.actual_hash(fnt))
}
}
+ elsif target.kind_of? Hash
+ # key=>value list or OptionObj
+ fnt = target[:font] rescue ''
+ fnt = fnt.actual_hash if fnt.kind_of?(TkFont)
+ configs = {
+ :font => fnt,
+ :command=>proc{|fnt, *args|
+ target[:font] = TkFont.actual_hash(fnt)
+ }
+ }
else
configs = {
:font=>target.cget_tkstring(:font),
diff --git a/ext/tk/lib/tk/image.rb b/ext/tk/lib/tk/image.rb
index 79d9ce8d00..39d63478a6 100644
--- a/ext/tk/lib/tk/image.rb
+++ b/ext/tk/lib/tk/image.rb
@@ -211,7 +211,7 @@ class TkPhotoImage<TkImage
end
def put(data, *opts)
- if opts == []
+ if opts.empty?
tk_send('put', data)
elsif opts.size == 1 && opts[0].kind_of?(Hash)
tk_send('put', data, *_photo_hash_kv(opts[0]))
diff --git a/ext/tk/lib/tk/timer.rb b/ext/tk/lib/tk/timer.rb
index be2a8919e4..ddfbfce9be 100644
--- a/ext/tk/lib/tk/timer.rb
+++ b/ext/tk/lib/tk/timer.rb
@@ -428,7 +428,7 @@ class TkTimer
def restart(*restart_args, &b)
cancel if @running
- if restart_args == [] && !b
+ if restart_args.empty? && !b
start(@init_sleep, @init_proc, *@init_args)
else
start(*restart_args, &b)
diff --git a/ext/tk/lib/tk/virtevent.rb b/ext/tk/lib/tk/virtevent.rb
index 19c0dac380..c11e9692e7 100644
--- a/ext/tk/lib/tk/virtevent.rb
+++ b/ext/tk/lib/tk/virtevent.rb
@@ -100,7 +100,7 @@ class TkVirtualEvent<TkObject
end
def delete(*sequences)
- if sequences == []
+ if sequences.empty?
tk_call_without_enc('event', 'delete', "<#{@id}>")
TkVirtualEventTBL.mutex.synchronize{
TkVirtualEventTBL.delete(@id)
diff --git a/ext/tk/tcltklib.c b/ext/tk/tcltklib.c
index cc3c0e9b8d..a926d3f5d0 100644
--- a/ext/tk/tcltklib.c
+++ b/ext/tk/tcltklib.c
@@ -4,7 +4,7 @@
* Oct. 24, 1997 Y. Matsumoto
*/
-#define TCLTKLIB_RELEASE_DATE "2009-07-12"
+#define TCLTKLIB_RELEASE_DATE "2009-08-04"
#include "ruby.h"
@@ -12,6 +12,7 @@
#include "ruby/encoding.h"
#endif
#ifndef HAVE_RUBY_RUBY_H
+#undef RUBY_RELEASE_DATE
#include "version.h"
#endif
@@ -1538,8 +1539,12 @@ lib_num_of_mainwindows(self)
#ifdef RUBY_USE_NATIVE_THREAD /* Ruby 1.9+ !!! */
static VALUE
+#ifdef HAVE_PROTOTYPES
+call_DoOneEvent_core(VALUE flag_val)
+#else
call_DoOneEvent_core(flag_val)
VALUE flag_val;
+#endif
{
int flag;
@@ -1552,16 +1557,24 @@ call_DoOneEvent_core(flag_val)
}
static VALUE
+#ifdef HAVE_PROTOTYPES
+call_DoOneEvent(VALUE flag_val)
+#else
call_DoOneEvent(flag_val)
VALUE flag_val;
+#endif
{
return tk_funcall(call_DoOneEvent_core, 0, (VALUE*)NULL, flag_val);
}
#else /* Ruby 1.8- */
static VALUE
+#ifdef HAVE_PROTOTYPES
+call_DoOneEvent(VALUE flag_val)
+#else
call_DoOneEvent(flag_val)
VALUE flag_val;
+#endif
{
int flag;
@@ -1576,8 +1589,12 @@ call_DoOneEvent(flag_val)
static VALUE
+#ifdef HAVE_PROTOTYPES
+eventloop_sleep(VALUE dummy)
+#else
eventloop_sleep(dummy)
VALUE dummy;
+#endif
{
struct timeval t;
@@ -1585,7 +1602,7 @@ eventloop_sleep(dummy)
return Qnil;
}
- t.tv_sec = (time_t)0;
+ t.tv_sec = 0;
t.tv_usec = (long)(no_event_wait*1000.0);
#ifdef HAVE_NATIVETHREAD
@@ -1716,7 +1733,7 @@ lib_eventloop_core(check_root, update_flag, check_var, interp)
if (update_flag) DUMP1("update loop start!!");
- t.tv_sec = (time_t)0;
+ t.tv_sec = 0;
t.tv_usec = (long)(no_event_wait*1000.0);
Tcl_DeleteTimerHandler(timer_token);
@@ -2302,9 +2319,9 @@ lib_watchdog_core(check_rootwidget)
int check = RTEST(check_rootwidget);
struct timeval t0, t1;
- t0.tv_sec = (time_t)0;
+ t0.tv_sec = 0;
t0.tv_usec = (long)((NO_THREAD_INTERRUPT_TIME)*1000.0);
- t1.tv_sec = (time_t)0;
+ t1.tv_sec = 0;
t1.tv_usec = (long)((WATCHDOG_INTERVAL)*1000.0);
/* check other watchdog thread */
@@ -2446,8 +2463,12 @@ _thread_call_proc(arg)
}
static VALUE
+#ifdef HAVE_PROTOTYPES
+_thread_call_proc_value(VALUE th)
+#else
_thread_call_proc_value(th)
VALUE th;
+#endif
{
return rb_funcall(th, ID_value, 0);
}
@@ -2684,10 +2705,14 @@ TkStringValue(obj)
}
static int
+#ifdef HAVE_PROTOTYPES
+tcl_protect_core(Tcl_Interp *interp, VALUE (*proc)(VALUE), VALUE data)
+#else
tcl_protect_core(interp, proc, data) /* should not raise exception */
Tcl_Interp *interp;
VALUE (*proc)();
VALUE data;
+#endif
{
volatile VALUE ret, exc = Qnil;
int status = 0;
@@ -3205,18 +3230,28 @@ ip_ruby_cmd(clientData, interp, argc, argv)
/*****************************/
static int
#if TCL_MAJOR_VERSION >= 8
+#ifdef HAVE_PROTOTYPES
+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;
int argc;
Tcl_Obj *CONST argv[];
+#endif
#else /* TCL_MAJOR_VERSION < 8 */
+#ifdef HAVE_PROTOTYPES
+ip_InterpExitCommand(ClientData clientData, Tcl_Interp *interp,
+ int argc, char *argv[])
+#else
ip_InterpExitCommand(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char *argv[];
#endif
+#endif
{
DUMP1("start ip_InterpExitCommand");
if (interp != (Tcl_Interp*)NULL
@@ -3228,27 +3263,40 @@ ip_InterpExitCommand(clientData, interp, argc, argv)
Tcl_ResetResult(interp);
/* Tcl_Preserve(interp); */
/* Tcl_Eval(interp, "interp eval {} {destroy .}; interp delete {}"); */
- ip_finalize(interp);
- Tcl_DeleteInterp(interp);
- Tcl_Release(interp);
+ if (!Tcl_InterpDeleted(interp)) {
+ ip_finalize(interp);
+
+ Tcl_DeleteInterp(interp);
+ Tcl_Release(interp);
+ }
}
return TCL_OK;
}
static int
#if TCL_MAJOR_VERSION >= 8
+#ifdef HAVE_PROTOTYPES
+ip_RubyExitObjCmd(ClientData clientData, Tcl_Interp *interp,
+ int argc, Tcl_Obj *CONST argv[])
+#else
ip_RubyExitObjCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
Tcl_Obj *CONST argv[];
+#endif
#else /* TCL_MAJOR_VERSION < 8 */
+#ifdef HAVE_PROTOTYPES
+ip_RubyExitCommand(ClientData clientData, Tcl_Interp *interp,
+ int argc, char *argv[])
+#else
ip_RubyExitCommand(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char *argv[];
#endif
+#endif
{
int state;
char *cmd, *param;
@@ -3277,9 +3325,12 @@ ip_RubyExitCommand(clientData, interp, argc, argv)
Tcl_ResetResult(interp);
if (rb_safe_level() >= 4 || Tcl_IsSafe(interp)) {
- ip_finalize(interp);
- Tcl_DeleteInterp(interp);
- Tcl_Release(interp);
+ if (!Tcl_InterpDeleted(interp)) {
+ ip_finalize(interp);
+
+ Tcl_DeleteInterp(interp);
+ Tcl_Release(interp);
+ }
return TCL_OK;
}
@@ -3607,7 +3658,7 @@ ip_rb_threadUpdateCommand(clientData, interp, objc, objv)
DUMP1("set idle proc");
Tcl_DoWhenIdle(rb_threadUpdateProc, (ClientData) param);
- t.tv_sec = (time_t)0;
+ t.tv_sec = 0;
t.tv_usec = (long)((EVENT_HANDLER_TIMEOUT)*1000.0);
while(!param->done) {
@@ -3687,14 +3738,14 @@ VwaitVarProc(clientData, interp, name1, name2, flags)
#if TCL_MAJOR_VERSION >= 8
static int
ip_rbVwaitObjCmd(clientData, interp, objc, objv)
- ClientData clientData;
+ ClientData clientData; /* Not used */
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
#else /* TCL_MAJOR_VERSION < 8 */
static int
ip_rbVwaitCommand(clientData, interp, objc, objv)
- ClientData clientData;
+ ClientData clientData; /* Not used */
Tcl_Interp *interp;
int objc;
char *objv[];
@@ -3967,10 +4018,10 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
&& eventloop_thread != rb_thread_current()) {
#if TCL_MAJOR_VERSION >= 8
DUMP1("call ip_rb_threadTkWaitObjCmd");
- return ip_rb_threadTkWaitObjCmd(clientData, interp, objc, objv);
+ return ip_rb_threadTkWaitObjCmd((ClientData)tkwin, interp, objc, objv);
#else /* TCL_MAJOR_VERSION < 8 */
DUMP1("call ip_rb_threadTkWaitCommand");
- return ip_rb_threadTkWwaitCommand(clientData, interp, objc, objv);
+ return ip_rb_threadTkWwaitCommand((ClientData)tkwin, interp, objc, objv);
#endif
}
#endif
@@ -4394,7 +4445,7 @@ ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv)
#else /* TCL_MAJOR_VERSION < 8 */
static int
ip_rb_threadVwaitCommand(clientData, interp, objc, objv)
- ClientData clientData;
+ ClientData clientData; /* Not used */
Tcl_Interp *interp;
int objc;
char *objv[];
@@ -4500,7 +4551,7 @@ ip_rb_threadVwaitCommand(clientData, interp, objc, objv)
return TCL_ERROR;
}
- t.tv_sec = (time_t)0;
+ t.tv_sec = 0;
t.tv_usec = (long)((EVENT_HANDLER_TIMEOUT)*1000.0);
while(!param->done) {
@@ -4580,6 +4631,8 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
if (rb_thread_alone() || eventloop_thread == current_thread) {
#if TCL_MAJOR_VERSION >= 8
DUMP1("call ip_rbTkWaitObjCmd");
+ DUMP2("eventloop_thread %lx", eventloop_thread);
+ DUMP2("current_thread %lx", current_thread);
return ip_rbTkWaitObjCmd(clientData, interp, objc, objv);
#else /* TCL_MAJOR_VERSION < 8 */
DUMP1("call rb_VwaitCommand");
@@ -4722,7 +4775,7 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
return TCL_ERROR;
}
- t.tv_sec = (time_t)0;
+ t.tv_sec = 0;
t.tv_usec = (long)((EVENT_HANDLER_TIMEOUT)*1000.0);
while(!param->done) {
@@ -4808,7 +4861,7 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
- t.tv_sec = (time_t)0;
+ t.tv_sec = 0;
t.tv_usec = (long)((EVENT_HANDLER_TIMEOUT)*1000.0);
while(param->done != TKWAIT_MODE_VISIBILITY) {
@@ -4930,7 +4983,7 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
- t.tv_sec = (time_t)0;
+ t.tv_sec = 0;
t.tv_usec = (long)((EVENT_HANDLER_TIMEOUT)*1000.0);
while(param->done != TKWAIT_MODE_DESTROY) {
@@ -5049,11 +5102,13 @@ delete_slaves(ip)
slave = Tcl_GetSlave(ip, slave_name);
if (slave == (Tcl_Interp*)NULL) continue;
- /* call ip_finalize */
- ip_finalize(slave);
+ if (!Tcl_InterpDeleted(slave)) {
+ /* call ip_finalize */
+ ip_finalize(slave);
- Tcl_DeleteInterp(slave);
- /* Tcl_Release(slave); */
+ Tcl_DeleteInterp(slave);
+ /* Tcl_Release(slave); */
+ }
}
}
@@ -5091,10 +5146,12 @@ delete_slaves(ip)
slave = Tcl_GetSlave(ip, slave_name);
if (slave == (Tcl_Interp*)NULL) continue;
- /* call ip_finalize */
- ip_finalize(slave);
+ if (!Tcl_InterpDeleted(slave)) {
+ /* call ip_finalize */
+ ip_finalize(slave);
- Tcl_DeleteInterp(slave);
+ Tcl_DeleteInterp(slave);
+ }
}
}
}
@@ -5106,26 +5163,39 @@ delete_slaves(ip)
/* finalize operation */
static void
+#ifdef HAVE_PROTOTYPES
+lib_mark_at_exit(VALUE self)
+#else
lib_mark_at_exit(self)
VALUE self;
+#endif
{
at_exit = 1;
}
static int
#if TCL_MAJOR_VERSION >= 8
+#ifdef HAVE_PROTOTYPES
+ip_null_proc(ClientData clientData, Tcl_Interp *interp,
+ int argc, Tcl_Obj *CONST argv[])
+#else
ip_null_proc(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
Tcl_Obj *CONST argv[];
+#endif
#else /* TCL_MAJOR_VERSION < 8 */
+#ifdef HAVE_PROTOTYPES
+ip_null_proc(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
+#else
ip_null_proc(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char *argv[];
#endif
+#endif
{
Tcl_ResetResult(interp);
return TCL_OK;
@@ -5306,9 +5376,12 @@ ip_free(ptr)
return;
}
- ip_finalize(ptr->ip);
- Tcl_DeleteInterp(ptr->ip);
- Tcl_Release(ptr->ip);
+ if (!Tcl_InterpDeleted(ptr->ip)) {
+ ip_finalize(ptr->ip);
+
+ Tcl_DeleteInterp(ptr->ip);
+ Tcl_Release(ptr->ip);
+ }
ptr->ip = (Tcl_Interp*)NULL;
free(ptr);
@@ -5339,11 +5412,11 @@ ip_replace_wait_commands(interp, mainWin)
#if TCL_MAJOR_VERSION >= 8
DUMP1("Tcl_CreateObjCommand(\"vwait\")");
Tcl_CreateObjCommand(interp, "vwait", ip_rbVwaitObjCmd,
- (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
+ (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
#else /* TCL_MAJOR_VERSION < 8 */
DUMP1("Tcl_CreateCommand(\"vwait\")");
Tcl_CreateCommand(interp, "vwait", ip_rbVwaitCommand,
- (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
+ (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
#endif
/* replace 'tkwait' command */
@@ -5361,11 +5434,11 @@ ip_replace_wait_commands(interp, mainWin)
#if TCL_MAJOR_VERSION >= 8
DUMP1("Tcl_CreateObjCommand(\"thread_vwait\")");
Tcl_CreateObjCommand(interp, "thread_vwait", ip_rb_threadVwaitObjCmd,
- (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
+ (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
#else /* TCL_MAJOR_VERSION < 8 */
DUMP1("Tcl_CreateCommand(\"thread_vwait\")");
Tcl_CreateCommand(interp, "thread_vwait", ip_rb_threadVwaitCommand,
- (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
+ (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
#endif
/* add 'thread_tkwait' command */
@@ -5403,6 +5476,72 @@ ip_replace_wait_commands(interp, mainWin)
}
+#if TCL_MAJOR_VERSION >= 8
+static int
+ip_rb_replaceSlaveTkCmdsObjCmd(clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+#else /* TCL_MAJOR_VERSION < 8 */
+static int
+ip_rb_replaceSlaveTkCmdsCommand(clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ char *objv[];
+#endif
+{
+ char *slave_name;
+ Tcl_Interp *slave;
+ Tk_Window mainWin;
+
+ if (objc != 2) {
+#ifdef Tcl_WrongNumArgs
+ Tcl_WrongNumArgs(interp, 1, objv, "slave_name");
+#else
+ char *nameString;
+#if TCL_MAJOR_VERSION >= 8
+ nameString = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+#else /* TCL_MAJOR_VERSION < 8 */
+ nameString = objv[0];
+#endif
+ Tcl_AppendResult(interp, "wrong number of arguments: should be \"",
+ nameString, " slave_name\"", (char *) NULL);
+#endif
+ }
+
+#if TCL_MAJOR_VERSION >= 8
+ slave_name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+#else
+ slave_name = objv[1];
+#endif
+
+ slave = Tcl_GetSlave(interp, slave_name);
+ if (slave == NULL) {
+ Tcl_AppendResult(interp, "cannot find slave \"",
+ slave_name, "\"", (char *)NULL);
+ return TCL_ERROR;
+ }
+ mainWin = Tk_MainWindow(slave);
+
+ /* replace 'exit' command --> 'interp_exit' command */
+#if TCL_MAJOR_VERSION >= 8
+ DUMP1("Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
+ 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,
+ (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
+#endif
+
+ /* replace vwait and tkwait */
+ ip_replace_wait_commands(slave, mainWin);
+
+ return TCL_OK;
+}
+
#if TCL_MAJOR_VERSION >= 8
static int ip_rbNamespaceObjCmd _((ClientData, Tcl_Interp *, int,
@@ -5497,9 +5636,13 @@ ip_wrap_namespace_command(interp)
/* call when interpreter is deleted */
static void
+#ifdef HAVE_PROTOTYPES
+ip_CallWhenDeleted(ClientData clientData, Tcl_Interp *ip)
+#else
ip_CallWhenDeleted(clientData, ip)
ClientData clientData;
Tcl_Interp *ip;
+#endif
{
int thr_crit_bup;
/* Tk_Window main_win = (Tk_Window) clientData; */
@@ -5712,6 +5855,17 @@ ip_init(argc, argv, self)
/* wrap namespace command */
ip_wrap_namespace_command(ptr->ip);
+ /* 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,
+ (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
+#else /* TCL_MAJOR_VERSION < 8 */
+ Tcl_CreateCommand(ptr->ip, "__replace_slave_tk_commands__",
+ ip_rb_replaceSlaveTkCmdsCommand,
+ (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
+#endif
+
/* set finalizer */
Tcl_CallWhenDeleted(ptr->ip, ip_CallWhenDeleted, (ClientData)mainWin);
@@ -5815,6 +5969,17 @@ ip_create_slave_core(interp, argc, argv)
/* wrap namespace command */
ip_wrap_namespace_command(slave->ip);
+ /* 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,
+ (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
+#else /* TCL_MAJOR_VERSION < 8 */
+ Tcl_CreateCommand(slave->ip, "__replace_slave_tk_commands__",
+ ip_rb_replaceSlaveTkCmdsCommand,
+ (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
+#endif
+
/* set finalizer */
Tcl_CallWhenDeleted(slave->ip, ip_CallWhenDeleted, (ClientData)mainWin);
@@ -6109,7 +6274,8 @@ ip_delete(self)
int thr_crit_bup;
struct tcltkip *ptr = get_ip(self);
- if (ptr == (struct tcltkip *)NULL || ptr->ip == (Tcl_Interp*)NULL) {
+ /* if (ptr == (struct tcltkip *)NULL || ptr->ip == (Tcl_Interp*)NULL) { */
+ if (deleted_ip(ptr)) {
DUMP1("delete deleted IP");
return Qnil;
}
@@ -6117,12 +6283,14 @@ ip_delete(self)
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
- DUMP1("call ip_finalize");
- ip_finalize(ptr->ip);
-
DUMP1("delete interp");
- Tcl_DeleteInterp(ptr->ip);
- Tcl_Release(ptr->ip);
+ if (!Tcl_InterpDeleted(ptr->ip)) {
+ DUMP1("call ip_finalize");
+ ip_finalize(ptr->ip);
+
+ Tcl_DeleteInterp(ptr->ip);
+ Tcl_Release(ptr->ip);
+ }
rb_thread_critical = thr_crit_bup;
@@ -6541,7 +6709,7 @@ tk_funcall(func, argc, argv, obj)
rb_thread_critical = thr_crit_bup;
/* wait for the handler to be processed */
- t.tv_sec = (time_t)0;
+ t.tv_sec = 0;
t.tv_usec = (long)((EVENT_HANDLER_TIMEOUT)*1000.0);
DUMP2("callq wait for handler (current thread:%lx)", current);
@@ -6617,8 +6785,12 @@ struct call_eval_info {
};
static VALUE
+#ifdef HAVE_PROTOTYPES
+call_tcl_eval(VALUE arg)
+#else
call_tcl_eval(arg)
VALUE arg;
+#endif
{
struct call_eval_info *inf = (struct call_eval_info *)arg;
@@ -7030,7 +7202,7 @@ ip_eval(self, str)
rb_thread_critical = thr_crit_bup;
/* wait for the handler to be processed */
- t.tv_sec = (time_t)0;
+ t.tv_sec = 0;
t.tv_usec = (long)((EVENT_HANDLER_TIMEOUT)*1000.0);
DUMP2("evq wait for handler (current thread:%lx)", current);
@@ -7792,8 +7964,12 @@ struct invoke_info {
};
static VALUE
+#ifdef HAVE_PROTOTYPES
+invoke_tcl_proc(VALUE arg)
+#else
invoke_tcl_proc(arg)
VALUE arg;
+#endif
{
struct invoke_info *inf = (struct invoke_info *)arg;
int i, len;
@@ -8510,7 +8686,7 @@ ip_invoke_with_position(argc, argv, obj, position)
rb_thread_critical = thr_crit_bup;
/* wait for the handler to be processed */
- t.tv_sec = (time_t)0;
+ t.tv_sec = 0;
t.tv_usec = (long)((EVENT_HANDLER_TIMEOUT)*1000.0);
DUMP2("ivq wait for handler (current thread:%lx)", current);