summaryrefslogtreecommitdiff
path: root/ext/tk
diff options
context:
space:
mode:
authornagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>2005-03-02 07:08:18 +0000
committernagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>2005-03-02 07:08:18 +0000
commitd7d2f8bfe294f886ebb6ba3d7bf94a3a5e884049 (patch)
tree202fdc4daf958bdad32c9ea2e2cc48b40a782304 /ext/tk
parent1c59b283a5cc2478aaed7d7a8ccd5bae2f121ce1 (diff)
* 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
Diffstat (limited to 'ext/tk')
-rw-r--r--ext/tk/ChangeLog.tkextlib4
-rw-r--r--ext/tk/lib/multi-tk.rb277
-rw-r--r--ext/tk/lib/tk.rb89
-rw-r--r--ext/tk/lib/tk/canvas.rb6
-rw-r--r--ext/tk/lib/tk/clock.rb6
-rw-r--r--ext/tk/lib/tk/timer.rb1
-rw-r--r--ext/tk/lib/tk/variable.rb247
-rw-r--r--ext/tk/lib/tkextlib/tclx/tclx.rb10
-rw-r--r--ext/tk/sample/demos-en/anilabel.rb2
-rw-r--r--ext/tk/sample/demos-en/widget8
-rw-r--r--ext/tk/sample/demos-jp/anilabel.rb2
-rw-r--r--ext/tk/sample/demos-jp/widget8
-rw-r--r--ext/tk/tkutil.c70
13 files changed, 586 insertions, 144 deletions
diff --git a/ext/tk/ChangeLog.tkextlib b/ext/tk/ChangeLog.tkextlib
index 53e3dd69ee..d99ceece7e 100644
--- a/ext/tk/ChangeLog.tkextlib
+++ b/ext/tk/ChangeLog.tkextlib
@@ -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
diff --git a/ext/tk/lib/multi-tk.rb b/ext/tk/lib/multi-tk.rb
index cfe4887c4e..268246fa73 100644
--- a/ext/tk/lib/multi-tk.rb
+++ b/ext/tk/lib/multi-tk.rb
@@ -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
- end
+ break unless self.alive?
+ if check_root
+ begin
+ break if TclTkLib.num_of_mainwindows == 0
+ rescue StandardError
+ break
end
- @interp.mainloop(check_root)
end
- #rescue StandardError
- rescue Exception
- if TclTkLib.mainloop_abort_on_exception != nil
- STDERR.print("Warning: Tk mainloop receives ", $!.class.inspect,
- " exception (ignore) : ", $!.message, "\n");
+ 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
+ #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
- 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
diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb
index e7217ff975..95e26d7264 100644
--- a/ext/tk/lib/tk.rb
+++ b/ext/tk/lib/tk.rb
@@ -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'
diff --git a/ext/tk/lib/tk/canvas.rb b/ext/tk/lib/tk/canvas.rb
index e9a2caccd6..0a2bcad9f1 100644
--- a/ext/tk/lib/tk/canvas.rb
+++ b/ext/tk/lib/tk/canvas.rb
@@ -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)})
diff --git a/ext/tk/lib/tk/clock.rb b/ext/tk/lib/tk/clock.rb
index 3581152c8b..4e9438f5ab 100644
--- a/ext/tk/lib/tk/clock.rb
+++ b/ext/tk/lib/tk/clock.rb
@@ -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
diff --git a/ext/tk/lib/tk/timer.rb b/ext/tk/lib/tk/timer.rb
index a1f43fa864..b399bd8b97 100644
--- a/ext/tk/lib/tk/timer.rb
+++ b/ext/tk/lib/tk/timer.rb
@@ -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
diff --git a/ext/tk/lib/tk/variable.rb b/ext/tk/lib/tk/variable.rb
index 62d4ec29ae..e3a08dfdcf 100644
--- a/ext/tk/lib/tk/variable.rb
+++ b/ext/tk/lib/tk/variable.rb
@@ -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
diff --git a/ext/tk/lib/tkextlib/tclx/tclx.rb b/ext/tk/lib/tkextlib/tclx/tclx.rb
index 760ebd92b1..44799acbc9 100644
--- a/ext/tk/lib/tkextlib/tclx/tclx.rb
+++ b/ext/tk/lib/tkextlib/tclx/tclx.rb
@@ -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
diff --git a/ext/tk/sample/demos-en/anilabel.rb b/ext/tk/sample/demos-en/anilabel.rb
index 36989c5c91..f063bc53a4 100644
--- a/ext/tk/sample/demos-en/anilabel.rb
+++ b/ext/tk/sample/demos-en/anilabel.rb
@@ -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')
diff --git a/ext/tk/sample/demos-en/widget b/ext/tk/sample/demos-en/widget
index 1a4fb0b96d..b8073a05da 100644
--- a/ext/tk/sample/demos-en/widget
+++ b/ext/tk/sample/demos-en/widget
@@ -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. / " +
diff --git a/ext/tk/sample/demos-jp/anilabel.rb b/ext/tk/sample/demos-jp/anilabel.rb
index 8cbec50167..97781fbe77 100644
--- a/ext/tk/sample/demos-jp/anilabel.rb
+++ b/ext/tk/sample/demos-jp/anilabel.rb
@@ -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')
diff --git a/ext/tk/sample/demos-jp/widget b/ext/tk/sample/demos-jp/widget
index 3be05c167c..59d6309d56 100644
--- a/ext/tk/sample/demos-jp/widget
+++ b/ext/tk/sample/demos-jp/widget
@@ -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. / " +
diff --git a/ext/tk/tkutil.c b/ext/tk/tkutil.c
index 221432bb76..bedf12642a 100644
--- a/ext/tk/tkutil.c
+++ b/ext/tk/tkutil.c
@@ -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;