/sources/ruby-1.8.5/ext/tk/lib/tk.rb

Large files files are truncated, but you can click here to view the full file

#
#               tk.rb - Tk interface module using tcltklib
#                       $Date: 2006/07/14 04:10:49 $
#                       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 /\A@font\S+\z/
      TkFont.get_obj(val)
    when /\A-?\d+\z/
      val.to_i
    when /\A\.\S*\z/
      #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 /\Ai(_\d+_)?\d+\z/
      TkImage::Tk_IMGTBL[val]? TkImage::Tk_IMGTBL[val] : val
    when /\A-?\d+\.?\d*(e[-+]?\d+)?\z/
      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){
        class << self
          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)
      if name.kind_of?(Array)
        name.each{|param| self.add_tk_procs(*param)}
      else
        name = name.to_s
        @add_tk_procs << [name, args, body]
        self._invoke('proc', name, args, body) if args && body
      end
    end
    def INTERP.remove_tk_procs(*names)
      names.each{|name|
        name = name.to_s
        @add_tk_procs.delete_if{|elem| 
          elem.kind_of?(Array) && elem[0].to_s == name
        }
        self._invoke('rename', name, '')
      }
    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} {
          return -code $st \
                 -errorinfo [string range $ret [expr $idx + 2] \
                                               [string length $ret]] \
                 [string range $ret 0 [expr $idx - 1]]
       } else {
          return -code $st $ret
       }
    } else {
        return $ret
    }
  EOL
=begin
  INTERP.add_tk_procs('rb_out', 'args', <<-'EOL')
    if {[set st [catch {eval {ruby_cmd TkCore callback} $args} ret]] != 0} {
       #return -code $st $ret
       set idx [string first "\n\n" $ret]
       if {$idx > 0} {
          return -code $st \
                 -errorinfo [string range $ret [expr $idx + 2] \
                                               [string length $ret]] \
                 [string range $ret 0 [expr $idx - 1]]
       } else {
          return -code $st $ret
       }
    } else {
        return $ret
    }
  EOL
=end
=begin
  INTERP.add_tk_procs('rb_out', 'args', <<-'EOL')
    #regsub -all {\\} $args {\\\\} args
    #regsub -all {!} $args {\\!} args
    #regsub -all "{" $args "\\{" args
    regsub -all {(\\|!|\{|\})} $args {\\\1} args
    if {[set st [catch {ruby [format "TkCore.callback %%Q!%s!" $args]} ret]] != 0} {
       #return -code $st $ret
       set idx [string first "\n\n" $ret]
       if {$idx > 0} {
          return -code $st \
                 -errorinfo [string range $ret [expr $idx + 2] \
                                               [string length $ret]] \
                 [string range $ret 0 [expr $idx - 1]]
       } else {
          return -code $st $ret
       }
    } else {
        return $ret
    }
  EOL
=end

  at_exit{ INTERP.remove_tk_procs(TclTkLib::FINALIZE_PROC_NAME) }

  EventFlag = TclTkLib::EventFlag

  def callback_break
    fail TkCallbackBreak, "Tk callback returns 'break' status"
  end

  def callback_continue
    fail TkCallbackContinue, "Tk callback returns 'continue' status"
  end

  def callback_return
    fail TkCallbackReturn, "Tk callback returns 'return' status"
  end

  def TkCore.callback(*arg)
    begin
      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) + ': ' + 
              _toUTF8(e.message) + "\n" + 
              "\n---< backtrace of Ruby side >-----\n" + 
              _toUTF8(e.backtrace.join("\n")) + 
              "\n---< backtrace of Tk side >-------"
        msg.instance_variable_set(:@encoding, 'utf-8')
      rescue Exception
        msg = e.class.inspect + ': ' + e.message + "\n" + 
              "\n---< backtrace of Ruby side >-----\n" + 
              e.backtrace.join("\n") + 
              "\n---< backtrace of Tk side >-------"
      end
      # TkCore::INTERP._set_global_var('errorInfo', msg)
      # fail(e)
      fail(e, msg)
    end
  end
