#
# tk.rb - Tk interface module using tcltklib
# $Date$
# by Yukihiro Matsumoto <matz@netlab.jp>
# use Shigehiro's tcltklib
require 'tcltklib'
require 'tkutil'
# autoload
require 'tk/autoload'
class TclTkIp
# backup original (without encoding) _eval and _invoke
alias _eval_without_enc _eval
alias _invoke_without_enc _invoke
def _ip_id_
# for RemoteTkIp
''
end
end
# define TkComm module (step 1: basic functions)
module TkComm
include TkUtil
extend TkUtil
WidgetClassNames = {}.taint
TkExtlibAutoloadModule = [].taint
# None = Object.new ### --> definition is moved to TkUtil module
# def None.to_s
# 'None'
# end
# None.freeze
#Tk_CMDTBL = {}
#Tk_WINDOWS = {}
Tk_IDs = ["00000".taint, "00000".taint].freeze # [0]-cmdid, [1]-winid
# for backward compatibility
Tk_CMDTBL = Object.new
def Tk_CMDTBL.method_missing(id, *args)
TkCore::INTERP.tk_cmd_tbl.__send__(id, *args)
end
Tk_CMDTBL.freeze
Tk_WINDOWS = Object.new
def Tk_WINDOWS.method_missing(id, *args)
TkCore::INTERP.tk_windows.__send__(id, *args)
end
Tk_WINDOWS.freeze
self.instance_eval{
@cmdtbl = [].taint
}
unless const_defined?(:GET_CONFIGINFO_AS_ARRAY)
# GET_CONFIGINFO_AS_ARRAY = false => returns a Hash { opt =>val, ... }
# true => returns an Array [[opt,val], ... ]
# val is a list which includes resource info.
GET_CONFIGINFO_AS_ARRAY = true
end
unless const_defined?(:GET_CONFIGINFOwoRES_AS_ARRAY)
# for configinfo without resource info; list of [opt, value] pair
# false => returns a Hash { opt=>val, ... }
# true => returns an Array [[opt,val], ... ]
GET_CONFIGINFOwoRES_AS_ARRAY = true
end
# *** ATTENTION ***
# 'current_configinfo' method always returns a Hash under all cases of above.
def error_at
frames = caller()
frames.delete_if do |c|
c =~ %r!/tk(|core|thcore|canvas|text|entry|scrollbox)\.rb:\d+!
end
frames
end
private :error_at
def _genobj_for_tkwidget(path)
return TkRoot.new if path == '.'
begin
#tk_class = TkCore::INTERP._invoke('winfo', 'class', path)
tk_class = Tk.ip_invoke_without_enc('winfo', 'class', path)
rescue
return path
end
if ruby_class = WidgetClassNames[tk_class]
ruby_class_name = ruby_class.name
# gen_class_name = ruby_class_name + 'GeneratedOnTk'
gen_class_name = ruby_class_name
classname_def = ''
else # ruby_class == nil
mods = TkExtlibAutoloadModule.find_all{|m| m.const_defined?(tk_class)}
mods.each{|mod|
begin
mod.const_get(tk_class) # auto_load
break if (ruby_class = WidgetClassNames[tk_class])
rescue LoadError
# ignore load error
end
}
unless ruby_class
std_class = 'Tk' << tk_class
if Object.const_defined?(std_class)
Object.const_get(std_class) # auto_load
ruby_class = WidgetClassNames[tk_class]
end
end
if ruby_class
# found
ruby_class_name = ruby_class.name
gen_class_name = ruby_class_name
classname_def = ''
else
# unknown
ruby_class_name = 'TkWindow'
gen_class_name = 'TkWidget_' + tk_class
classname_def = "WidgetClassName = '#{tk_class}'.freeze"
end
end
###################################
=begin
if ruby_class = WidgetClassNames[tk_class]
ruby_class_name = ruby_class.name
# gen_class_name = ruby_class_name + 'GeneratedOnTk'
gen_class_name = ruby_class_name
classname_def = ''
else
mod = TkExtlibAutoloadModule.find{|m| m.const_defined?(tk_class)}
if mod
ruby_class_name = mod.name + '::' + tk_class
gen_class_name = ruby_class_name
classname_def = ''
elsif Object.const_defined?('Tk' + tk_class)
ruby_class_name = 'Tk' + tk_class
# gen_class_name = ruby_class_name + 'GeneratedOnTk'
gen_class_name = ruby_class_name
classname_def = ''
else
ruby_class_name = 'TkWindow'
# gen_class_name = ruby_class_name + tk_class + 'GeneratedOnTk'
gen_class_name = 'TkWidget_' + tk_class
classname_def = "WidgetClassName = '#{tk_class}'.freeze"
end
end
=end
=begin
unless Object.const_defined? gen_class_name
Object.class_eval "class #{gen_class_name}<#{ruby_class_name}
#{classname_def}
end"
end
Object.class_eval "#{gen_class_name}.new('widgetname'=>'#{path}',
'without_creating'=>true)"
=end
base = Object
gen_class_name.split('::').each{|klass|
next if klass == ''
if base.const_defined?(klass)
base = base.class_eval klass
else
base = base.class_eval "class #{klass}<#{ruby_class_name}
#{classname_def}
end
#{klass}"
end
}
base.class_eval "#{gen_class_name}.new('widgetname'=>'#{path}',
'without_creating'=>true)"
end
private :_genobj_for_tkwidget
module_function :_genobj_for_tkwidget
def _at(x,y=nil)
if y
"@#{Integer(x)},#{Integer(y)}"
else
"@#{Integer(x)}"
end
end
module_function :_at
def tk_tcl2ruby(val, enc_mode = false, listobj = true)
=begin
if val =~ /^rb_out\S* (c(_\d+_)?\d+)/
#return Tk_CMDTBL[$1]
return TkCore::INTERP.tk_cmd_tbl[$1]
#cmd_obj = TkCore::INTERP.tk_cmd_tbl[$1]
#if cmd_obj.kind_of?(Proc) || cmd_obj.kind_of?(Method)
# cmd_obj
#else
# cmd_obj.cmd
#end
end
=end
if val =~ /rb_out\S*(?:\s+(::\S*|[{](::.*)[}]|["](::.*)["]))? (c(_\d+_)?(\d+))/
return TkCore::INTERP.tk_cmd_tbl[$4]
end
#if val.include? ?\s
# return val.split.collect{|v| tk_tcl2ruby(v)}
#end
case val
when /^@font/
TkFont.get_obj(val)
when /^-?\d+$/
val.to_i
when /^\./
#Tk_WINDOWS[val] ? Tk_WINDOWS[val] : _genobj_for_tkwidget(val)
TkCore::INTERP.tk_windows[val]?
TkCore::INTERP.tk_windows[val] : _genobj_for_tkwidget(val)
when /^i(_\d+_)?\d+$/
TkImage::Tk_IMGTBL[val]? TkImage::Tk_IMGTBL[val] : val
when /^-?\d+\.?\d*(e[-+]?\d+)?$/
val.to_f
when /\\ /
val.gsub(/\\ /, ' ')
when /[^\\] /
if listobj
#tk_split_escstr(val).collect{|elt|
# tk_tcl2ruby(elt, enc_mode, listobj)
#}
val = _toUTF8(val) unless enc_mode
tk_split_escstr(val, false, false).collect{|elt|
tk_tcl2ruby(elt, true, listobj)
}
elsif enc_mode
_fromUTF8(val)
else
val
end
else
if enc_mode
_fromUTF8(val)
else
val
end
end
end
private :tk_tcl2ruby
module_function :tk_tcl2ruby
#private_class_method :tk_tcl2ruby
unless const_defined?(:USE_TCLs_LIST_FUNCTIONS)
USE_TCLs_LIST_FUNCTIONS = true
end
if USE_TCLs_LIST_FUNCTIONS
###########################################################################
# use Tcl function version of split_list
###########################################################################
def tk_split_escstr(str, src_enc=true, dst_enc=true)
str = _toUTF8(str) if src_enc
if dst_enc
TkCore::INTERP._split_tklist(str).map!{|s| _fromUTF8(s)}
else
TkCore::INTERP._split_tklist(str)
end
end
def tk_split_sublist(str, depth=-1, src_enc=true, dst_enc=true)
# return [] if str == ""
# list = TkCore::INTERP._split_tklist(str)
str = _toUTF8(str) if src_enc
if depth == 0
return "" if str == ""
list = [str]
else
return [] if str == ""
list = TkCore::INTERP._split_tklist(str)
end
if list.size == 1
# tk_tcl2ruby(list[0], nil, false)
tk_tcl2ruby(list[0], dst_enc, false)
else
list.collect{|token| tk_split_sublist(token, depth - 1, false, dst_enc)}
end
end
def tk_split_list(str, depth=0, src_enc=true, dst_enc=true)
return [] if str == ""
str = _toUTF8(str) if src_enc
TkCore::INTERP._split_tklist(str).map!{|token|
tk_split_sublist(token, depth - 1, false, dst_enc)
}
end
def tk_split_simplelist(str, src_enc=true, dst_enc=true)
#lst = TkCore::INTERP._split_tklist(str)
#if (lst.size == 1 && lst =~ /^\{.*\}$/)
# TkCore::INTERP._split_tklist(str[1..-2])
#else
# lst
#end
str = _toUTF8(str) if src_enc
if dst_enc
TkCore::INTERP._split_tklist(str).map!{|s| _fromUTF8(s)}
else
TkCore::INTERP._split_tklist(str)
end
end
def array2tk_list(ary, enc=nil)
return "" if ary.size == 0
sys_enc = TkCore::INTERP.encoding
sys_enc = TclTkLib.encoding_system unless sys_enc
dst_enc = (enc == nil)? sys_enc: enc
dst = ary.collect{|e|
if e.kind_of? Array
s = array2tk_list(e, enc)
elsif e.kind_of? Hash
tmp_ary = []
#e.each{|k,v| tmp_ary << k << v }
e.each{|k,v| tmp_ary << "-#{_get_eval_string(k)}" << v }
s = array2tk_list(tmp_ary, enc)
else
s = _get_eval_string(e, enc)
end
if dst_enc != true && dst_enc != false
if (s_enc = s.instance_variable_get(:@encoding))
s_enc = s_enc.to_s
else
s_enc = sys_enc
end
dst_enc = true if s_enc != dst_enc
end
s
}
if sys_enc && dst_enc
dst.map!{|s| _toUTF8(s)}
ret = TkCore::INTERP._merge_tklist(*dst)
if dst_enc.kind_of?(String)
ret = _fromUTF8(ret, dst_enc)
ret.instance_variable_set(:@encoding, dst_enc)
else
ret.instance_variable_set(:@encoding, 'utf-8')
end
ret
else
TkCore::INTERP._merge_tklist(*dst)
end
end
else
###########################################################################
# use Ruby script version of split_list (traditional methods)
###########################################################################
def tk_split_escstr(str, src_enc=true, dst_enc=true)
return [] if str == ""
list = []
token = nil
escape = false
brace = 0
str.split('').each {|c|
brace += 1 if c == '{' && !escape
brace -= 1 if c == '}' && !escape
if brace == 0 && c == ' ' && !escape
list << token.gsub(/^\{(.*)\}$/, '\1') if token
token = nil
else
token = (token || "") << c
end
escape = (c == '\\' && !escape)
}
list << token.gsub(/^\{(.*)\}$/, '\1') if token
list
end
def tk_split_sublist(str, depth=-1, src_enc=true, dst_enc=true)
#return [] if str == ""
#return [tk_split_sublist(str[1..-2])] if str =~ /^\{.*\}$/
#list = tk_split_escstr(str)
if depth == 0
return "" if str == ""
str = str[1..-2] if str =~ /^\{.*\}$/
list = [str]
else
return [] if str == []
return [tk_split_sublist(str[1..-2], depth - 1)] if str =~ /^\{.*\}$/
list = tk_split_escstr(str)
end
if list.size == 1
tk_tcl2ruby(list[0], nil, false)
else
list.collect{|token| tk_split_sublist(token, depth - 1)}
end
end
def tk_split_list(str, depth=0, src_enc=true, dst_enc=true)
return [] if str == ""
tk_split_escstr(str).collect{|token|
tk_split_sublist(token, depth - 1)
}
end
=begin
def tk_split_list(str)
return [] if str == ""
idx = str.index('{')
while idx and idx > 0 and str[idx-1] == ?\\
idx = str.index('{', idx+1)
end
unless idx
list = tk_tcl2ruby(str)
unless Array === list
list = [list]
end
return list
end
list = tk_tcl2ruby(str[0,idx])
list = [] if list == ""
str = str[idx+1..-1]
i = -1
escape = false
brace = 1
str.each_byte {|c|
i += 1
brace += 1 if c == ?{ && !escape
brace -= 1 if c == ?} && !escape
escape = (c == ?\\)
break if brace == 0
}
if str.size == i + 1
return tk_split_list(str[0, i])
end
if str[0, i] == ' '
list.push ' '
else
list.push tk_split_list(str[0, i])
end
list += tk_split_list(str[i+1..-1])
list
end
=end
def tk_split_simplelist(str, src_enc=true, dst_enc=true)
return [] if str == ""
list = []
token = nil
escape = false
brace = 0
str.split('').each {|c|
if c == '\\' && !escape
escape = true
token = (token || "") << c if brace > 0
next
end
brace += 1 if c == '{' && !escape
brace -= 1 if c == '}' && !escape
if brace == 0 && c == ' ' && !escape
list << token.gsub(/^\{(.*)\}$/, '\1') if token
token = nil
else
token = (token || "") << c
end
escape = false
}
list << token.gsub(/^\{(.*)\}$/, '\1') if token
list
end
def array2tk_list(ary, enc=nil)
ary.collect{|e|
if e.kind_of? Array
"{#{array2tk_list(e, enc)}}"
elsif e.kind_of? Hash
# "{#{e.to_a.collect{|ee| array2tk_list(ee)}.join(' ')}}"
e.each{|k,v| tmp_ary << "-#{_get_eval_string(k)}" << v }
array2tk_list(tmp_ary, enc)
else
s = _get_eval_string(e, enc)
(s.index(/\s/) || s.size == 0)? "{#{s}}": s
end
}.join(" ")
end
end
private :tk_split_escstr, :tk_split_sublist
private :tk_split_list, :tk_split_simplelist
private :array2tk_list
module_function :tk_split_escstr, :tk_split_sublist
module_function :tk_split_list, :tk_split_simplelist
module_function :array2tk_list
private_class_method :tk_split_escstr, :tk_split_sublist
private_class_method :tk_split_list, :tk_split_simplelist
# private_class_method :array2tk_list
=begin
### --> definition is moved to TkUtil module
def _symbolkey2str(keys)
h = {}
keys.each{|key,value| h[key.to_s] = value}
h
end
private :_symbolkey2str
module_function :_symbolkey2str
=end
=begin
### --> definition is moved to TkUtil module
# def hash_kv(keys, enc_mode = nil, conf = [], flat = false)
def hash_kv(keys, enc_mode = nil, conf = nil)
# Hash {key=>val, key=>val, ... } or Array [ [key, val], [key, val], ... ]
# ==> Array ['-key', val, '-key', val, ... ]
dst = []
if keys and keys != None
keys.each{|k, v|
#dst.push("-#{k}")
dst.push('-' + k.to_s)
if v != None
# v = _get_eval_string(v, enc_mode) if (enc_mode || flat)
v = _get_eval_string(v, enc_mode) if enc_mode
dst.push(v)
end
}
end
if conf
conf + dst
else
dst
end
end
private :hash_kv
module_function :hash_kv
=end
=begin
### --> definition is moved to TkUtil module
def bool(val)
case val
when "1", 1, 'yes', 'true'
true
else
false
end
end
def number(val)
case val
when /^-?\d+$/
val.to_i
when /^-?\d+\.?\d*(e[-+]?\d+)?$/
val.to_f
else
fail(ArgumentError, "invalid value for Number:'#{val}'")
end
end
def string(val)
if val == "{}"
''
elsif val[0] == ?{ && val[-1] == ?}
val[1..-2]
else
val
end
end
def num_or_str(val)
begin
number(val)
rescue ArgumentError
string(val)
end
end
=end
def list(val, depth=0, enc=true)
tk_split_list(val, depth, enc, enc)
end
def simplelist(val, src_enc=true, dst_enc=true)
tk_split_simplelist(val, src_enc, dst_enc)
end
def window(val)
if val =~ /^\./
#Tk_WINDOWS[val]? Tk_WINDOWS[val] : _genobj_for_tkwidget(val)
TkCore::INTERP.tk_windows[val]?
TkCore::INTERP.tk_windows[val] : _genobj_for_tkwidget(val)
else
nil
end
end
def image_obj(val)
if val =~ /^i(_\d+_)?\d+$/
TkImage::Tk_IMGTBL[val]? TkImage::Tk_IMGTBL[val] : val
else
val
end
end
def procedure(val)
=begin
if val =~ /^rb_out\S* (c(_\d+_)?\d+)/
#Tk_CMDTBL[$1]
#TkCore::INTERP.tk_cmd_tbl[$1]
TkCore::INTERP.tk_cmd_tbl[$1].cmd
=end
if val =~ /rb_out\S*(?:\s+(::\S*|[{](::.*)[}]|["](::.*)["]))? (c(_\d+_)?(\d+))/
return TkCore::INTERP.tk_cmd_tbl[$4].cmd
else
#nil
val
end
end
private :bool, :number, :string, :num_or_str
private :list, :simplelist, :window, :procedure
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
def _fromUTF8(str, encoding = nil)
TkCore::INTERP._fromUTF8(str, encoding)
end
private :_toUTF8, :_fromUTF8
module_function :_toUTF8, :_fromUTF8
def _callback_entry_class?(cls)
cls <= Proc || cls <= Method || cls <= TkCallbackEntry
end
private :_callback_entry_class?
module_function :_callback_entry_class?
def _callback_entry?(obj)
obj.kind_of?(Proc) || obj.kind_of?(Method) || obj.kind_of?(TkCallbackEntry)
end
private :_callback_entry?
module_function :_callback_entry?
=begin
### --> definition is moved to TkUtil module
def _get_eval_string(str, enc_mode = nil)
return nil if str == None
if str.kind_of?(TkObject)
str = str.path
elsif str.kind_of?(String)
str = _toUTF8(str) if enc_mode
elsif str.kind_of?(Symbol)
str = str.id2name
str = _toUTF8(str) if enc_mode
elsif str.kind_of?(Hash)
str = hash_kv(str, enc_mode).join(" ")
elsif str.kind_of?(Array)
str = array2tk_list(str)
str = _toUTF8(str) if enc_mode
elsif str.kind_of?(Proc)
str = install_cmd(str)
elsif str == nil
str = ""
elsif str == false
str = "0"
elsif str == true
str = "1"
elsif (str.respond_to?(:to_eval))
str = str.to_eval()
str = _toUTF8(str) if enc_mode
else
str = str.to_s() || ''
unless str.kind_of? String
fail RuntimeError, "fail to convert the object to a string"
end
str = _toUTF8(str) if enc_mode
end
return str
end
=end
=begin
def _get_eval_string(obj, enc_mode = nil)
case obj
when Numeric
obj.to_s
when String
(enc_mode)? _toUTF8(obj): obj
when Symbol
(enc_mode)? _toUTF8(obj.id2name): obj.id2name
when TkObject
obj.path
when Hash
hash_kv(obj, enc_mode).join(' ')
when Array
(enc_mode)? _toUTF8(array2tk_list(obj)): array2tk_list(obj)
when Proc, Method, TkCallbackEntry
install_cmd(obj)
when false
'0'
when true
'1'
when nil
''
when None
nil
else
if (obj.respond_to?(:to_eval))
(enc_mode)? _toUTF8(obj.to_eval): obj.to_eval
else
begin
obj = obj.to_s || ''
rescue
fail RuntimeError, "fail to convert object '#{obj}' to string"
end
(enc_mode)? _toUTF8(obj): obj
end
end
end
private :_get_eval_string
module_function :_get_eval_string
=end
=begin
### --> definition is moved to TkUtil module
def _get_eval_enc_str(obj)
return obj if obj == None
_get_eval_string(obj, true)
end
private :_get_eval_enc_str
module_function :_get_eval_enc_str
=end
=begin
### --> obsolete
def ruby2tcl(v, enc_mode = nil)
if v.kind_of?(Hash)
v = hash_kv(v)
v.flatten!
v.collect{|e|ruby2tcl(e, enc_mode)}
else
_get_eval_string(v, enc_mode)
end
end
private :ruby2tcl
=end
=begin
### --> definition is moved to TkUtil module
def _conv_args(args, enc_mode, *src_args)
conv_args = []
src_args.each{|arg|
conv_args << _get_eval_string(arg, enc_mode) unless arg == None
# if arg.kind_of?(Hash)
# arg.each{|k, v|
# args << '-' + k.to_s
# args << _get_eval_string(v, enc_mode)
# }
# elsif arg != None
# args << _get_eval_string(arg, enc_mode)
# end
}
args + conv_args
end
private :_conv_args
=end
def _curr_cmd_id
#id = format("c%.4d", Tk_IDs[0])
id = "c" + TkCore::INTERP._ip_id_ + TkComm::Tk_IDs[0]
end
def _next_cmd_id
id = _curr_cmd_id
#Tk_IDs[0] += 1
TkComm::Tk_IDs[0].succ!
id
end
private :_curr_cmd_id, :_next_cmd_id
module_function :_curr_cmd_id, :_next_cmd_id
def install_cmd(cmd)
return '' if cmd == ''
begin
ns = TkCore::INTERP._invoke_without_enc('namespace', 'current')
ns = nil if ns == '::' # for backward compatibility
rescue
# probably, Tcl7.6
ns = nil
end
id = _next_cmd_id
#Tk_CMDTBL[id] = cmd
if cmd.kind_of?(TkCallbackEntry)
TkCore::INTERP.tk_cmd_tbl[id] = cmd
else
TkCore::INTERP.tk_cmd_tbl[id] = TkCore::INTERP.get_cb_entry(cmd)
end
@cmdtbl = [] unless defined? @cmdtbl
@cmdtbl.taint unless @cmdtbl.tainted?
@cmdtbl.push id
#return Kernel.format("rb_out %s", id);
if ns
'rb_out' << TkCore::INTERP._ip_id_ << ' ' << ns << ' ' << id
else
'rb_out' << TkCore::INTERP._ip_id_ << ' ' << id
end
end
def uninstall_cmd(id)
#id = $1 if /rb_out\S* (c(_\d+_)?\d+)/ =~ id
id = $4 if id =~ /rb_out\S*(?:\s+(::\S*|[{](::.*)[}]|["](::.*)["]))? (c(_\d+_)?(\d+))/
#Tk_CMDTBL.delete(id)
TkCore::INTERP.tk_cmd_tbl.delete(id)
end
# private :install_cmd, :uninstall_cmd
module_function :install_cmd, :uninstall_cmd
=begin
def install_win(ppath,name=nil)
if !name or name == ''
#name = format("w%.4d", Tk_IDs[1])
#Tk_IDs[1] += 1
name = "w" + Tk_IDs[1]
Tk_IDs[1].succ!
end
if name[0] == ?.
@path = name.dup
elsif !ppath or ppath == "."
@path = Kernel.format(".%s", name);
else
@path = Kernel.format("%s.%s", ppath, name)
end
#Tk_WINDOWS[@path] = self
TkCore::INTERP.tk_windows[@path] = self
end
=end
def install_win(ppath,name=nil)
if name
if name == ''
raise ArgumentError, "invalid wiget-name '#{name}'"
end
if name[0] == ?.
@path = '' + name
@path.freeze
return TkCore::INTERP.tk_windows[@path] = self
end
else
name = "w" + TkCore::INTERP._ip_id_ + Tk_IDs[1]
Tk_IDs[1].succ!
end
if !ppath or ppath == '.'
@path = '.' + name
else
@path = ppath + '.' + name
end
@path.freeze
TkCore::INTERP.tk_windows[@path] = self
end
def uninstall_win()
#Tk_WINDOWS.delete(@path)
TkCore::INTERP.tk_windows.delete(@path)
end
private :install_win, :uninstall_win
def _epath(win)
if win.kind_of?(TkObject)
win.epath
elsif win.respond_to?(:epath)
win.epath
else
win
end
end
private :_epath
end
# define TkComm module (step 2: event binding)
module TkComm
include TkEvent
extend TkEvent
def tk_event_sequence(context)
if context.kind_of? TkVirtualEvent
context = context.path
end
if context.kind_of? Array
context = context.collect{|ev|
if ev.kind_of? TkVirtualEvent
ev.path
else
ev
end
}.join("><")
end
if /,/ =~ context
context = context.split(/\s*,\s*/).join("><")
else
context
end
end
def _bind_core(mode, what, context, cmd, *args)
id = install_bind(cmd, *args) if cmd
begin
tk_call_without_enc(*(what + ["<#{tk_event_sequence(context)}>",
mode + id]))
rescue
uninstall_cmd(id) if cmd
fail
end
end
def _bind(what, context, cmd, *args)
_bind_core('', what, context, cmd, *args)
end
def _bind_append(what, context, cmd, *args)
_bind_core('+', what, context, cmd, *args)
end
def _bind_remove(what, context)
tk_call_without_enc(*(what + ["<#{tk_event_sequence(context)}>", '']))
end
def _bindinfo(what, context=nil)
if context
tk_call_without_enc(*what+["<#{tk_event_sequence(context)}>"]) .collect {|cmdline|
=begin
if cmdline =~ /^rb_out\S* (c(?:_\d+_)?\d+)\s+(.*)$/
#[Tk_CMDTBL[$1], $2]
[TkCore::INTERP.tk_cmd_tbl[$1], $2]
=end
if cmdline =~ /rb_out\S*(?:\s+(::\S*|[{](::.*)[}]|["](::.*)["]))? (c(_\d+_)?(\d+))/
[TkCore::INTERP.tk_cmd_tbl[$4], $5]
else
cmdline
end
}
else
tk_split_simplelist(tk_call_without_enc(*what)).collect!{|seq|
l = seq.scan(/<*[^<>]+>*/).collect!{|subseq|
case (subseq)
when /^<<[^<>]+>>$/
TkVirtualEvent.getobj(subseq[1..-2])
when /^<[^<>]+>$/
subseq[1..-2]
else
subseq.split('')
end
}.flatten
(l.size == 1) ? l[0] : l
}
end
end
def _bind_core_for_event_class(klass, mode, what, context, cmd, *args)
id = install_bind_for_event_class(klass, cmd, *args) if cmd
begin
tk_call_without_enc(*(what + ["<#{tk_event_sequence(context)}>",
mode + id]))
rescue
uninstall_cmd(id) if cmd
fail
end
end
def _bind_for_event_class(klass, what, context, cmd, *args)
_bind_core_for_event_class(klass, '', what, context, cmd, *args)
end
def _bind_append_for_event_class(klass, what, context, cmd, *args)
_bind_core_for_event_class(klass, '+', what, context, cmd, *args)
end
def _bind_remove_for_event_class(klass, what, context)
_bind_remove(what, context)
end
def _bindinfo_for_event_class(klass, what, context=nil)
_bindinfo(what, context)
end
private :tk_event_sequence
private :_bind_core, :_bind, :_bind_append, :_bind_remove, :_bindinfo
private :_bind_core_for_event_class, :_bind_for_event_class,
:_bind_append_for_event_class, :_bind_remove_for_event_class,
:_bindinfo_for_event_class
#def bind(tagOrClass, context, cmd=Proc.new, *args)
# _bind(["bind", tagOrClass], context, cmd, *args)
# tagOrClass
#end
def bind(tagOrClass, context, *args)
# if args[0].kind_of?(Proc) || args[0].kind_of?(Method)
if TkComm._callback_entry?(args[0]) || !block_given?
cmd = args.shift
else
cmd = Proc.new
end
_bind(["bind", tagOrClass], context, cmd, *args)
tagOrClass
end
#def bind_append(tagOrClass, context, cmd=Proc.new, *args)
# _bind_append(["bind", tagOrClass], context, cmd, *args)
# tagOrClass
#end
def bind_append(tagOrClass, context, *args)
# if args[0].kind_of?(Proc) || args[0].kind_of?(Method)
if TkComm._callback_entry?(args[0]) || !block_given?
cmd = args.shift
else
cmd = Proc.new
end
_bind_append(["bind", tagOrClass], context, cmd, *args)
tagOrClass
end
def bind_remove(tagOrClass, context)
_bind_remove(['bind', tagOrClass], context)
tagOrClass
end
def bindinfo(tagOrClass, context=nil)
_bindinfo(['bind', tagOrClass], context)
end
#def bind_all(context, cmd=Proc.new, *args)
# _bind(['bind', 'all'], context, cmd, *args)
# TkBindTag::ALL
#end
def bind_all(context, *args)
# if args[0].kind_of?(Proc) || args[0].kind_of?(Method)
if TkComm._callback_entry?(args[0]) || !block_given?
cmd = args.shift
else
cmd = Proc.new
end
_bind(['bind', 'all'], context, cmd, *args)
TkBindTag::ALL
end
#def bind_append_all(context, cmd=Proc.new, *args)
# _bind_append(['bind', 'all'], context, cmd, *args)
# TkBindTag::ALL
#end
def bind_append_all(context, *args)
# if args[0].kind_of?(Proc) || args[0].kind_of?(Method)
if TkComm._callback_entry?(args[0]) || !block_given?
cmd = args.shift
else
cmd = Proc.new
end
_bind_append(['bind', 'all'], context, cmd, *args)
TkBindTag::ALL
end
def bind_remove_all(context)
_bind_remove(['bind', 'all'], context)
TkBindTag::ALL
end
def bindinfo_all(context=nil)
_bindinfo(['bind', 'all'], context)
end
end
module TkCore
include TkComm
extend TkComm
unless self.const_defined? :INTERP
if self.const_defined? :IP_NAME
name = IP_NAME.to_s
else
#name = nil
name = $0
end
if self.const_defined? :IP_OPTS
if IP_OPTS.kind_of?(Hash)
opts = hash_kv(IP_OPTS).join(' ')
else
opts = IP_OPTS.to_s
end
else
opts = ''
end
INTERP = TclTkIp.new(name, opts)
def INTERP.__getip
self
end
INTERP.instance_eval{
@tk_cmd_tbl = {}.taint
def @tk_cmd_tbl.[]=(idx,val)
if self.has_key?(idx) && Thread.current.group != ThreadGroup::Default
fail SecurityError,"cannot change the entried command"
end
super(idx,val)
end
@tk_windows = {}.taint
@tk_table_list = [].taint
@init_ip_env = [].taint # table of Procs
@add_tk_procs = [].taint # table of [name, args, body]
@cb_entry_class = Class.new(TkCallbackEntry){|c|
class << c
def inspect
sprintf("#<Class(TkCallbackEntry):%0x>", self.__id__)
end
alias to_s inspect
end
def initialize(ip, cmd)
@ip = ip
@cmd = cmd
end
attr_reader :ip, :cmd
def call(*args)
@ip.cb_eval(@cmd, *args)
end
def inspect
sprintf("#<cb_entry:%0x>", self.__id__)
end
alias to_s inspect
}.freeze
}
def INTERP.cb_entry_class
@cb_entry_class
end
def INTERP.tk_cmd_tbl
@tk_cmd_tbl
end
def INTERP.tk_windows
@tk_windows
end
class Tk_OBJECT_TABLE
def initialize(id)
@id = id
end
def method_missing(m, *args, &b)
TkCore::INTERP.tk_object_table(@id).__send__(m, *args, &b)
end
end
def INTERP.tk_object_table(id)
@tk_table_list[id]
end
def INTERP.create_table
id = @tk_table_list.size
(tbl = {}).tainted? || tbl.taint
@tk_table_list << tbl
# obj = Object.new
# obj.instance_eval <<-EOD
# def self.method_missing(m, *args)
# TkCore::INTERP.tk_object_table(#{id}).send(m, *args)
# end
# EOD
# return obj
Tk_OBJECT_TABLE.new(id)
end
def INTERP.get_cb_entry(cmd)
@cb_entry_class.new(__getip, cmd).freeze
end
def INTERP.cb_eval(cmd, *args)
TkUtil._get_eval_string(TkUtil.eval_cmd(cmd, *args))
end
def INTERP.init_ip_env(script = Proc.new)
@init_ip_env << script
script.call(self)
end
def INTERP.add_tk_procs(name, args = nil, body = nil)
@add_tk_procs << [name, args, body]
self._invoke('proc', name, args, body) if args && body
end
def INTERP.init_ip_internal
ip = self
@init_ip_env.each{|script| script.call(ip)}
@add_tk_procs.each{|name,args,body| ip._invoke('proc',name,args,body)}
end
end
WIDGET_DESTROY_HOOK = '<WIDGET_DESTROY_HOOK>'
INTERP._invoke_without_enc('event', 'add',
"<#{WIDGET_DESTROY_HOOK}>", '<Destroy>')
INTERP._invoke_without_enc('bind', 'all', "<#{WIDGET_DESTROY_HOOK}>",
install_cmd(proc{|path|
unless TkCore::INTERP.deleted?
begin
if (widget=TkCore::INTERP.tk_windows[path])
if widget.respond_to?(:__destroy_hook__)
widget.__destroy_hook__
end
end
rescue Exception=>e
p e if $DEBUG
end
end
}) << ' %W')
INTERP.add_tk_procs(TclTkLib::FINALIZE_PROC_NAME, '',
"bind all <#{WIDGET_DESTROY_HOOK}> {}")
INTERP.add_tk_procs('rb_out', 'ns args', <<-'EOL')
if [regexp {^::} $ns] {
set cmd {namespace eval $ns {ruby_cmd TkCore callback} $args}
} else {
set cmd {eval {ruby_cmd TkCore callback} $ns $args}
}
if {[set st [catch $cmd ret]] != 0} {
#return -code $st $ret
set idx [string first "\n\n" $ret]
if {$idx > 0} {
|