1
0
Fork 0
mirror of https://github.com/ruby/ruby.git synced 2022-11-09 12:17:21 -05:00

* ext/tcltklib/tcltklib.c: enforce thread-check and exception-handling to

avoid SEGV trouble.
  [KNOWN BUG] When supports pthread and running multiple Tk interpreters,
  an interrupt signal causes SEGV frequently. That may be a trouble of
  Ruby's signal handler.
* ext/tk/tkutil/tkutil.c; fix a bug on converting a SJIS string array
  to a Tcl's list string.
* ext/tk/tcltklib.c: wrap Tcl's original "namespace" command to
  protect from namespace crash.
* ext/tk/lib/multi-tk.rb: enforce exception-handling.
* ext/tk/lib/multi-tk.rb: catch IRB_EXIT to work on irb.
* ext/tk/lib/tk.rb: ditto.
* ext/tk/tcltklib.c: add TclTkLib.mainloop_thread?
* ext/tk/lib/multi-tk.rb: (bug fix) callback returns a value.
* ext/tk/lib/tk/canvas.rb (delete): bug fix when multiple arguments.
* ext/tk/lib/clock.rb: fix 'no method error'.
* ext/tk/lib/clock.rb (self.clicks): accept a Symbol argument.
* ext/tk/lib/variable.rb: be able to set default_value_type; :numeric,
  :bool, :string, :symbol, :list, :numlist or nil (default; same to
  :string). If set a type, TkVariable#value returns a value of the type.
* ext/tk/lib/tkextlib/tclx/tclx.rb: add Tk::TclX.signal to warn the
  risk of using TclX extension's 'signal' command.
* ext/tk/sample/irbtk.rb: irb with Ruby/Tk.
* ext/tk/sample/demos-*/anilabel.rb: bug fix on 'show code'
* ext/tk/sample/demos-*/aniwave.rb: new Ruby/Tk animation demo.
* ext/tk/sample/demos-*/pendulum.rb: ditto.
* ext/tk/sample/demos-*/goldberg.rb: ditto.
* ext/tk/sample/demos-*/widget: add entries of animation demos.


git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/branches/ruby_1_8@8048 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
This commit is contained in:
nagai 2005-03-02 07:08:18 +00:00
parent 1c59b283a5
commit d7d2f8bfe2
17 changed files with 3022 additions and 682 deletions

View file

@ -1,3 +1,53 @@
Wed Mar 2 16:00:02 2005 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp>
* ext/tcltklib/tcltklib.c: enforce thread-check and exception-handling
to avoid SEGV trouble.
[KNOWN BUG] When supports pthread and running multiple Tk
interpreters, an interrupt signal causes SEGV frequently. That
may be a trouble of Ruby's signal handler.
* ext/tk/tkutil/tkutil.c; fix a bug on converting a SJIS string array
to a Tcl's list string.
* ext/tk/tcltklib.c: wrap Tcl's original "namespace" command to
protect from namespace crash.
* ext/tk/lib/multi-tk.rb: enforce exception-handling.
* ext/tk/lib/multi-tk.rb: catch IRB_EXIT to work on irb.
* ext/tk/lib/tk.rb: ditto.
* ext/tk/tcltklib.c: add TclTkLib.mainloop_thread?
* ext/tk/lib/multi-tk.rb: (bug fix) callback returns a value.
* ext/tk/lib/tk/canvas.rb (delete): bug fix when multiple arguments.
* ext/tk/lib/clock.rb: fix 'no method error'.
* ext/tk/lib/clock.rb (self.clicks): accept a Symbol argument.
* ext/tk/lib/variable.rb: be able to set default_value_type; :numeric,
:bool, :string, :symbol, :list, :numlist or nil (default; same to
:string). If set a type, TkVariable#value returns a value of the
type.
* ext/tk/lib/tkextlib/tclx/tclx.rb: add Tk::TclX.signal to warn the
risk of using TclX extension's 'signal' command.
* ext/tk/sample/irbtk.rb: irb with Ruby/Tk.
* ext/tk/sample/demos-*/anilabel.rb: bug fix on 'show code'
* ext/tk/sample/demos-*/aniwave.rb: new Ruby/Tk animation demo.
* ext/tk/sample/demos-*/pendulum.rb: ditto.
* ext/tk/sample/demos-*/goldberg.rb: ditto.
* ext/tk/sample/demos-*/widget: add entries of animation demos.
Tue Mar 1 00:47:43 2005 Masatoshi SEKI <m_seki@mva.biglobe.ne.jp>
* test/rinda/test_rinda.rb: backport from CVS_HEAD. use

View file

@ -132,6 +132,16 @@ module TclTklib
: If 'check_root' is false, doen't return by the other
: reasons than exceptions.
mainloop_thread?
: Returns whether the current thread executes the eventloop.
: If true, the eventloop is working on the current thread.
: If no eventloop is working, this method returns nil.
: And if the other thread executes the eventloop, returns false.
:
: *** ATTENTION ***
: When this methods returns false, it is dangerous to call a Tk
: interpreter directly.
mainloop_watchdog(check_root = true)
: On the normal eventloop, some kinds of callback operations
: cause deadlock. To avoid some of such deadlocks, this

View file