=begin
  def TkCore.callback(arg_str)
    # arg = tk_split_list(arg_str)
    arg = tk_split_simplelist(arg_str)
    #_get_eval_string(TkUtil.eval_cmd(Tk_CMDTBL[arg.shift], *arg))
    #_get_eval_string(TkUtil.eval_cmd(TkCore::INTERP.tk_cmd_tbl[arg.shift], 
    #                        *arg))
    # TkCore::INTERP.tk_cmd_tbl[arg.shift].call(*arg)
    begin
      TkCore::INTERP.tk_cmd_tbl[arg.shift].call(*arg)
    rescue Exception => e
      raise(e, e.class.inspect + ': ' + e.message + "\n" + 
               "\n---< backtrace of Ruby side >-----\n" + 
               e.backtrace.join("\n") + 
               "\n---< backtrace of Tk side >-------")
    end
#=begin
#    cb_obj = TkCore::INTERP.tk_cmd_tbl[arg.shift]
#    unless $DEBUG
#      cb_obj.call(*arg)
#    else
#      begin
#       raise 'check backtrace'
#      rescue
#       # ignore backtrace before 'callback'
#       pos = -($!.backtrace.size)
#      end
#      begin
#       cb_obj.call(*arg)
#      rescue
#       trace = $!.backtrace
#       raise $!, "\n#{trace[0]}: #{$!.message} (#{$!.class})\n" + 
#                 "\tfrom #{trace[1..pos].join("\n\tfrom ")}"
#      end
#    end
#=end
  end
=end

  def load_cmd_on_ip(tk_cmd)
    bool(tk_call('auto_load', tk_cmd))
  end

  def after(ms, cmd=Proc.new)
    crit_bup = Thread.critical
    Thread.critical = true

    myid = _curr_cmd_id
    cmdid = install_cmd(proc{ret = cmd.call;uninstall_cmd(myid); ret})

    Thread.critical = crit_bup

    tk_call_without_enc("after",ms,cmdid)  # return id
