1berry/ruby
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

* ext/tk/lib/tcltklib.c: fix trouble on old-style C function

Browse Source 
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
This commit is contained in:
nagai 2009-08-03 19:01:03 +00:00
parent 6b63928374
commit 4293a98596
9 changed files with 307 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
ChangeLog
View File

@ -1,3 +1,17 @@
Tue Aug 4 03:56:51 2009 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp>
* 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,virtevent.rb,image.rb,timer.rb}:
don't create unnecessary array.
Mon Aug 3 22:19:24 2009 Yusuke Endoh <mame@tsg.ne.jp>
* eval.c (rb_mod_include): fix document. [ruby-core:24675]

65
ext/tk/lib/multi-tk.rb
View File

@ -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])

2
ext/tk/lib/tk.rb
View File

@ -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'

2
ext/tk/lib/tk/canvas.rb
View File

@ -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))

20
ext/tk/lib/tk/fontchooser.rb
View File

@ -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),

2
ext/tk/lib/tk/image.rb
View File

@ -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]))

2
ext/tk/lib/tk/timer.rb
View File

@ -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)

2
ext/tk/lib/tk/virtevent.rb
View File

@ -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)

264
ext/tk/tcltklib.c
View File

@ -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);