@ -230,6 +230,15 @@ require "tcltklib"
: WINDOW 以外のイベントは発生しうるため ).終了には,外部
: からの働き掛け ( スレッドを活用するなど ) が必要.
mainloop_thread?
: カレントスレッドがイベントループを実行しているスレッド
: かどうかを返す.
: イベントループを実行しているスレッドであれば true を,
: どのスレッドでもイベントループが実行されていない場合は
: nil を,他のスレッドでイベントループが実行されている場
: 合は false を返す.
: false の際に Tk インタープリタを直接呼ぶのは危険である.
mainloop_watchdog(check_root = true)
: 通常のイベントループでは,イベント処理の内容によっては
: デッドロックを引き起こす可能性がある (例えばイベントに
@ -377,7 +386,7 @@ require "tcltklib"
: 失敗した場合は RuntimeError の例外を発生する.
safe?
: Tcl/Tk インタープリタ safe インタープリタであるかを調べる.
: Tcl/Tk インタープリタ safe インタープリタであるかを調べる.
: safe インタープリタであれば true を返す.
allow_ruby_exit?

File diff suppressed because it is too large Load diff

View file

@ -1,3 +1,7 @@
2005-02-20 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp>
* ext/tk/lib/tclx/tclx.rb: warning TclX's 'signal' command.
2005-01-25 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp>
* ext/tk/lib/tkextlib/blt/component.rb: bug fix. cannot accept

View file

@ -77,17 +77,22 @@ class MultiTkIp
cmd.inspect
end
def call(*args)
begin
unless @ip.deleted?
@ip.cb_eval(@cmd, *args)
end
rescue TkCallbackBreak, TkCallbackContinue => e
fail e
rescue Exception => e
if @ip.safe?
# ignore
else
unless @ip.deleted?
current = Thread.current
backup_ip = current['callback_ip']
current['callback_ip'] = @ip
begin
@ip.cb_eval(@cmd, *args)
rescue TkCallbackBreak, TkCallbackContinue => e
fail e
rescue Exception => e
if @ip.safe?
nil # ignore
else
fail e
end
ensure
current['callback_ip'] = backup_ip
end
end
end
@ -105,19 +110,23 @@ class MultiTkIp
def _check_and_return(thread, exception, wait=0)
unless thread
unless exception.kind_of?(MultiTkIp_OK) || safe?
unless exception.kind_of?(MultiTkIp_OK)
msg = "#{exception.class}: #{exception.message}"
if @interp.deleted?
warn("Warning (#{self}): " + msg)
return nil
end
if safe?
warn("Warning (#{self}): " + msg) if $DEBUG
return nil
end
begin
if @interp.deleted?
warn('Warning: ' + msg)
elsif @interp._eval_without_enc('info command bgerror').size != 0
@interp._eval(@interp._merge_tklist('bgerror', msg))
else
warn('Warning: ' + msg)
end
@interp._eval_without_enc(@interp._merge_tklist('bgerror', msg))
rescue Exception => e
warn('Warning: ' + msg)
warn('Warning: ' + e.message)
warn("Warning (#{self}): " + msg)
end
end
return nil
@ -230,8 +239,18 @@ class MultiTkIp
def _receiver_eval_proc_core(safe_level, thread, cmd, *args)
begin
#ret = proc{$SAFE = safe_level; cmd.call(*args)}.call
ret = cmd.call(safe_level, *args)
#ret = cmd.call(safe_level, *args)
normal_ret = false
ret = catch(:IRB_EXIT) do # IRB hack
retval = cmd.call(safe_level, *args)
normal_ret = true
retval
end
unless normal_ret
# catch IRB_EXIT
exit(ret)
end
ret
rescue SystemExit => e
# delete IP
unless @interp.deleted?
@ -297,7 +316,8 @@ class MultiTkIp
_check_and_return(thread, MultiTkIp_OK.new(nil))
end
if master? && !safe? && allow_ruby_exit?
# if master? && !safe? && allow_ruby_exit?
if !@interp.deleted? && master? && !safe? && allow_ruby_exit?
=begin
ObjectSpace.each_object(TclTkIp){|obj|
obj.delete unless obj.deleted?
@ -380,6 +400,16 @@ class MultiTkIp
rescue Exception => e
# raise exception
begin
bt = _toUTF8(e.backtrace.join("\n"))
bt.instance_variable_set(:@encoding, 'utf-8')
rescue Exception
bt = e.backtrace.join("\n")
end
begin
@interp._set_global_var('errorInfo', bt)
rescue Exception
end
_check_and_return(thread, e)
else
@ -411,7 +441,8 @@ class MultiTkIp
def _receiver_mainloop(check_root)
Thread.new{
while !@interp.deleted?
break if @interp._invoke_without_enc('info', 'command', '.').size == 0
inf = @interp._invoke_without_enc('info', 'command', '.')
break if !inf.kind_of?(String) || inf != '.'
sleep 0.5
end
}
@ -742,8 +773,8 @@ class MultiTkIp
# create toplevel widget
begin
top = TkToplevel.new(toplevel_keys)
rescue NameError
fail unless @interp.safe?
rescue NameError => e
fail e unless @interp.safe?
fail SecurityError, "unable create toplevel on the safe interpreter"
end
msg = "Untrusted Ruby/Tk applet (#{slave_name})"
@ -870,7 +901,11 @@ class MultiTkIp
fail SecurityError, "cannot create a master-ip at level #{$SAFE}"
end
if !master.master? && master.safe?
if master.deleted? && safeip == nil
fail RuntimeError, "cannot create a slave of a deleted interpreter"
end
if !master.deleted? && !master.master? && master.safe?
fail SecurityError, "safe-slave-ip cannot create a new interpreter"
end
@ -964,15 +999,20 @@ class MultiTkIp
undef :instance_eval
end
# dummy call for initialization
self.eval_proc{ Tk.tk_call('set', 'tcl_patchLevel') }
self.freeze # defend against modification
end
######################################
def _default_delete_hook(slave)
if @slave_ip_top[slave].kind_of?(String)
@slave_ip_tbl.delete(slave)
top = @slave_ip_top.delete(slave)
if top.kind_of?(String)
# call default hook of safetk.tcl (ignore exceptions)
if @slave_ip_top[slave] == ''
if top == ''
begin
@interp._eval("::safe::disallowTk #{slave}")
rescue
@ -980,20 +1020,19 @@ class MultiTkIp
end
else # toplevel path
begin
@interp._eval("::safe::tkDelete {} #{@slave_ip_top[slave]} #{slave}")
@interp._eval("::safe::tkDelete {} #{top} #{slave}")
rescue
warn("Waring: fail to call '::safe::tkDelete'") if $DEBUG
begin
@interp._eval("destroy #{@slave_ip_top[slave]}")
@interp._eval("destroy #{top}")
rescue
warn("Waring: fail to destroy toplevel") if $DEBUG
end
end
end
end
@slave_ip_tbl.delete(slave)
@slave_ip_top.delete(slave)
end
end
@ -1007,10 +1046,14 @@ class MultiTkIp
end
def self.__getip
if Thread.current.group == ThreadGroup::Default
current = Thread.current
if TclTkLib.mainloop_thread? != false && current['callback_ip']
return current['callback_ip']
end
if current.group == ThreadGroup::Default
@@DEFAULT_MASTER
else
ip = @@IP_TABLE[Thread.current.group]
ip = @@IP_TABLE[current.group]
unless ip
fail SecurityError,
"cannot call Tk methods on #{Thread.current.inspect}"
@ -1093,9 +1136,15 @@ class MultiTkIp
def inspect
s = self.to_s.chop!
if master?
s << ':master'
if @interp.deleted?
s << ':deleted-master'
else
s << ':master'
end
else
if @interp.safe?
if @interp.deleted?
s << ':deleted-slave'
elsif @interp.safe?
s << ':safe-slave'
else
s << ':trusted-slave'
@ -1281,11 +1330,13 @@ class MultiTkIp
#self.eval_callback{ TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *args)) }
#ret = self.eval_callback{ TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *args)) }
ret = self.eval_callback(*args){|safe, *params|
$SAFE=safe; TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *params))
$SAFE=safe
TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *params))
}
if ret.kind_of?(Exception)
raise ret
raise ret
end
ret
end
end
@ -1300,10 +1351,11 @@ class MultiTkIp
end
# on IP thread
if (@cmd_receiver == Thread.current)
if @cmd_receiver == Thread.current ||
(!req_val && TclTkLib.mainloop_thread? != false) # callback
begin
ret = cmd.call(*args)
rescue SystemExit
rescue SystemExit => e
# exit IP
warn("Warning: "+ $! + " on " + self.inspect) if $DEBUG
begin
@ -1318,6 +1370,18 @@ class MultiTkIp
((e.message.length > 0)? ' "' + e.message + '"': '') +
" on " + self.inspect)
end
=begin
begin
bt = _toUTF8(e.backtrace.join("\n"))
bt.instance_variable_set(:@encoding, 'utf-8')
rescue Exception
bt = e.backtrace.join("\n")
end
begin
@interp._set_global_var('errorInfo', bt)
rescue Exception
end
=end
ret = e
end
return ret
@ -1353,7 +1417,7 @@ class MultiTkIp
self._eval_without_enc('exit')
rescue Exception
end
if !safe? && allow_ruby_exit?
if !self.deleted? && !safe? && allow_ruby_exit?
self.delete
fail e
else
@ -1380,11 +1444,34 @@ class MultiTkIp
end
end
=end
=begin
def eval_callback(*args)
if block_given?
eval_proc_core(false, Proc.new, *args)
# eval_proc_core(Thread.current, Proc.new, *args)
else
cmd = args.shift
eval_proc_core(false, *args)
# eval_proc_core(Thread.current, *args)
end
end
=end
def eval_callback(*args)
if block_given?
cmd = Proc.new
else
cmd = args.shift
end
if TclTkLib.mainloop_thread? != false
args.unshift(safe_level)
end
current = Thread.current
backup_ip = current['callback_ip']
current['callback_ip'] = self
begin
eval_proc_core(false, cmd, *args)
ensure
current['callback_ip'] = backup_ip
end
end
@ -1399,7 +1486,7 @@ class MultiTkIp
=end
def eval_proc(*args)
# The scope of the eval-block of 'eval_proc' method is different from
# the enternal. If you want to pass local values to the eval-block,
# the external. If you want to pass local values to the eval-block,
# use arguments of eval_proc method. They are passed to block-arguments.
if block_given?
cmd = Proc.new
@ -1408,11 +1495,24 @@ class MultiTkIp
fail ArgumentError, "A Proc or Method object is expected for 1st argument"
end
end
eval_proc_core(true,
proc{|safe, *params|
$SAFE=safe; Thread.new(*params, &cmd).value
},
*args)
if TclTkLib.mainloop_thread? == true
# call from eventloop
current = Thread.current
backup_ip = current['callback_ip']
current['callback_ip'] = self
begin
eval_proc_core(false, cmd, safe_level, *args)
ensure
current['callback_ip'] = backup_ip
end
else
eval_proc_core(true,
proc{|safe, *params|
$SAFE=safe
Thread.new(*params, &cmd).value
},
*args)
end
end
alias call eval_proc
@ -1739,7 +1839,7 @@ end
# depend on TclTkIp
class MultiTkIp
def mainloop(check_root = true, restart_on_dead = false)
def mainloop(check_root = true, restart_on_dead = true)
#return self if self.slave?
#return self if self != @@DEFAULT_MASTER
if self != @@DEFAULT_MASTER
@ -1752,7 +1852,11 @@ class MultiTkIp
rescue MultiTkIp_OK => ret
# return value
@wait_on_mainloop[1] = false
return ret.value.value
if ret.value.kind_of?(Thread)
return ret.value.value
else
return ret.value
end
rescue SystemExit
# exit IP
warn("Warning: " + $! + " on " + self.inspect) if $DEBUG
@ -1762,7 +1866,7 @@ class MultiTkIp
rescue Exception
end
self.delete
rescue Exception => e
rescue StandardError => e
if $DEBUG
warn("Warning: " + e.class.inspect +
((e.message.length > 0)? ' "' + e.message + '"': '') +
@ -1779,31 +1883,59 @@ class MultiTkIp
unless restart_on_dead
@wait_on_mainloop[1] = true
=begin
begin
@interp.mainloop(check_root)
rescue StandardError => e
if $DEBUG
warn("Warning: " + e.class.inspect +
((e.message.length > 0)? ' "' + e.message + '"': '') +
" on " + self.inspect)
end
end
=end
@interp.mainloop(check_root)
@wait_on_mainloop[1] = false
else
begin
loop do
@wait_on_mainloop[1] = true
loop do
break unless self.alive?
if check_root
begin
break if TclTkLib.num_of_mainwindows == 0
rescue Exception
break
break unless self.alive?
if check_root
begin
break if TclTkLib.num_of_mainwindows == 0
rescue StandardError
break
end
end
break if @interp.deleted?
begin
@interp.mainloop(check_root)
rescue StandardError => e
if TclTkLib.mainloop_abort_on_exception != nil
#STDERR.print("Warning: Tk mainloop receives ", $!.class.inspect,
# " exception (ignore) : ", $!.message, "\n");
if $DEBUG
warn("Warning: Tk mainloop receives " << e.class.inspect <<
" exception (ignore) : " << e.message);
end
end
@interp.mainloop(check_root)
#raise e
rescue Exception => e
=begin
if TclTkLib.mainloop_abort_on_exception != nil
#STDERR.print("Warning: Tk mainloop receives ", $!.class.inspect,
# " exception (ignore) : ", $!.message, "\n");
if $DEBUG
warn("Warning: Tk mainloop receives " << e.class.inspect <<
" exception (ignore) : " << e.message);
end
end
=end
raise e
ensure
@wait_on_mainloop[1] = false
Thread.pass # avoid eventloop conflict
end
#rescue StandardError
rescue Exception
if TclTkLib.mainloop_abort_on_exception != nil
STDERR.print("Warning: Tk mainloop receives ", $!.class.inspect,
" exception (ignore) : ", $!.message, "\n");
end
retry
ensure
@wait_on_mainloop[1] = false
end
end
self
@ -1875,18 +2007,17 @@ class MultiTkIp
@interp._eval_without_enc("foreach i {#{after_ids}} {after cancel $i}")
rescue Exception
end
=begin
begin
@interp._invoke('destroy', '.') unless @interp.deleted?
rescue Exception
end
=end
if @safe_base && !@interp.deleted?
# do 'exit' to call the delete_hook procedure
@interp._eval_without_enc('exit')
else
@interp.delete unless @interp.deleted?
end
@interp.delete
self
end

View file

@ -565,6 +565,15 @@ end
module_function :bool, :number, :num_or_str, :string
module_function :list, :simplelist, :window, :image_obj, :procedure
def subst(str, *opts)
# opts := :nobackslashes | :nocommands | novariables
tk_call('subst',
*(opts.collect{|opt|
opt = opt.to_s
(opt[0] == ?-)? opt: '-' << opt
} << str))
end
def _toUTF8(str, encoding = nil)
TkCore::INTERP._toUTF8(str, encoding)
end
@ -1110,13 +1119,14 @@ module TkCore
INTERP._invoke_without_enc('bind', 'all', "<#{WIDGET_DESTROY_HOOK}>",
install_cmd(proc{|path|
unless TkCore::INTERP.deleted?
if (widget = TkCore::INTERP.tk_windows[path])
if widget.respond_to?(:__destroy_hook__)
begin
begin
if (widget=TkCore::INTERP.tk_windows[path])
if widget.respond_to?(:__destroy_hook__)
widget.__destroy_hook__
rescue Exception
end
end
rescue Exception=>e
p e if $DEBUG
end
end
}) << ' %W')
@ -1175,11 +1185,24 @@ module TkCore
def TkCore.callback(*arg)
begin
TkCore::INTERP.tk_cmd_tbl[arg.shift].call(*arg)
rescue SystemExit
exit(0)
rescue Interrupt
exit!(1)
if TkCore::INTERP.tk_cmd_tbl.kind_of?(Hash)
#TkCore::INTERP.tk_cmd_tbl[arg.shift].call(*arg)
normal_ret = false
ret = catch(:IRB_EXIT) do # IRB hack
retval = TkCore::INTERP.tk_cmd_tbl[arg.shift].call(*arg)
normal_ret = true
retval
end
unless normal_ret
# catch IRB_EXIT
exit(ret)
end
ret
end
rescue SystemExit=>e
exit(e.status)
rescue Interrupt=>e
fail(e)
rescue Exception => e
begin
msg = _toUTF8(e.class.inspect) + ': ' +
@ -1194,6 +1217,8 @@ module TkCore
e.backtrace.join("\n") +
"\n---< backtrace of Tk side >-------"
end
# TkCore::INTERP._set_global_var('errorInfo', msg)
# fail(e)
fail(e, msg)
end
end
@ -1383,6 +1408,22 @@ module TkCore
TclTkLib.mainloop(check_root)
end
def mainloop_thread?
# true : current thread is mainloop
# nil : there is no mainloop
# false : mainloop is running on the other thread
# ( At then, it is dangerous to call Tk interpreter directly. )
TclTkLib.mainloop_thread?
end
def mainloop_exist?
TclTkLib.mainloop_thread? != nil
end
def is_mainloop?
TclTkLib.mainloop_thread? == true
end
def mainloop_watchdog(check_root = true)
# watchdog restarts mainloop when mainloop is dead
TclTkLib.mainloop_watchdog(check_root)
@ -1738,13 +1779,34 @@ module Tk
end
def Tk.pack(*args)
#TkPack.configure(*args)
TkPack(*args)
TkPack.configure(*args)
end
def Tk.pack_forget(*args)
TkPack.forget(*args)
end
def Tk.unpack(*args)
TkPack.forget(*args)
end
def Tk.grid(*args)
TkGrid.configure(*args)
end
def Tk.grid_forget(*args)
TkGrid.forget(*args)
end
def Tk.ungrid(*args)
TkGrid.forget(*args)
end
def Tk.place(*args)
TkPlace.configure(*args)
end
def Tk.place_forget(*args)
TkPlace.forget(*args)
end
def Tk.unplace(*args)
TkPlace.forget(*args)
end
def Tk.update(idle=nil)
if idle
@ -3541,7 +3603,7 @@ class TkWindow<TkObject
self
end
def grid_forget
def grid_forget
#tk_call('grid', 'forget', epath)
TkGrid.forget(self)
self
@ -3940,7 +4002,7 @@ end
#Tk.freeze
module Tk
RELEASE_DATE = '2005-01-28'.freeze
RELEASE_DATE = '2005-03-02'.freeze
autoload :AUTO_PATH, 'tk/variable'
autoload :TCL_PACKAGE_PATH, 'tk/variable'
@ -3950,7 +4012,6 @@ module Tk
autoload :TCL_PRECISION, 'tk/variable'
end
# call setup script for Tk extension libraries (base configuration)
begin
require 'tkextlib/setup.rb'

View file

@ -159,8 +159,10 @@ class TkCanvas<TkWindow
def delete(*args)
if TkcItem::CItemID_TBL[self.path]
find('withtag', *args).each{|item|
TkcItem::CItemID_TBL[self.path].delete(item.id)
args.each{|tag|
find('withtag', tag).each{|item|
TkcItem::CItemID_TBL[self.path].delete(item.id)
}
}
end
tk_send_without_enc('delete', *args.collect{|t| tagid(t)})

View file

@ -5,13 +5,17 @@ require 'tk'
module Tk
module Clock
include Tk
extend TkCore
def self.add(clk, *args)
tk_call_without_enc('clock','add', clk, *args).to_i
end
def self.clicks(ms=nil)
ms = ms.to_s if ms.kind_of?(Symbol)
case ms
when nil
when nil, ''
tk_call_without_enc('clock','clicks').to_i
when /^mic/
tk_call_without_enc('clock','clicks','-microseconds').to_i

View file

@ -420,6 +420,7 @@ class TkTimer
@wait_var.value = 0
tk_call 'after', 'cancel', @after_id if @after_id
@after_id = nil
Tk_CBTBL.delete(@id) ;# for GC
self
end

View file

@ -126,7 +126,81 @@ TkCore::INTERP.add_tk_procs('rb_var', 'args', <<-'EOL')
self
end
def initialize(val="")
def default_value_type
@type
end
def default_value_type=(type)
if type.kind_of?(Class)
if type == NilClass
@type = nil
elsif type == Numeric
@type = :numeric
elsif type == TrueClass || type == FalseClass
@type = :bool
elsif type == String
@type = :string
elsif type == Symbol
@type = :symbol
elsif type == Array
@type = :list
else
@type = nil
end
else
case(type)
when nil
@type = nil
when :numeric, 'numeric'
@type = :numeric
when true, false, :bool, 'bool'
@type = :bool
when :string, 'string'
@type = :string
when :symbol, 'symbol'
@type = :symbol
when :list, 'list'
@type = :list
when :numlist, 'numlist'
@type = :numlist
else
self.default_value_type = type.class
end
end
@type
end
def _to_default_type(val)
return val unless @type
if val.kind_of?(Hash)
val.keys.each{|k| val[k] = _to_default_type(val[k]) }
val
else
begin
case(@type)
when :numeric
number(val)
when :bool
TkComm
when :string
val
when :symbol
val.intern
when :list
tk_split_simplelist(val)
when :numlist
tk_split_simplelist(val).collect!{|v| number(v)}
else
val
end
rescue
val
end
end
end
private :_to_default_type
def initialize(val="", type=nil)
# @id = Tk_VARIABLE_ID.join('')
@id = Tk_VARIABLE_ID.join(TkCore::INTERP._ip_id_)
Tk_VARIABLE_ID[1].succ!
@ -139,6 +213,8 @@ TkCore::INTERP.add_tk_procs('rb_var', 'args', <<-'EOL')
@trace_elem = nil
@trace_opts = nil
self.default_value_type = type
begin
INTERP._unset_global_var(@id)
rescue
@ -242,13 +318,25 @@ TkCore::INTERP.add_tk_procs('rb_var', 'args', <<-'EOL')
def is_hash?
#ITNERP._eval("global #{@id}; array exist #{@id}") == '1'
INTERP._invoke_without_enc('global', @id)
INTERP._invoke_without_enc('array', 'exist', @id) == '1'
# INTERP._invoke_without_enc('array', 'exist', @id) == '1'
TkComm.bool(INTERP._invoke_without_enc('array', 'exist', @id))
end
def is_scalar?
! is_hash?
end
def exist?(idx = nil)
INTERP._invoke_without_enc('global', @id)
if idx
# array
TkComm.bool(tk_call('info', 'exist', "#{@id}")) &&
TkComm.bool(tk_call('info', 'exist', "#{@id}(#{idx})"))
else
TkComm.bool(tk_call('info', 'exist', @id))
end
end
def keys
if (is_scalar?)
fail RuntimeError, 'cannot get keys from a scalar variable'
@ -258,6 +346,11 @@ TkCore::INTERP.add_tk_procs('rb_var', 'args', <<-'EOL')
tk_split_simplelist(INTERP._fromUTF8(INTERP._invoke_without_enc('array', 'names', @id)))
end
def size
INTERP._invoke_without_enc('global', @id)
TkComm.number(INTERP._invoke_without_enc('array', 'size', @id))
end
def clear
if (is_scalar?)
fail RuntimeError, 'cannot clear a scalar variable'
@ -274,7 +367,6 @@ TkCore::INTERP.add_tk_procs('rb_var', 'args', <<-'EOL')
self
end
unless const_defined?(:USE_TCLs_SET_VARIABLE_FUNCTIONS)
USE_TCLs_SET_VARIABLE_FUNCTIONS = true
end
@ -284,10 +376,11 @@ if USE_TCLs_SET_VARIABLE_FUNCTIONS
# use Tcl function version of set tkvariable
###########################################################################
def value
def _value
#if INTERP._eval("global #{@id}; array exist #{@id}") == '1'
INTERP._invoke_without_enc('global', @id)
if INTERP._invoke('array', 'exist', @id) == '1'
# if INTERP._invoke('array', 'exist', @id) == '1'
if TkComm.bool(INTERP._invoke('array', 'exist', @id))
#Hash[*tk_split_simplelist(INTERP._eval("global #{@id}; array get #{@id}"))]
Hash[*tk_split_simplelist(INTERP._invoke('array', 'get', @id))]
else
@ -306,6 +399,7 @@ if USE_TCLs_SET_VARIABLE_FUNCTIONS
}
self.value
elsif val.kind_of?(Array)
=begin
INTERP._set_global_var(@id, '')
val.each{|v|
#INTERP._set_variable(@id, _toUTF8(_get_eval_string(v)),
@ -316,6 +410,8 @@ if USE_TCLs_SET_VARIABLE_FUNCTIONS
TclTkLib::VarAccessFlag::LIST_ELEMENT)
}
self.value
=end
_fromUTF8(INTERP._set_global_var(@id, array2tk_list(val)))
else
#_fromUTF8(INTERP._set_global_var(@id, _toUTF8(_get_eval_string(val))))
_fromUTF8(INTERP._set_global_var(@id, _get_eval_string(val, true)))
@ -325,7 +421,8 @@ if USE_TCLs_SET_VARIABLE_FUNCTIONS
def [](*idxs)
index = idxs.collect{|idx| _get_eval_string(idx, true)}.join(',')
begin
_fromUTF8(INTERP._get_global_var2(@id, index))
# _fromUTF8(INTERP._get_global_var2(@id, index))
_to_default_type(_fromUTF8(INTERP._get_global_var2(@id, index)))
rescue => e
case @def_default
when :proc
@ -365,7 +462,7 @@ else
# use Ruby script version of set tkvariable (traditional methods)
###########################################################################
def value
def _value
begin
INTERP._eval(Kernel.format('global %s; set %s', @id, @id))
#INTERP._eval(Kernel.format('set %s', @id))
@ -436,7 +533,8 @@ else
def [](*idxs)
index = idxs.collect{|idx| _get_eval_string(idx)}.join(',')
begin
INTERP._eval(Kernel.format('global %s; set %s(%s)', @id, @id, index))
# INTERP._eval(Kernel.format('global %s; set %s(%s)', @id, @id, index))
_to_default_type(INTERP._eval(Kernel.format('global %s; set %s(%s)', @id, @id, index)))
rescue => e
case @def_default
when :proc
@ -483,8 +581,19 @@ else
end
protected :_value
def value
_to_default_type(_value)
end
def value_type=(val)
self.default_value_type = val
self.value=(val)
end
def numeric
number(value)
number(_value)
end
def numeric=(val)
case val
@ -497,17 +606,20 @@ end
end
val
end
def numeric_type=(val)
@type = :numeric
self.numeric=(val)
end
def bool
# see Tcl_GetBoolean man-page
case value.downcase
case _value.downcase
when '0', 'false', 'no', 'off'
false
else
true
end
end
def bool=(val)
if ! val
self.value = '0'
@ -520,30 +632,48 @@ end
end
end
end
def bool_type=(val)
@type = :bool
self.bool=(val)
end
def to_i
number(value).to_i
number(_value).to_i
end
def to_f
number(value).to_f
number(_value).to_f
end
def to_s
#string(value).to_s
value
_value
end
alias string= value=
def string_type=(val)
@type = :string
self.value=(val)
end
def to_sym
value.intern
_value.intern
end
alias symbol= value=
def symbol_type=(val)
@type = :symbol
self.value=(val)
end
def list
#tk_split_list(value)
tk_split_simplelist(value)
tk_split_simplelist(_value)
end
alias to_a list
def numlist
list.collect!{|val| number(val)}
end
def list=(val)
case val
when Array
@ -555,6 +685,39 @@ end
end
val
end
alias numlist= list=
def list_type=(val)
@type = :list
self.list=(val)
end
def numlist_type=(val)
@type = :numlist
self.numlist=(val)
end
def lappend(*elems)
tk_call('lappend', @id, *elems)
self
end
def lindex(idx)
tk_call('lindex', self._value, idx)
end
alias lget lindex
def lget_i(idx)
number(lget(idx)).to_i
end
def lget_f(idx)
number(lget(idx)).to_f
end
def lset(idx, val)
tk_call('lset', @id, idx, val)
self
end
def inspect
#Kernel.format "#<TkVariable: %s>", @id
@ -564,7 +727,7 @@ end
def coerce(other)
case other
when TkVariable
[other.value, self.value]
[other._value, self._value]
when String
[other, self.to_s]
when Symbol
@ -576,7 +739,7 @@ end
when Array
[other, self.to_a]
else
[other, self.value]
[other, self._value]
end
end
@ -599,12 +762,12 @@ end
when Array
self.to_a + other
when String
self.value + other
self._value + other
else
begin
number(self.value) + other
number(self._value) + other
rescue
self.value + other.to_s
self._value + other.to_s
end
end
end
@ -612,37 +775,40 @@ end
if other.kind_of?(Array)
self.to_a - other
else
number(self.value) - other
number(self._value) - other
end
end
def *(other)
begin
number(self.value) * other
rescue
self.value * other
end
num_or_str(self._value) * other.to_i
#begin
# number(self._value) * other
#rescue
# self._value * other
#end
end
def /(other)
number(self.value) / other
number(self._value) / other
end
def %(other)
begin
number(self.value) % other
rescue
self.value % other
end
num_or_str(self._value) % other.to_i
#begin
# number(self._value) % other
#rescue
# self._value % other
#end
end
def **(other)
number(self.value) ** other
number(self._value) ** other
end
def =~(other)
self.value =~ other
self._value =~ other
end
def ==(other)
case other
when TkVariable
self.equal?(other)
#self.equal?(other)
self._value == other._value
when String
self.to_s == other
when Symbol
@ -654,7 +820,8 @@ end
when Array
self.to_a == other
when Hash
self.value == other
# false if self is not an assoc array
self._value == other
else
false
end
@ -673,17 +840,17 @@ end
val = other.numeric
other = val
rescue
other = other.value
other = other._value
end
end
if other.kind_of?(Numeric)
begin
return self.numeric <=> other
rescue
return self.value <=> other.to_s
return self._value <=> other.to_s
end
else
return self.value <=> other
return self._value <=> other
end
end