#    return
#    if false #defined? Thread
#      Thread.start do
#       ms = Float(ms)/1000
#       ms = 10 if ms == 0
#       sleep ms/1000
#       cmd.call
#      end
#    else
#      cmdid = install_cmd(cmd)
#      tk_call("after",ms,cmdid)
#    end
  end

  def after_idle(cmd=Proc.new)
    crit_bup = Thread.critical
    Thread.critical = true

    myid = _curr_cmd_id
    cmdid = install_cmd(proc{ret = cmd.call;uninstall_cmd(myid); ret})

    Thread.critical = crit_bup

    tk_call_without_enc('after','idle',cmdid)
  end

  def after_cancel(afterId)
    tk_call_without_enc('after','cancel',afterId)
  end

  def windowingsystem
    tk_call_without_enc('tk', 'windowingsystem')
  end

  def scaling(scale=nil)
    if scale
      tk_call_without_enc('tk', 'scaling', scale)
    else
      Float(number(tk_call_without_enc('tk', 'scaling')))
    end
  end
  def scaling_displayof(win, scale=nil)
    if scale
      tk_call_without_enc('tk', 'scaling', '-displayof', win, scale)
    else
      Float(number(tk_call_without_enc('tk', '-displayof', win, 'scaling')))
    end
  end

  def inactive
    Integer(tk_call_without_enc('tk', 'inactive'))
  end
  def inactive_displayof(win)
    Integer(tk_call_without_enc('tk', 'inactive', '-displayof', win))
  end
  def reset_inactive
    tk_call_without_enc('tk', 'inactive', 'reset')
  end
  def reset_inactive_displayof(win)
    tk_call_without_enc('tk', 'inactive', '-displayof', win, 'reset')
  end

  def appname(name=None)
    tk_call('tk', 'appname', name)
  end

  def appsend_deny
    tk_call('rename', 'send', '')
  end

  def appsend(interp, async, *args)
    if $SAFE >= 4
      fail SecurityError, "cannot send Tk commands at level 4"
    elsif $SAFE >= 1 && args.find{|obj| obj.tainted?}
      fail SecurityError, "cannot send tainted Tk commands at level #{$SAFE}"
    end
    if async != true && async != false && async != nil
      args.unshift(async)
      async = false
    end
    if async
      tk_call('send', '-async', '--', interp, *args)
    else
      tk_call('send', '--', interp, *args)
    end
  end

  def rb_appsend(interp, async, *args)
    if $SAFE >= 4
      fail SecurityError, "cannot send Ruby commands at level 4"
    elsif $SAFE >= 1 && args.find{|obj| obj.tainted?}
      fail SecurityError, "cannot send tainted Ruby commands at level #{$SAFE}"
    end
    if async != true && async != false && async != nil
      args.unshift(async)
      async = false
    end
    #args = args.collect!{|c| _get_eval_string(c).gsub(/[\[\]$"]/, '\\\\\&')}
    args = args.collect!{|c| _get_eval_string(c).gsub(/[\[\]$"\\]/, '\\\\\&')}
    # args.push(').to_s"')
    # appsend(interp, async, 'ruby "(', *args)
    args.push('}.call)"')
    appsend(interp, async, 'ruby "TkComm._get_eval_string(proc{', *args)
  end

  def appsend_displayof(interp, win, async, *args)
    if $SAFE >= 4
      fail SecurityError, "cannot send Tk commands at level 4"
    elsif $SAFE >= 1 && args.find{|obj| obj.tainted?}
      fail SecurityError, "cannot send tainted Tk commands at level #{$SAFE}"
    end
    win = '.' if win == nil
    if async != true && async != false && async != nil
      args.unshift(async)
      async = false
    end
    if async
      tk_call('send', '-async', '-displayof', win, '--', interp, *args)
    else
      tk_call('send', '-displayor', win, '--', interp, *args)
    end
  end

  def rb_appsend_displayof(interp, win, async, *args)
    if $SAFE >= 4
      fail SecurityError, "cannot send Ruby commands at level 4"
    elsif $SAFE >= 1 && args.find{|obj| obj.tainted?}
      fail SecurityError, "cannot send tainted Ruby commands at level #{$SAFE}"
    end
    win = '.' if win == nil
    if async != true && async != false && async != nil
      args.unshift(async)
      async = false
    end
    #args = args.collect!{|c| _get_eval_string(c).gsub(/[\[\]$"]/, '\\\\\&')}
    args = args.collect!{|c| _get_eval_string(c).gsub(/[\[\]$"\\]/, '\\\\\&')}
    # args.push(').to_s"')
    # appsend_displayof(interp, win, async, 'ruby "(', *args)
    args.push('}.call)"')
    appsend(interp, win, async, 'ruby "TkComm._get_eval_string(proc{', *args)
  end

  def info(*args)
    tk_call('info', *args)
  end

  def mainloop(check_root = true)
    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)
  end

  def do_one_event(flag = TclTkLib::EventFlag::ALL)
    TclTkLib.do_one_event(flag)
  end

  def set_eventloop_tick(timer_tick)
    TclTkLib.set_eventloop_tick(timer_tick)
  end

  def get_eventloop_tick()
    TclTkLib.get_eventloop_tick
  end

  def set_no_event_wait(wait)
    TclTkLib.set_no_even_wait(wait)
  end

  def get_no_event_wait()
    TclTkLib.get_no_eventloop_wait
  end

  def set_eventloop_weight(loop_max, no_event_tick)
    TclTkLib.set_eventloop_weight(loop_max, no_event_tick)
  end

  def get_eventloop_weight()
    TclTkLib.get_eventloop_weight
  end

  def restart(app_name = nil, keys = {})
    TkCore::INTERP.init_ip_internal

    tk_call('set', 'argv0', app_name) if app_name
    if keys.kind_of?(Hash)
      # tk_call('set', 'argc', keys.size * 2)
      tk_call('set', 'argv', hash_kv(keys).join(' '))
    end

    INTERP.restart
    nil
  end

  def event_generate(win, context, keys=nil)
    #win = win.path if win.kind_of?(TkObject)
    if context.kind_of?(TkEvent::Event)
      context.generate(win, ((keys)? keys: {}))
    elsif keys
      tk_call_without_enc('event', 'generate', win, 
                          "<#{tk_event_sequence(context)}>", 
                          *hash_kv(keys, true))
    else
      tk_call_without_enc('event', 'generate', win, 
                          "<#{tk_event_sequence(context)}>")
    end
    nil
  end

  def messageBox(keys)
    tk_call('tk_messageBox', *hash_kv(keys))
  end

  def getOpenFile(keys = nil)
    tk_call('tk_getOpenFile', *hash_kv(keys))
  end
  def getMultipleOpenFile(keys = nil)
    simplelist(tk_call('tk_getOpenFile', '-multiple', '1', *hash_kv(keys)))
  end

  def getSaveFile(keys = nil)
    tk_call('tk_getSaveFile', *hash_kv(keys))
  end
  def getMultipleSaveFile(keys = nil)
    simplelist(tk_call('tk_getSaveFile', '-multiple', '1', *hash_kv(keys)))
  end

  def chooseColor(keys = nil)
    tk_call('tk_chooseColor', *hash_kv(keys))
  end

  def chooseDirectory(keys = nil)
    tk_call('tk_chooseDirectory', *hash_kv(keys))
  end

  def _ip_eval_core(enc_mode, cmd_string)
    case enc_mode
    when nil
      res = INTERP._eval(cmd_string)
    when false
      res = INTERP._eval_without_enc(cmd_string)
    when true
      res = INTERP._eval_with_enc(cmd_string)
    end
    if  INTERP._return_value() != 0
      fail RuntimeError, res, error_at
    end
    return res
  end
  private :_ip_eval_core

  def ip_eval(cmd_string)
    _ip_eval_core(nil, cmd_string)
  end

  def ip_eval_without_enc(cmd_string)
    _ip_eval_core(false, cmd_string)
  end

  def ip_eval_with_enc(cmd_string)
    _ip_eval_core(true, cmd_string)
  end

  def _ip_invoke_core(enc_mode, *args)
    case enc_mode
    when false
      res = INTERP._invoke_without_enc(*args)
    when nil
      res = INTERP._invoke(*args)
    when true
      res = INTERP._invoke_with_enc(*args)
    end
    if  INTERP._return_value() != 0
      fail RuntimeError, res, error_at
    end
    return res
  end
  private :_ip_invoke_core

  def ip_invoke(*args)
    _ip_invoke_core(nil, *args)
  end

  def ip_invoke_without_enc(*args)
    _ip_invoke_core(false, *args)
  end

  def ip_invoke_with_enc(*args)
    _ip_invoke_core(true, *args)
  end

  def _tk_call_core(enc_mode, *args)
    ### puts args.inspect if $DEBUG
    #args.collect! {|x|ruby2tcl(x, enc_mode)}
    #args.compact!
    #args.flatten!
    args = _conv_args([], enc_mode, *args)
    puts 'invoke args => ' + args.inspect if $DEBUG
    ### print "=> ", args.join(" ").inspect, "\n" if $DEBUG
    begin
      # res = INTERP._invoke(*args).taint
      # res = INTERP._invoke(enc_mode, *args)
      res = _ip_invoke_core(enc_mode, *args)
      # >>>>>  _invoke returns a TAINTED string  <<<<<
    rescue NameError => err
      # err = $!
      begin
        args.unshift "unknown"
        #res = INTERP._invoke(*args).taint 
        #res = INTERP._invoke(enc_mode, *args) 
        res = _ip_invoke_core(enc_mode, *args) 
        # >>>>>  _invoke returns a TAINTED string  <<<<<
      rescue StandardError => err2
        fail err2 unless /^invalid command/ =~ err2.message
        fail err
      end
    end
    if  INTERP._return_value() != 0
      fail RuntimeError, res, error_at
    end
    ### print "==> ", res.inspect, "\n" if $DEBUG
    return res
  end
  private :_tk_call_core

  def tk_call(*args)
    _tk_call_core(nil, *args)
  end

  def tk_call_without_enc(*args)
    _tk_call_core(false, *args)
  end

  def tk_call_with_enc(*args)
    _tk_call_core(true, *args)
  end

  def _tk_call_to_list_core(depth, arg_enc, val_enc, *args)
    args = _conv_args([], arg_enc, *args)
    val = _tk_call_core(false, *args)
    if !depth.kind_of?(Integer) || depth == 0
      tk_split_simplelist(val, false, val_enc)
    else
      tk_split_list(val, depth, false, val_enc)
    end
  end
  #private :_tk_call_to_list_core

  def tk_call_to_list(*args)
    _tk_call_to_list_core(-1, nil, true, *args)
  end

  def tk_call_to_list_without_enc(*args)
    _tk_call_to_list_core(-1, false, false, *args)
  end

  def tk_call_to_list_with_enc(*args)
    _tk_call_to_list_core(-1, true, true, *args)
  end

  def tk_call_to_simplelist(*args)
    _tk_call_to_list_core(0, nil, true, *args)
  end

  def tk_call_to_simplelist_without_enc(*args)
    _tk_call_to_list_core(0, false, false, *args)
  end

  def tk_call_to_simplelist_with_enc(*args)
    _tk_call_to_list_core(0, true, true, *args)
  end
end


module Tk
  include TkCore
  extend Tk

  TCL_VERSION = INTERP._invoke_without_enc("info", "tclversion").freeze
  TCL_PATCHLEVEL = INTERP._invoke_without_enc("info", "patchlevel").freeze

  major, minor = TCL_VERSION.split('.')
  TCL_MAJOR_VERSION = major.to_i
  TCL_MINOR_VERSION = minor.to_i

  TK_VERSION  = INTERP._invoke_without_enc("set", "tk_version").freeze
  TK_PATCHLEVEL  = INTERP._invoke_without_enc("set", "tk_patchLevel").freeze

  major, minor = TK_VERSION.split('.')
  TK_MAJOR_VERSION = major.to_i
  TK_MINOR_VERSION = minor.to_i

  JAPANIZED_TK = (INTERP._invoke_without_enc("info", "commands", 
                                             "kanji") != "").freeze

  def Tk.const_missing(sym)
    case(sym)
    when :TCL_LIBRARY
      INTERP._invoke_without_enc('global', 'tcl_library')
      INTERP._invoke("set", "tcl_library").freeze

    when :TK_LIBRARY
      INTERP._invoke_without_enc('global', 'tk_library')
      INTERP._invoke("set", "tk_library").freeze

    when :LIBRARY
      INTERP._invoke("info", "library").freeze

    #when :PKG_PATH, :PACKAGE_PATH, :TCL_PACKAGE_PATH
    #  INTERP._invoke_without_enc('global', 'tcl_pkgPath')
    #  tk_split_simplelist(INTERP._invoke('set', 'tcl_pkgPath'))

    #when :LIB_PATH, :LIBRARY_PATH, :TCL_LIBRARY_PATH
    #  INTERP._invoke_without_enc('global', 'tcl_libPath')
    #  tk_split_simplelist(INTERP._invoke('set', 'tcl_libPath'))

    when :PLATFORM, :TCL_PLATFORM
      if $SAFE >= 4
        fail SecurityError, "can't get #{sym} when $SAFE >= 4"
      end
      INTERP._invoke_without_enc('global', 'tcl_platform')
      Hash[*tk_split_simplelist(INTERP._invoke_without_enc('array', 'get', 
                                                           'tcl_platform'))]

    when :ENV
      INTERP._invoke_without_enc('global', 'env')
      Hash[*tk_split_simplelist(INTERP._invoke('array', 'get', 'env'))]

    #when :AUTO_PATH   #<=== 
    #  tk_split_simplelist(INTERP._invoke('set', 'auto_path'))

    #when :AUTO_OLDPATH
    #  tk_split_simplelist(…