ffi-tk 2009.11.29

data/lib/ffi-tk/core_extensions.rb

@@ -0,0 +1,154 @@
+module Tk
+  # Already converted statement, don't process again
+  class TclString < String
+    def to_tcl
+      self
+    end
+  end
+
+  # A lot of conversion helpers...
+
+  module CoreExtensions
+    module Array
+      def to_tcl
+        TclString.new('{' << map(&:to_tcl).compact.join(' ') << '}')
+      end
+
+      def tcl_options_to_hash(hints = {})
+        ::Hash[each_slice(2).map{|key, value|
+          key = key.sub(/^-/, '').to_sym
+
+          case hint = hints[key]
+          when :boolean
+            [key, Tk.boolean(value)]
+          when :symbol
+            [key, value.to_sym]
+          when :float
+            [key, Float(value)]
+          else
+            [key, value]
+          end
+        }]
+      end
+    end
+
+    module Hash
+      def to_tcl
+        pairs = map{|key, val| "#{key.to_tcl} #{val.to_tcl}" }
+        TclString.new(pairs.join(' '))
+      end
+
+      def to_tcl_options
+        pairs = map{|key, val| "#{key.to_tcl_option} #{val.to_tcl}" }
+        TclString.new(pairs.join(' '))
+      end
+      alias to_tcl_options? to_tcl_options
+    end
+
+    module Proc
+      def to_tcl
+        @id, @command = Tk.register_proc(self)
+        @command.to_tcl
+      end
+    end
+
+    module Regexp
+      def to_tcl
+        embed = []
+        embed << 'i' if options & ::Regexp::IGNORECASE != 0
+        embed << 'x' if options & ::Regexp::EXTENDED != 0
+        embed << 'n' if options & ::Regexp::MULTILINE != 0
+
+        if embed.empty?
+          pattern = source
+        else
+          pattern = "(?#{embed.join})#{source}"
+        end
+
+        TclString.new('{' << pattern.gsub(/([^\\])(?=[{}])/, '\1\\\\\2') << '}')
+      end
+    end
+
+    module String
+      def to_tcl
+        TclString.new('"' << gsub(/[\[\]$"\\]/, '\\\\\&') << '"')
+      end
+
+      def to_tcl_option
+        TclString.new(sub(/\A(?=[^-])/, '-'))
+      end
+    end
+
+    module Symbol
+      def to_tcl
+        TclString.new(to_s.dump)
+      end
+
+      def to_tcl_option
+        TclString.new(to_s.sub(/\A(?=[^-])/, '-'))
+      end
+    end
+
+    module Numeric
+      def to_tcl
+        TclString.new(to_s)
+      end
+    end
+
+    module Float
+      def tcl_to_ruby(option, hints)
+        self
+      end
+    end
+
+    module Fixnum
+      def tcl_to_ruby(option, hints)
+        name = option.sub(/^-/, '').to_sym
+
+        if type = hints[name]
+          case type
+          when :boolean
+            Tk.boolean(self)
+          else
+            self
+          end
+        end
+      end
+
+      def to_boolean
+        Tk.boolean(self)
+      end
+    end
+
+    module TrueClass
+      def to_tcl
+        TclString.new('1')
+      end
+    end
+
+    module FalseClass
+      def to_tcl
+        TclString.new('0')
+      end
+    end
+
+    module NilClass
+      def to_tcl
+        TclString.new('""')
+      end
+    end
+
+    constants.each do |const|
+      ext = const_get(const)
+      into = Module.const_get(const)
+
+      collisions = ext.instance_methods & into.instance_methods
+
+      if collisions.empty?
+        into.__send__(:include, ext)
+      else
+        warn "Won't include %p with %p, %p exists" % [into, ext, collisions] if $DEBBUG
+      end
+    end
+  end
+end

data/lib/ffi-tk/event/data.rb

@@ -0,0 +1,60 @@
+module Tk
+  module Event
+    Data = Struct.new(
+      :id, :sequence, :border_width, :button, :count, :detail, :focus, :height,
+      :keycode, :keysym, :keysym_number, :mode, :mousewheel_delta,
+      :override_redirect, :place, :property, :root, :send_event, :serial, :state,
+      :subwindow, :time, :type, :unicode, :width, :window, :window_path, :x,
+      :x_root, :y, :y_root
+    )
+
+    class Data
+      PROPERTIES = [
+        ['%#', :Integer, :serial            ],
+        ['%b', :Integer, :button            ],
+        ['%c', :Integer, :count             ],
+        ['%d', :String,  :detail            ],
+        ['%f', :String,  :focus             ],
+        ['%h', :Integer, :height            ],
+        ['%i', :String,  :window            ],
+        ['%k', :String,  :keycode           ],
+        ['%m', :String,  :mode              ],
+        ['%o', :String,  :override_redirect ],
+        ['%p', :String,  :place             ],
+        ['%s', :String,  :state             ],
+        ['%t', :String,  :time              ],
+        ['%w', :Integer, :width             ],
+        ['%x', :Integer, :x                 ],
+        ['%y', :Integer, :y                 ],
+        ['%A', :String,  :unicode           ],
+        ['%B', :Integer, :border_width      ],
+        ['%D', :String,  :mousewheel_delta  ],
+        ['%E', :String,  :send_event        ],
+        ['%K', :String,  :keysym            ],
+        ['%N', :String,  :keysym_number     ],
+        ['%P', :String,  :property          ],
+        ['%R', :Integer, :root              ],
+        ['%S', :Integer, :subwindow         ],
+        ['%T', :Integer, :type              ],
+        ['%W', :String,  :window_path       ],
+        ['%X', :Integer, :x_root            ],
+        ['%Y', :Integer, :y_root            ],
+      ]
+
+      def initialize(id, sequence, *properties)
+        super id, sequence
+
+        PROPERTIES.each do |code, conv, name|
+          property = properties.shift
+          next if property == '??'
+          converted = __send__(conv, property)
+          self[name] = converted
+        end
+      end
+
+      def call
+        Handler.invoke(id, self) if id
+      end
+    end
+  end
+end

data/lib/ffi-tk/event/handler.rb

@@ -0,0 +1,44 @@
+module Tk
+  module Event
+    module Handler
+      data = Data::PROPERTIES.transpose[0].join(' ').gsub(/%/, '%%')
+      @callback = %(bind %s %s { ::RubyFFI::event %d %s #{data} })
+      @store = []
+      @mutex = Mutex.new
+
+      module_function
+
+      def invoke(id, event)
+        return unless found = @store.at(id)
+        found.call(event)
+      end
+
+      def register_block(block)
+        id = nil
+
+        @mutex.synchronize{
+          @store << block
+          id = @store.size - 1
+        }
+
+        return id
+      end
+
+      def register(tag, sequence, &block)
+        id = register_block(block)
+        Tk.interp.eval(@callback % [tag, sequence, id, sequence])
+        id
+      end
+
+      def register_custom(block)
+        id = register_block(block)
+        yield id
+        id
+      end
+
+      def unregister(id)
+        @store[id] = nil
+      end
+    end
+  end
+end

data/lib/ffi-tk/ffi/tcl.rb

@@ -0,0 +1,92 @@
+require 'ffi-tk/ffi/tcl/obj'
+require 'ffi-tk/ffi/tcl/interp'
+require 'ffi-tk/ffi/tcl/cmd_proc'
+require 'ffi-tk/ffi/tcl/time'
+require 'ffi-tk/ffi/tcl/eval_result'
+
+module FFI
+  module Tcl
+    extend FFI::Library
+    ffi_lib 'libtcl8.5.so', 'tcl85.dll', *::Tk::LIBPATH[:tcl]
+
+    attach_function :Tcl_AppendAllObjTypes, [Interp, Obj], :int
+    attach_function :Tcl_CreateInterp, [], Interp
+    attach_function :Tcl_DeleteInterp, [Interp], :void
+    attach_function :Tcl_DoOneEvent, [flags = :int], :int
+    attach_function :Tcl_EvalEx, [Interp, script = :string, length = :int, flags = :int], :int
+    attach_function :Tcl_GetBoolean, [Interp, :string, :pointer], :int
+    attach_function :Tcl_GetBooleanFromObj, [Interp, Obj, boolean = :pointer], :int
+    attach_function :Tcl_GetDoubleFromObj, [Interp, Obj, :pointer], :int
+    attach_function :Tcl_GetIntFromObj, [Interp, Obj, int = :pointer], :int
+    attach_function :Tcl_GetObjResult, [Interp], Obj
+    attach_function :Tcl_GetObjType, [:string], ObjType
+    attach_function :Tcl_GetString, [Obj], :string
+    attach_function :Tcl_GetStringFromObj, [Obj, length = :pointer], :string
+    attach_function :Tcl_GetStringResult, [Interp], :string
+    attach_function :Tcl_GetUnicode, [Obj], :string
+    attach_function :Tcl_Init, [Interp], :int
+    attach_function :Tcl_ListObjGetElements, [Interp, Obj, count = :pointer, list = :pointer], :int
+    attach_function :Tcl_ListObjIndex, [Interp, list = :pointer, index = :int, result = :pointer], :int
+    attach_function :Tcl_ListObjLength, [Interp, list = :pointer, int = :pointer], :int
+    attach_function :Tcl_NewBooleanObj, [:int], Obj
+    attach_function :Tcl_NewIntObj, [:int], Obj
+    attach_function :Tcl_NewListObj, [count = :int, values = :pointer], Obj
+    attach_function :Tcl_NewStringObj, [:string, :int], Obj
+    attach_function :Tcl_ObjGetVar2, [Interp, :pointer, :pointer, :int], Obj
+    attach_function :Tcl_ObjSetVar2, [Interp, Obj, Obj, Obj, :int], Obj
+    attach_function :Tcl_ParseVar, [Interp, :pointer, :pointer], :pointer
+    attach_function :Tcl_SetObjResult, [Interp, Obj], :void
+    attach_function :Tcl_WaitForEvent, [TclTime], :int
+
+    callback :obj_cmd_proc, [:int, Interp, :int, :pointer], :int
+    callback :obj_delete_proc, [:int], :void
+    attach_function :Tcl_CreateObjCommand, [
+      Interp, name = :string, :obj_cmd_proc, :int, :obj_delete_proc], :pointer
+
+    module_function
+
+    ATTACHED_FUNCTIONS = {}
+    singleton_methods.grep(/^Tcl_/).each do |function|
+      ruby_name = function.to_s.
+        gsub(/([A-Z][a-z]+)/, '_\1').sub('_Tcl__', '').downcase
+      ATTACHED_FUNCTIONS[function] = ruby_name
+    end
+    BINDING = binding
+
+    def setup_eventloop_on_new_thread
+      puts "Run eventloop on new thread" if $DEBUG
+
+      code = <<-RUBY.strip
+def self.%s(*args, &block)
+  @thread_sender.thread_send{ %s(*args, &block) }
+end
+      RUBY
+
+      binding, file, line = BINDING, __FILE__, __LINE__ - 5
+      ATTACHED_FUNCTIONS.each do |function, ruby_name|
+        eval(code % [ruby_name, function], binding, file, line)
+      end
+
+      @thread_sender = ThreadSender.new
+      class << self; attr_reader :thread_sender; end
+      @thread_sender.thread_send{ Interp.new(create_interp) }
+    end
+
+    def setup_eventloop_on_main_thread
+      puts "Run eventloop on main thread" if $DEBUG
+
+      code = <<-'RUBY'.strip
+def self.%s(*args, &block)
+  %s(*args, &block)
+end
+      RUBY
+
+      binding, file, line = BINDING, __FILE__, __LINE__ - 5
+      ATTACHED_FUNCTIONS.each do |function, ruby_name|
+        eval(code % [ruby_name, function], binding, file, line)
+      end
+
+      Interp.new(create_interp)
+    end
+  end
+end

data/lib/ffi-tk/ffi/tcl/cmd_proc.rb

@@ -0,0 +1,10 @@
+module FFI
+  module Tcl
+    class CmdProc < PrettyStruct
+      layout :clientData, :int,
+             :interp,     Interp,
+             :argc,       :int,
+             :argv,       :pointer
+    end
+  end
+end

data/lib/ffi-tk/ffi/tcl/eval_result.rb

@@ -0,0 +1,148 @@
+module FFI
+  module Tcl
+    # This whole class feels very awkward, maybe it should be merged with Obj.
+    class EvalResult < ::Struct.new(:interp, :obj)
+      TYPES = {}
+
+      def self.reset_types(interp)
+        TYPES.clear
+        list = Tcl.new_list_obj(0, nil)
+        Tcl.append_all_obj_types(interp, list)
+
+        result_pointer = MemoryPointer.new(:pointer)
+        count_pointer  = MemoryPointer.new(:int)
+        length_pointer = MemoryPointer.new(:int)
+
+        Tcl.list_obj_length(interp, list, count_pointer)
+        count = count_pointer.get_int(0)
+
+        (0...count).each do |idx|
+          Tcl.list_obj_index(interp, list, idx, result_pointer)
+          element_pointer = result_pointer.get_pointer(0)
+          name = Tcl.get_string_from_obj(element_pointer, length_pointer)
+          type = Tcl.get_obj_type(name)
+          TYPES[type.to_i] = name.to_sym
+        end
+      end
+
+      def self.guess(interp, obj, fallback = nil)
+        obj = Obj.new(obj) unless obj.respond_to?(:type)
+        type = TYPES[obj.type.to_i]
+
+        case type
+        when :list
+          to_list(interp, obj)
+        when :string, :pixel, :cmdName
+          to_string(interp, obj)
+        when :int
+          to_int(interp, obj)
+        when :double
+          to_double(interp, obj)
+        else
+          if fallback
+            __send__(fallback, interp, obj)
+          else
+            raise "Unknown type: %p" % [type] if type
+            new(interp, obj)
+          end
+        end
+      end
+
+      def self.to_double(interp, obj)
+        double_pointer = MemoryPointer.new(:double)
+
+        if Tcl.get_double_from_obj(interp, obj, double_pointer) == 0
+          double_pointer.get_double(0)
+        else
+          raise "Couldn't get double from %p" % [obj]
+        end
+      end
+
+      def self.to_list(interp, obj)
+        map_list_core(interp, obj) do |pointer|
+          value = guess(interp, pointer, :to_string)
+          block_given? ? yield(value) : value
+        end
+      end
+
+      def self.map_list_core(interp, obj)
+        result_pointer = MemoryPointer.new(:pointer)
+        count_pointer  = MemoryPointer.new(:int)
+        length_pointer = MemoryPointer.new(:int)
+
+        Tcl.list_obj_length(interp, obj, count_pointer)
+        count = count_pointer.get_int(0)
+
+        (0...count).map do |idx|
+          Tcl.list_obj_index(interp, obj, idx, result_pointer)
+          yield result_pointer.get_pointer(0)
+        end
+      end
+
+      def self.to_boolean(interp, obj)
+        boolean_pointer = MemoryPointer.new(:int)
+        Tcl.get_boolean_from_obj(interp, obj, boolean_pointer)
+        boolean_pointer.get_int(0) == 1
+      end
+
+      def self.to_int(interp, obj)
+        int_pointer = MemoryPointer.new(:int)
+        Tcl.get_int_from_obj(interp, obj, int_pointer)
+        int_pointer.get_int(0)
+      end
+
+      def self.to_string(interp, obj)
+        length_pointer = MemoryPointer.new(:int)
+        string = Tcl.get_string_from_obj(obj, length_pointer)
+        string.force_encoding(Encoding.default_external)
+      end
+
+      def to_a(&block)
+        self.class.to_list(interp, obj, &block)
+      end
+
+      def to_a?(&block)
+        value = self.class.to_list(interp, obj, &block)
+        value.empty? ? nil : value
+      end
+
+      def to_sym
+        self.class.to_string(interp, obj).to_sym
+      end
+
+      def to_sym?
+        value = self.class.to_string(interp, obj).to_sym
+        value.empty? ? nil : value.to_sym
+      end
+
+      def to_i
+        self.class.to_int(interp, obj)
+      end
+
+      def to_f
+        self.class.to_double(interp, obj)
+      end
+
+      def to_s
+        self.class.to_string(interp, obj)
+      end
+
+      def to_s?
+        value = self.class.to_string(interp, obj)
+        value.empty? ? nil : value
+      end
+
+      def to_boolean
+        self.class.to_boolean(interp, obj)
+      end
+
+      def to_tcl
+        to_s.to_tcl
+      end
+
+      def inspect
+        "#<EvalResult #{to_s}>"
+      end
+    end
+  end
+end