View file

@ -27,6 +27,16 @@ module Tk
Tk.tk_call('infox', *args)
end
def self.signal(*args)
warn("Warning: Don't recommend to use TclX's 'signal' command. Please use Ruby's 'Signal.trap' method")
Tk.tk_call('signal', *args)
end
def self.signal_restart(*args)
warn("Warning: Don't recommend to use TclX's 'signal' command. Please use Ruby's 'Signal.trap' method")
Tk.tk_call('signal', '-restart', *args)
end
##############################
class XPG3_MsgCat

View file

@ -37,7 +37,7 @@ TkFrame.new($anilabel_demo) {|frame|
TkButton.new(frame) {
text 'See Code'
command proc{showCode 'label'}
command proc{showCode 'anilabel'}
}.pack('side'=>'left', 'expand'=>'yes')
}.pack('side'=>'bottom', 'fill'=>'x', 'pady'=>'2m')

View file

@ -392,6 +392,12 @@ txt.insert('end', "\n")
txt.insert('end', "Animation\n", tag_title)
txt.insert('end', " \n ", tag_demospace)
txt.insert('end', "1. Animated labels (if supported)\n", tag_demo, "demo-anilabel")
txt.insert('end', " \n ", tag_demospace)
txt.insert('end', "2. Animated wave (if supported)\n", tag_demo, "demo-aniwave")
txt.insert('end', " \n ", tag_demospace)
txt.insert('end', "3. Pendulum simulation (if supported)\n", tag_demo, "demo-pendulum")
txt.insert('end', " \n ", tag_demospace)
txt.insert('end', "4. A celebration of Rube Goldberg (if supported)\n", tag_demo, "demo-goldberg")
txt.insert('end', "\n")
txt.insert('end', "Miscellaneous\n", tag_title)
@ -785,7 +791,7 @@ end
#
def aboutBox
Tk.messageBox('icon'=>'info', 'type'=>'ok', 'title'=>'About Widget Demo',
'message'=>"Ruby/Tk widget demonstration Ver.1.5.0-en\n\n" +
'message'=>"Ruby/Tk widget demonstration Ver.1.5.2-en\n\n" +
"based on demos of Tk8.1 -- 8.5 " +
"( Copyright:: " +
"(c) 1996-1997 Sun Microsystems, Inc. / " +

View file

@ -39,7 +39,7 @@ TkFrame.new($anilabel_demo) {|frame|
TkButton.new(frame) {
text 'コード参照'
command proc{showCode 'label'}
command proc{showCode 'anilabel'}
}.pack('side'=>'left', 'expand'=>'yes')
}.pack('side'=>'bottom', 'fill'=>'x', 'pady'=>'2m')

View file

@ -442,6 +442,12 @@ txt.insert('end', "\n")
txt.insert('end', "アニメーション\n", tag_kanji_title)
txt.insert('end', " \n ", tag_demospace)
txt.insert('end', "1. アニメーションラベル (機能に対応したバージョンのTkが必要)\n", tag_demo, "demo-anilabel")
txt.insert('end', " \n ", tag_demospace)
txt.insert('end', "2. 波形のアニメーション (機能に対応したバージョンのTkが必要)\n", tag_demo, "demo-aniwave")
txt.insert('end', " \n ", tag_demospace)
txt.insert('end', "3. 振り子のシミュレーション (機能に対応したバージョンのTkが必要)\n", tag_demo, "demo-pendulum")
txt.insert('end', " \n ", tag_demospace)
txt.insert('end', "4. A celebration of Rube Goldberg (機能に対応したバージョンのTkが必要)\n", tag_demo, "demo-goldberg")
txt.insert('end', "\n")
#txt.insert('end', "その他\n", tag_middle)
@ -813,7 +819,7 @@ end
#
def aboutBox
Tk.messageBox('icon'=>'info', 'type'=>'ok', 'title'=>'About Widget Demo',
'message'=>"Ruby/Tk ウィジェットデモ Ver.1.5.0-jp\n\n" +
'message'=>"Ruby/Tk ウィジェットデモ Ver.1.5.2-jp\n\n" +
"based on demos of Tk8.1 -- 8.5 " +
"( Copyright:: " +
"(c) 1996-1997 Sun Microsystems, Inc. / " +

View file

@ -8,12 +8,20 @@
************************************************/
#define TKUTIL_RELEASE_DATE "2005-02-16"
#define TKUTIL_RELEASE_DATE "2005-03-02"
#include "ruby.h"
#include "rubysig.h"
#include "st.h"
/* check ruby_version */
#include "version.h"
#if RUBY_VERSION_MINOR == 9
#define ST_FOREACH_PASS_ERR_ARG 1 /* Ruby 1.9 */
#else
#define ST_FOREACH_PASS_ERR_ARG 0 /* Ruby 1.8 (from 2005/02/08) */
#endif
static VALUE cMethod;
static VALUE cTclTkLib;
@ -199,12 +207,36 @@ fromUTF8_toDefaultEnc(str, self)
return tk_fromUTF8(1, argv, self);
}
#if ST_FOREACH_PASS_ERR_ARG
static void
hash_check(err)
int err;
{
if (err) {
rb_raise(rb_eRuntimeError, "hash modified during iteration");
}
}
#endif
#if ST_FOREACH_PASS_ERR_ARG
static int
to_strkey(key, value, hash, err)
VALUE key;
VALUE value;
VALUE hash;
int err;
#else
static int
to_strkey(key, value, hash)
VALUE key;
VALUE value;
VALUE hash;
#endif
{
#if ST_FOREACH_PASS_ERR_ARG
hash_check(err);
#endif
if (key == Qundef) return ST_CONTINUE;
rb_hash_aset(hash, rb_funcall(key, ID_to_s, 0, 0), value);
return ST_CHECK;
@ -219,9 +251,7 @@ tk_symbolkey2str(self, keys)
if NIL_P(keys) return new_keys;
keys = rb_convert_type(keys, T_HASH, "Hash", "to_hash");
if (st_foreach(RHASH(keys)->tbl, to_strkey, new_keys)) {
rb_raise(rb_eRuntimeError, "hash modified during iteration");
}
st_foreach(RHASH(keys)->tbl, to_strkey, new_keys);
return new_keys;
}
@ -454,14 +484,26 @@ assoc2kv_enc(assoc, ary, self)
}
}
#if ST_FOREACH_PASS_ERR_ARG
static int
push_kv(key, val, args, err)
VALUE key;
VALUE val;
VALUE args;
int err;
#else
static int
push_kv(key, val, args)
VALUE key;
VALUE val;
VALUE args;
#endif
{
volatile VALUE ary;
#if ST_FOREACH_PASS_ERR_ARG
hash_check(err);
#endif
ary = RARRAY(args)->ptr[0];
if (key == Qundef) return ST_CONTINUE;
@ -493,9 +535,7 @@ hash2kv(hash, ary, self)
RARRAY(args)->ptr[0] = dst;
RARRAY(args)->ptr[1] = self;
RARRAY(args)->len = 2;
if (st_foreach(RHASH(hash)->tbl, push_kv, args)) {
rb_raise(rb_eRuntimeError, "hash modified during iteration");
}
st_foreach(RHASH(hash)->tbl, push_kv, args);
if (NIL_P(ary)) {
return dst;
@ -504,14 +544,26 @@ hash2kv(hash, ary, self)
}
}
#if ST_FOREACH_PASS_ERR_ARG
static int
push_kv_enc(key, val, args, err)
VALUE key;
VALUE val;
VALUE args;
int err;
#else
static int
push_kv_enc(key, val, args)
VALUE key;
VALUE val;
VALUE args;
#endif
{
volatile VALUE ary;
#if ST_FOREACH_PASS_ERR_ARG
hash_check(err);
#endif
ary = RARRAY(args)->ptr[0];
if (key == Qundef) return ST_CONTINUE;
@ -546,9 +598,7 @@ hash2kv_enc(hash, ary, self)
RARRAY(args)->ptr[0] = dst;
RARRAY(args)->ptr[1] = self;
RARRAY(args)->len = 2;
if (st_foreach(RHASH(hash)->tbl, push_kv_enc, args)) {
rb_raise(rb_eRuntimeError, "hash modified during iteration");
}
st_foreach(RHASH(hash)->tbl, push_kv_enc, args);
if (NIL_P(ary)) {
return dst;