path: root/ext/tk/lib/tk/event.rb

#
#  tk/event.rb - module for event
#

module TkEvent
end

########################

require 'tkutil'
require 'tk'

########################

module TkEvent
  class Event < TkUtil::CallbackSubst
    module Grp
      KEY         =           0x1
      BUTTON      =           0x2
      MOTION      =           0x4
      CROSSING    =           0x8
      FOCUS       =           0x10
      EXPOSE      =           0x20
      VISIBILITY  =           0x40
      CREATE      =           0x80
      DESTROY     =           0x100
      UNMAP       =           0x200
      MAP         =           0x400
      REPARENT    =           0x800
      CONFIG      =           0x1000
      GRAVITY     =           0x2000
      CIRC        =           0x4000
      PROP        =           0x8000
      COLORMAP    =           0x10000
      VIRTUAL     =           0x20000
      ACTIVATE    =           0x40000
      MAPREQ      =           0x80000
      CONFIGREQ   =           0x100000
      RESIZEREQ   =           0x200000
      CIRCREQ     =           0x400000

      MWHEEL      =           0x10000000

      ALL         =           0xFFFFFFFF

      KEY_BUTTON_MOTION_VIRTUAL  = (KEY|MWHEEL|BUTTON|MOTION|VIRTUAL)
      KEY_BUTTON_MOTION_CROSSING = (KEY|MWHEEL|BUTTON|MOTION|CROSSING|VIRTUAL)
    end

    type_data = [
      #-----+-------------------+------------------+-----------------------#
      #  ID |  const            |  group_flag      |  context_name         #
      #-----+-------------------+------------------+-----------------------#
      [  2,  :KeyPress,          Grp::KEY,         'KeyPress',    'Key'    ], 
      [  3,  :KeyRelease,        Grp::KEY,         'KeyRelease'            ], 
      [  4,  :ButtonPress,       Grp::BUTTON,      'ButtonPress', 'Button' ], 
      [  5,  :ButtonRelease,     Grp::BUTTON,      'ButtonRelease'         ], 
      [  6,  :MotionNotify,      Grp::MOTION,      'Motion'                ], 
      [  7,  :EnterNotify,       Grp::CROSSING,    'Enter'                 ], 
      [  8,  :LeaveNotify,       Grp::CROSSING,    'Leave'                 ], 
      [  9,  :FocusIn,           Grp::FOCUS,       'FocusIn'               ], 
      [ 10,  :FocusOut,          Grp::FOCUS,       'FocusOut'              ], 
      [ 11,  :KeymapNotify,      0,                                        ], 
      [ 12,  :Expose,            Grp::EXPOSE,      'Expose'                ], 
      [ 13,  :GraphicsExpose,    Grp::EXPOSE,                              ], 
      [ 14,  :NoExpose,          0,                                        ], 
      [ 15,  :VisibilityNotify,  Grp::VISIBILITY,  'Visibility'            ], 
      [ 16,  :CreateNotify,      Grp::CREATE,      'Create'                ], 
      [ 17,  :DestroyNotify,     Grp::DESTROY,     'Destroy'               ], 
      [ 18,  :UnmapNotify,       Grp::UNMAP,       'Unmap'                 ], 
      [ 19,  :MapNotify,         Grp::MAP,         'Map'                   ], 
      [ 20,  :MapRequest,        Grp::MAPREQ,      'MapRequest'            ], 
      [ 21,  :ReparentNotify,    Grp::REPARENT,    'Reparent'              ], 
      [ 22,  :ConfigureNotify,   Grp::CONFIG,      'Configure'             ], 
      [ 23,  :ConfigureRequest,  Grp::CONFIGREQ,   'ConfigureRequest'      ], 
      [ 24,  :GravityNotify,     Grp::GRAVITY,     'Gravity'               ], 
      [ 25,  :ResizeRequest,     Grp::RESIZEREQ,   'ResizeRequest'         ], 
      [ 26,  :CirculateNotify,   Grp::CIRC,        'Circulate'             ], 
      [ 27,  :CirculateRequest,  0,                'CirculateRequest'      ], 
      [ 28,  :PropertyNotify,    Grp::PROP,        'Property'              ], 
      [ 29,  :SelectionClear,    0,                                        ], 
      [ 30,  :SelectionRequest,  0,                                        ], 
      [ 31,  :SelectionNotify,   0,                                        ], 
      [ 32,  :ColormapNotify,    Grp::COLORMAP,    'Colormap'              ], 
      [ 33,  :ClientMessage,     0,                                        ], 
      [ 34,  :MappingNotify,     0,                                        ], 
      [ 35,  :VirtualEvent,      Grp::VIRTUAL,                             ],
      [ 36,  :ActivateNotify,    Grp::ACTIVATE,    'Activate'              ],
      [ 37,  :DeactivateNotify,  Grp::ACTIVATE,    'Deactivate'            ],
      [ 38,  :MouseWheelEvent,   Grp::MWHEEL,      'MouseWheel'            ],
      [ 39,  :TK_LASTEVENT,      0,                                        ]
    ]

    module TypeNum
    end

    TYPE_NAME_TBL  = Hash.new
    TYPE_ID_TBL    = Hash.new
    TYPE_GROUP_TBL = Hash.new

    type_data.each{|id, c_name, g_flag, *t_names|
      TypeNum.const_set(c_name, id)
      t_names.each{|t_name| t_name.freeze; TYPE_NAME_TBL[t_name] = id }
      TYPE_ID_TBL[id]    = t_names
      TYPE_GROUP_TBL[id] = g_flag
    }

    TYPE_NAME_TBL.freeze
    TYPE_ID_TBL.freeze

    def self.type_id(name)
      TYPE_NAME_TBL[name.to_s]
    end

    def self.type_name(id)
      TYPE_ID_TBL[id] && TYPE_ID_TBL[id][0]
    end

    def self.group_flag(id)
      TYPE_GROUP_TBL[id] || 0
    end

    #############################################

    module StateMask
      ShiftMask      =        (1<<0)
      LockMask       =        (1<<1)
      ControlMask    =        (1<<2)
      Mod1Mask       =        (1<<3)
      Mod2Mask       =        (1<<4)
      Mod3Mask       =        (1<<5)
      Mod4Mask       =        (1<<6)
      Mod5Mask       =        (1<<7)
      Button1Mask    =        (1<<8)
      Button2Mask    =        (1<<9)
      Button3Mask    =        (1<<10)
      Button4Mask    =        (1<<11)
      Button5Mask    =        (1<<12)

      AnyModifier    =        (1<<15)

      META_MASK      =  (AnyModifier<<1)
      ALT_MASK       =  (AnyModifier<<2)
      EXTENDED_MASK  =  (AnyModifier<<3)

      CommandMask    =  Mod1Mask
      OptionMask     =  Mod2Mask
    end

    #############################################

    FIELD_FLAG = {
      # key  =>  flag
      'above'       => Grp::CONFIG, 
      'borderwidth' => (Grp::CREATE|Grp::CONFIG),
      'button'      => Grp::BUTTON, 
      'count'       => Grp::EXPOSE, 
      'data'        => Grp::VIRTUAL, 
      'delta'       => Grp::MWHEEL, 
      'detail'      => (Grp::FOCUS|Grp::CROSSING),
      'focus'       => Grp::CROSSING,
      'height'      => (Grp::EXPOSE|Grp::CONFIG),
      'keycode'     => Grp::KEY,
      'keysym'      => Grp::KEY,
      'mode'        => (Grp::CROSSING|Grp::FOCUS),
      'override'    => (Grp::CREATE|Grp::MAP|Grp::REPARENT|Grp::CONFIG),
      'place'       => Grp::CIRC,
      'root'        => (Grp::KEY_BUTTON_MOTION_VIRTUAL|Grp::CROSSING),
      'rootx'       => (Grp::KEY_BUTTON_MOTION_VIRTUAL|Grp::CROSSING),
      'rooty'       => (Grp::KEY_BUTTON_MOTION_VIRTUAL|Grp::CROSSING),
      'sendevent'   => Grp::ALL,
      'serial'      => Grp::ALL,
      'state'       => (Grp::KEY_BUTTON_MOTION_VIRTUAL|
                        Grp::CROSSING|Grp::VISIBILITY),
      'subwindow'   => (Grp::KEY_BUTTON_MOTION_VIRTUAL|Grp::CROSSING),
      'time'        => (Grp::KEY_BUTTON_MOTION_VIRTUAL|Grp::CROSSING|
                        Grp::PROP),
      'warp'        => Grp::KEY_BUTTON_MOTION_VIRTUAL,
      'width'       => (Grp::EXPOSE|Grp::CREATE|Grp::CONFIG),
      'window'      => (Grp::CREATE|Grp::UNMAP|Grp::MAP|Grp::REPARENT|
                        Grp::CONFIG|Grp::GRAVITY|Grp::CIRC),
      'when'        => Grp::ALL,
      'x'           => (Grp::KEY_BUTTON_MOTION_VIRTUAL|Grp::CROSSING|
                        Grp::EXPOSE|Grp::CREATE|Grp::CONFIG|Grp::GRAVITY|
                        Grp::REPARENT),
      'y'           => (Grp::KEY_BUTTON_MOTION_VIRTUAL|Grp::CROSSING|
                        Grp::EXPOSE|Grp::CREATE|Grp::CONFIG|Grp::GRAVITY|
                        Grp::REPARENT),
    }

    FIELD_OPERATION = {
      'root' => proc{|val| 
        begin
          Tk.tk_call_without_enc('winfo', 'pathname', val)
          val
        rescue
          nil
        end
      }, 

      'subwindow' => proc{|val| 
        begin
          Tk.tk_call_without_enc('winfo', 'pathname', val)
          val
        rescue
          nil
        end
      }, 

      'window' => proc{|val| nil}
    }

    #-------------------------------------------

    def valid_fields(group_flag=nil)
      group_flag = self.class.group_flag(self.type) unless group_flag

      fields = {}
      FIELD_FLAG.each{|key, flag|
        next if (flag & group_flag) == 0
        begin
          val = self.__send__(key)
        rescue
          next
        end
        next if !val || val == '??'
        fields[key] = val
      }

      fields
    end

    def valid_for_generate(group_flag=nil)
      fields = valid_fields(group_flag)

      FIELD_OPERATION.each{|key, cmd|
        next unless fields.has_key?(key)
        val = FIELD_OPERATION[key].call(fields[key])
        if val
          fields[key] = val
        else
          fields.delete(key)
        end
      }

      fields
    end

    def generate(win, modkeys={})
      klass = self.class

      if modkeys.has_key?(:type) || modkeys.has_key?('type')
        modkeys = TkComm._symbolkey2str(modkeys)
        type_id = modkeys.delete('type')
      else
        type_id = self.type
      end

      type_name  = klass.type_name(type_id)
      unless type_name
        fail RuntimeError, "type_id #{type_id} is invalid"
      end

      group_flag = klass.group_flag(type_id)

      opts = valid_for_generate(group_flag)

      modkeys.each{|key, val|
        if val
          opts[key.to_s] = val
        else
          opts.delete(key.to_s)
        end
      }

      if group_flag != Grp::KEY
        Tk.event_generate(win, type_name, opts)
      else
        # If type is KEY event, focus should be set to target widget.
        # If not set, original widget will get the same event. 
        # That will make infinite loop.
        w = Tk.tk_call_without_enc('focus')
        begin
          Tk.tk_call_without_enc('focus', win)
          Tk.event_generate(win, type_name, opts)
        ensure
          Tk.tk_call_without_enc('focus', w)
        end
      end
    end

    #############################################

    # [ <'%' subst-key char>, <proc type char>, <instance var (accessor) name>]
    KEY_TBL = [
      [ ?#, ?n, :serial ], 
      [ ?a, ?s, :above ], 
      [ ?b, ?n, :num ], 
      [ ?c, ?n, :count ], 
      [ ?d, ?s, :detail ], 
      [ ?f, ?b, :focus ], 
      [ ?h, ?n, :height ], 
      [ ?i, ?s, :win_hex ], 
      [ ?k, ?n, :keycode ], 
      [ ?m, ?s, :mode ], 
      [ ?o, ?b, :override ], 
      [ ?p, ?s, :place ], 
      [ ?s, ?x, :state ], 
      [ ?t, ?n, :time ], 
      [ ?w, ?n, :width ], 
      [ ?x, ?n, :x ], 
      [ ?y, ?n, :y ], 
      [ ?A, ?s, :char ], 
      [ ?B, ?n, :borderwidth ], 
      [ ?D, ?n, :wheel_delta ], 
      [ ?E, ?b, :send_event ], 
      [ ?K, ?s, :keysym ], 
      [ ?N, ?n, :keysym_num ], 
      [ ?P, ?s, :property ], 
      [ ?R, ?s, :rootwin_id ], 
      [ ?S, ?s, :subwindow ], 
      [ ?T, ?n, :type ], 
      [ ?W, ?w, :widget ], 
      [ ?X, ?n, :x_root ], 
      [ ?Y, ?n, :y_root ], 
      nil
    ]

    # [ <proc type char>, <proc/method to convert tcl-str to ruby-obj>]
    PROC_TBL = [
      [ ?n, TkComm.method(:num_or_str) ], 
      [ ?s, TkComm.method(:string) ], 
      [ ?b, TkComm.method(:bool) ], 
      [ ?w, TkComm.method(:window) ], 

      [ ?x, proc{|val|
          begin
            TkComm::number(val)
          rescue ArgumentError
            val
          end
        }
      ], 

      nil
    ]

    # setup tables to be used by scan_args, _get_subst_key, _get_all_subst_keys
    #
    #     _get_subst_key() and _get_all_subst_keys() generates key-string 
    #     which describe how to convert callback arguments to ruby objects. 
    #     When binding parameters are given, use _get_subst_key(). 
    #     But when no parameters are given, use _get_all_subst_keys() to 
    #     create a Event class object as a callback parameter. 
    #
    #     scan_args() is used when doing callback. It convert arguments 
    #     ( which are Tcl strings ) to ruby objects based on the key string 
    #     that is generated by _get_subst_key() or _get_all_subst_keys(). 
    #
    _setup_subst_table(KEY_TBL, PROC_TBL);

    #
    # NOTE: The order of parameters which passed to callback procedure is 
    #        <extra_arg>, <extra_arg>, ... , <subst_arg>, <subst_arg>, ...
    #

    # If you need support extra arguments given by Tcl/Tk, 
    # please override _get_extra_args_tbl
    #
    #def self._get_extra_args_tbl
    #  # return an array of convert procs
    #  []
    #end

=begin
    alias button num
    alias delta  wheel_delta
    alias root   rootwin_id
    alias rootx  x_root
    alias root_x x_root
    alias rooty  y_root
    alias root_y y_root
    alias sendevent send_event
=end
    ALIAS_TBL = {
      :button    => :num, 
      :data      => :detail, 
      :delta     => :wheel_delta, 
      :root      => :rootwin_id, 
      :rootx     => :x_root, 
      :root_x    => :x_root, 
      :rooty     => :y_root, 
      :root_y    => :y_root, 
      :sendevent => :send_event, 
      :window    => :widget
    }

    _define_attribute_aliases(ALIAS_TBL)

  end

  ###############################################

  def install_bind_for_event_class(klass, cmd, *args)
    extra_args_tbl = klass._get_extra_args_tbl

    if args.compact.size > 0
      args = args.join(' ')
      keys = klass._get_subst_key(args)

      if cmd.kind_of?(String)
        id = cmd
      elsif cmd.kind_of?(TkCallbackEntry)
        id = install_cmd(cmd)
      else
        id = install_cmd(proc{|*arg|
          ex_args = []
          extra_args_tbl.reverse_each{|conv| ex_args << conv.call(arg.pop)}
          begin
            TkUtil.eval_cmd(cmd, *(ex_args.concat(klass.scan_args(keys, arg))))
          rescue Exception=>e
            if TkCore::INTERP.kind_of?(TclTkIp)
              fail e
            else
              # MultiTkIp
              fail Exception, "#{e.class}: #{e.message.dup}"
            end
          end
        })
      end
    else
      keys, args = klass._get_all_subst_keys

      if cmd.kind_of?(String)
        id = cmd
      elsif cmd.kind_of?(TkCallbackEntry)
        id = install_cmd(cmd)
      else
        id = install_cmd(proc{|*arg|
          ex_args = []
          extra_args_tbl.reverse_each{|conv| ex_args << conv.call(arg.pop)}
          begin
            TkUtil.eval_cmd(cmd, *(ex_args << klass.new(*klass.scan_args(keys, arg))))
          rescue Exception=>e
            if TkCore::INTERP.kind_of?(TclTkIp)
              fail e
            else
              # MultiTkIp
              fail Exception, "#{e.class}: #{e.message.dup}"
            end
          end
        })
      end
    end

    if TkCore::INTERP.kind_of?(TclTkIp)
      id + ' ' + args
    else
      # MultiTkIp
      "if {[set st [catch {#{id} #{args}} ret]] != 0} {
         if {$st == 4} {
           return -code continue $ret
         } elseif {$st == 3} {
           return -code break $ret
         } elseif {$st == 2} {
           return -code return $ret
         } elseif {[regexp {^Exception: (TkCallbackContinue: .*)$} \
                                                               $ret m msg]} {
           return -code continue $msg
         } elseif {[regexp {^Exception: (TkCallbackBreak: .*)$} $ret m msg]} {
           return -code break $msg
         } elseif {[regexp {^Exception: (TkCallbackReturn: .*)$} $ret m msg]} {
           return -code return $msg
         } elseif {[regexp {^Exception: (\\S+: .*)$} $ret m msg]} {
           return -code return $msg
         } else {
           return -code error $ret
         }
       } else {
          set ret
       }"
    end
  end

  def install_bind(cmd, *args)
    install_bind_for_event_class(TkEvent::Event, cmd, *args)
  end
end