tk.rb

ruby的源代码

  def appsend(interp, async, *args)
    if async
      tk_call('send', '-async', '--', interp, *args)
    else
      tk_call('send', '--', interp, *args)
    end
  end

  def rb_appsend(interp, async, *args)
    args = args.collect!{|c| _get_eval_string(c).gsub(/[][$"]/, '\\\\\&')}
    args.push(').to_s"')
    appsend(interp, async, 'ruby "(', *args)
  end

  def appsend_displayof(interp, win, async, *args)
    win = '.' if win == nil
    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)
    args = args.collect!{|c| _get_eval_string(c).gsub(/[][$"]/, '\\\\\&')}
    args.push(').to_s"')
    appsend_displayof(interp, win, async, 'ruby "(', *args)
  end

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

  def mainloop
    TclTkLib.mainloop
  end

  def restart
    TkCore::INTERP.restart
    TkComm::Tk_WINDOWS.clear
    nil
  end

  def event_generate(window, context, keys=nil)
    window = window.path if window.kind_of? TkObject
    if keys
      tk_call('event', 'generate', window, 
	      "<#{tk_event_sequence(context)}>", *hash_kv(keys))
    else
      tk_call('event', 'generate', window, "<#{tk_event_sequence(context)}>")
    end
  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 getSaveFile(keys = nil)
    tk_call 'tk_getSaveFile', *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 tk_call(*args)
    puts args.inspect if $DEBUG
    args.collect! {|x|ruby2tcl(x)}
    args.compact!
    args.flatten!
    print "=> ", args.join(" ").inspect, "\n" if $DEBUG
    begin
      res = INTERP._invoke(*args)
    rescue NameError
      err = $!
      begin
        args.unshift "unknown"
        res = INTERP._invoke(*args)
      rescue
	fail unless /^invalid command/ =~ $!
	fail err
      end
    end
    if  INTERP._return_value() != 0
      fail RuntimeError, res, error_at
    end
    print "==> ", res.inspect, "\n" if $DEBUG
    return res
  end
end

module TkPackage
  include TkCore
  extend TkPackage

  def add_path(path)
    Tk::AUTO_PATH.value = Tk::AUTO_PATH.to_a << path
  end

  def forget(package)
    tk_call('package', 'forget', package)
    nil
  end

  def names
    tk_split_simplelist(tk_call('package', 'names'))
  end

  def provide(package, version=nil)
    if version
      tk_call('package', 'provide', package, version)
      nil
    else
      tk_call('package', 'provide', package)
    end
  end

  def present(package, version=None)
    tk_call('package', 'present', package, version)
  end

  def present_exact(package, version)
    tk_call('package', 'present', '-exact', package, version)
  end

  def require(package, version=None)
    tk_call('package', 'require', package, version)
  end

  def require_exact(package, version)
    tk_call('package', 'require', '-exact', package, version)
  end

  def versions(package)
    tk_split_simplelist(tk_call('package', 'versions', package))
  end

  def vcompare(version1, version2)
    Integer(tk_call('package', 'vcompare', version1, version2))
  end

  def vsatisfies(version1, version2)
    bool(tk_call('package', 'vsatisfies', version1, version2))
  end
end

module Tk
  include TkCore
  extend Tk

  TCL_VERSION = INTERP._invoke("info", "tclversion")
  TK_VERSION  = INTERP._invoke("set", "tk_version")

  TCL_PATCHLEVEL = INTERP._invoke("info", "patchlevel")
  TK_PATCHLEVEL  = INTERP._invoke("set", "tk_patchLevel")

  TCL_LIBRARY = INTERP._invoke("set", "tcl_library")
  TK_LIBRARY  = INTERP._invoke("set", "tk_library")
  LIBRARY     = INTERP._invoke("info", "library")

  PLATFORM = Hash[*tk_split_simplelist(INTERP._eval('array get tcl_platform'))]

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

  def root
    TkRoot.new
  end

  def bell
    tk_call 'bell'
  end

  def Tk.focus(display=nil)
    if display == nil
      r = tk_call('focus')
    else
      r = tk_call('focus', '-displayof', display)
    end
    tk_tcl2ruby(r)
  end

  def Tk.focus_lastfor(win)
    tk_tcl2ruby(tk_call('focus', '-lastfor', win))
  end

  def Tk.strictMotif(bool=None)
    bool(tk_call('set', 'tk_strictMotif', bool))
  end

  def Tk.show_kinsoku(mode='both')
    begin
      if /^8\.*/ === TK_VERSION  && JAPANIZED_TK
        tk_split_simplelist(tk_call('kinsoku', 'show', mode))
      end
    rescue
    end
  end
  def Tk.add_kinsoku(chars, mode='both')
    begin
      if /^8\.*/ === TK_VERSION  && JAPANIZED_TK
        tk_split_simplelist(tk_call('kinsoku', 'add', mode, 
                                    *(chars.split(''))))
      else
        []
      end
    rescue
      []
    end
  end
  def Tk.delete_kinsoku(chars, mode='both')
    begin
      if /^8\.*/ === TK_VERSION  && JAPANIZED_TK
        tk_split_simplelist(tk_call('kinsoku', 'delete', mode, 
                            *(chars.split(''))))
      end
    rescue
    end
  end

  def Tk.toUTF8(str,encoding)
    INTERP._toUTF8(str,encoding)
  end
  
  def Tk.fromUTF8(str,encoding)
    INTERP._fromUTF8(str,encoding)
  end

  module Scrollable
    def xscrollcommand(cmd=Proc.new)
      configure_cmd 'xscrollcommand', cmd
    end
    def yscrollcommand(cmd=Proc.new)
      configure_cmd 'yscrollcommand', cmd
    end
    def xview(*index)
      v = tk_send('xview', *index)
      list(v) if index.size == 0
    end
    def yview(*index)
      v = tk_send('yview', *index)
      list(v) if index.size == 0
    end
    def xscrollbar(bar=nil)
      if bar
	@xscrollbar = bar
	@xscrollbar.orient 'horizontal'
	self.xscrollcommand {|arg| @xscrollbar.set(*arg)}
	@xscrollbar.command {|arg| self.xview(*arg)}
      end
      @xscrollbar
    end
    def yscrollbar(bar=nil)
      if bar
	@yscrollbar = bar
	@yscrollbar.orient 'vertical'
	self.yscrollcommand {|arg| @yscrollbar.set(*arg)}
	@yscrollbar.command {|arg| self.yview(*arg)}
      end
      @yscrollbar
    end
  end

  module Wm
    include TkComm
    def aspect(*args)
      w = tk_call('wm', 'aspect', path, *args)
      list(w) if args.length == 0
    end
    def client(name=None)
      tk_call 'wm', 'client', path, name
    end
    def colormapwindows(*args)
      list(tk_call('wm', 'colormapwindows', path, *args))
    end
    def wm_command(value=None)
      string(tk_call('wm', 'command', path, value))
    end
    def deiconify
      tk_call 'wm', 'deiconify', path
    end
    def focusmodel(*args)
      tk_call 'wm', 'focusmodel', path, *args
    end
    def frame
      tk_call('wm', 'frame', path)
    end
    def geometry(*args)
      tk_call('wm', 'geometry', path, *args)
    end
    def grid(*args)
      w = tk_call('wm', 'grid', path, *args)
      list(w) if args.size == 0
    end
    def group(*args)
      w = tk_call 'wm', 'group', path, *args
      window(w) if args.size == 0
    end
    def iconbitmap(*args)
      tk_call 'wm', 'iconbitmap', path, *args
    end
    def iconify
      tk_call 'wm', 'iconify', path
    end
    def iconmask(*args)
      tk_call 'wm', 'iconmask', path, *args
    end
    def iconname(*args)
      tk_call 'wm', 'iconname', path, *args
    end
    def iconposition(*args)
      w = tk_call('wm', 'iconposition', path, *args)
      list(w) if args.size == 0
    end
    def iconwindow(*args)
      w = tk_call('wm', 'iconwindow', path, *args)
      window(w) if args.size == 0
    end
    def maxsize(*args)
      w = tk_call('wm', 'maxsize', path, *args)
      list(w) if args.size == 0
    end
    def minsize(*args)
      w = tk_call('wm', 'minsize', path, *args)
      list(w) if args.size == 0
    end
    def overrideredirect(bool=None)
      if bool == None
	bool(tk_call('wm', 'overrideredirect', path))
      else
	tk_call 'wm', 'overrideredirect', path, bool
      end
    end
    def positionfrom(*args)
      tk_call 'wm', 'positionfrom', path, *args
    end
    def protocol(name=nil, cmd=nil)
      if cmd
	tk_call('wm', 'protocol', path, name, cmd)
      elsif name
	result = tk_call('wm', 'protocol', path, name)
	(result == "")? nil : tk_tcl2ruby(result)
      else
	tk_split_simplelist(tk_call('wm', 'protocol', path))
      end
    end
    def resizable(*args)
      w = tk_call('wm', 'resizable', path, *args)
      if args.length == 0
	list(w).collect{|e| bool(e)}
      end
    end
    def sizefrom(*args)
      tk_call('wm', 'sizefrom', path, *args)
    end
    def state(state=None)
      tk_call 'wm', 'state', path, state
    end
    def title(*args)
      tk_call 'wm', 'title', path, *args
    end
    def transient(*args)
      window(tk_call 'wm', 'transient', path, *args)
    end
    def withdraw
      tk_call 'wm', 'withdraw', path
    end
  end
end

###########################################
#  convert kanji string to/from utf-8
###########################################
if /^8\.[1-9]/ =~ Tk::TCL_VERSION && !Tk::JAPANIZED_TK
  class TclTkIp
    # from tkencoding.rb by [e-mail]
    alias __eval _eval
    alias __invoke _invoke
    private :__eval
    private :__invoke
    
    attr_accessor :encoding
    
    def _eval(cmd)
      if @encoding
	_fromUTF8(__eval(_toUTF8(cmd, @encoding)), @encoding)
      else
	__eval(cmd)
      end
    end
    
    def _invoke(*cmds)
      if @encoding
	cmds = cmds.collect{|cmd| _toUTF8(cmd, @encoding)}
	_fromUTF8(__invoke(*cmds), @encoding)
      else
	__invoke(*cmds)
	end
    end
  end

  module Tk
    def encoding=(name)
      INTERP.encoding = name
    end

    def encoding
      INTERP.encoding
    end

    def encoding_names
      tk_split_simplelist(tk_call('encoding', 'names'))
    end

    def encoding_system
      tk_call('encoding', 'system')
    end

    def encoding_system=(enc)
      tk_call('encoding', 'system', enc)
    end
  end

  # estimate encoding
  case $KCODE
  when /^e/i  # EUC
    Tk.encoding = 'euc-jp'
  when /^s/i  # SJIS
    Tk.encoding = 'shiftjis'
  when /^u/i  # UTF8
    Tk.encoding = 'utf-8'
  else        # NONE
    begin
      Tk.encoding = Tk.encoding_system
    rescue StandardError, NameError
      Tk.encoding = 'utf-8'
    end
  end

else
  # dummy methods
  module Tk
    def encoding=(name)
      nil
    end
    def encoding
      nil
    end
    def encoding_names
      nil
    end
    def encoding_system
      nil
    end
    def encoding_system=(enc)
      nil
    end
  end
end

module TkBindCore
  def bind(context, cmd=Proc.new, args=nil)
    Tk.bind(to_eval, context, cmd, args)
  end

  def bind_append(context, cmd=Proc.new, args=nil)
    Tk.bind_append(to_eval, context, cmd, args)
  end

  def bind_remove(context)
    Tk.bind_remove(to_eval, context)
  end

  def bindinfo(context=nil)
    Tk.bindinfo(to_eval, context)
  end
end

class TkBindTag
  include TkBindCore

  BTagID_TBL = {}
  Tk_BINDTAG_ID = ["btag00000"]

  def TkBindTag.id2obj(id)
    BTagID_TBL[id]? BTagID_TBL[id]: id
  end

  ALL = self.new
  ALL.instance_eval {
    @id = 'all'
    BTagID_TBL[@id] = self
  }

  def initialize(*args)
    @id = Tk_BINDTAG_ID[0]
    Tk_BINDTAG_ID[0] = Tk_BINDTAG_ID[0].succ
    BTagID_TBL[@id] = self
    bind(*args) if args != []
  end

  def to_eval
    @id
  end

  def inspect
    format "#<TkBindTag: %s>", @id
  end
end

class TkBindTagAll<TkBindTag
  def TkBindTagAll.new(*args)
    $stderr.puts "Warning: TkBindTagALL is obsolete. Use TkBindTag::ALL\n"

    TkBindTag::ALL.bind(*args) if args != []
    TkBindTag::ALL
  end
end

class TkVariable
  include Tk
  extend TkCore

  TkVar_CB_TBL = {}
  Tk_VARIABLE_ID = ["v00000"]

  INTERP._invoke("proc", "rb_var", "args", "ruby [format \"TkVariable.callback %%Q!%s!\" $args]")

  def TkVariable.callback(args)
    name1,name2,op = tk_split_list(args)
    if TkVar_CB_TBL[name1]
      _get_eval_string(TkVar_CB_TBL[name1].trace_callback(name2,op))
    else
      ''
    end
  end

  def initialize(val="")
    @id = Tk_VARIABLE_ID[0]
    Tk_VARIABLE_ID[0] = Tk_VARIABLE_ID[0].succ
    if val == []
      INTERP._eval(format('global %s; set %s(0) 0; unset %s(0)', 
			  @id, @id, @id))
    elsif val.kind_of?(Array)
      a = []
      val.each_with_index{|e,i| a.push(i); a.push(array2tk_list(e))}
      s = '"' + a.join(" ").gsub(/[][$"]/, '\\\\\&') + '"'
      INTERP._eval(format('global %s; array set %s %s', @id, @id, s))
    elsif  val.kind_of?(Hash)
      s = '"' + val.to_a.collect{|e| array2tk_list(e)}.join(" ")\
                   .gsub(/[][$"]/, '\\\\\&') + '"'
      INTERP._eval(format('global %s; array set %s %s', @id, @id, s))
    else
      s = '"' + _get_eval_string(val).gsub(/[][$"]/, '\\\\\&') + '"'
      INTERP._eval(format('global %s; set %s %s', @id, @id, s))
    end
  end

  def wait
    INTERP._eval("tkwait variable #{@id}")
  end

  def id
    @id
  end

  def value
    begin
      INTERP._eval(format('global %s; set %s', @id, @id))
    rescue
      if INTERP._eval(format('global %s; array exists %s', @id, @id)) != "1"
	fail
      else
	Hash[*tk_split_simplelist(INTERP._eval(format('global %s; array get %s', 
						      @id, @id)))]
      end
    end
  end