1#
2#  tk/event.rb - module for event
3#
4
5module TkEvent
6end
7
8########################
9
10require 'tkutil'
11require 'tk' unless Object.const_defined? :TkComm
12
13########################
14
15module TkEvent
16  class Event < TkUtil::CallbackSubst
17    module Grp
18      KEY         =           0x1
19      BUTTON      =           0x2
20      MOTION      =           0x4
21      CROSSING    =           0x8
22      FOCUS       =           0x10
23      EXPOSE      =           0x20
24      VISIBILITY  =           0x40
25      CREATE      =           0x80
26      DESTROY     =           0x100
27      UNMAP       =           0x200
28      MAP         =           0x400
29      REPARENT    =           0x800
30      CONFIG      =           0x1000
31      GRAVITY     =           0x2000
32      CIRC        =           0x4000
33      PROP        =           0x8000
34      COLORMAP    =           0x10000
35      VIRTUAL     =           0x20000
36      ACTIVATE    =           0x40000
37      MAPREQ      =           0x80000
38      CONFIGREQ   =           0x100000
39      RESIZEREQ   =           0x200000
40      CIRCREQ     =           0x400000
41
42      MWHEEL      =           KEY
43
44      STRING_DATA =           0x80000000  # special flag for 'data' field
45
46      ALL         =           0xFFFFFFFF
47
48      KEY_BUTTON_MOTION_VIRTUAL  = (KEY|MWHEEL|BUTTON|MOTION|VIRTUAL)
49      KEY_BUTTON_MOTION_CROSSING = (KEY|MWHEEL|BUTTON|MOTION|CROSSING|VIRTUAL)
50    end
51
52    type_data = [
53      #-----+-------------------+------------------+-----------------------#
54      #  ID |  const            |  group_flag      |  context_name         #
55      #-----+-------------------+------------------+-----------------------#
56      [  2,  :KeyPress,          Grp::KEY,         'KeyPress',    'Key'    ],
57      [  3,  :KeyRelease,        Grp::KEY,         'KeyRelease'            ],
58      [  4,  :ButtonPress,       Grp::BUTTON,      'ButtonPress', 'Button' ],
59      [  5,  :ButtonRelease,     Grp::BUTTON,      'ButtonRelease'         ],
60      [  6,  :MotionNotify,      Grp::MOTION,      'Motion'                ],
61      [  7,  :EnterNotify,       Grp::CROSSING,    'Enter'                 ],
62      [  8,  :LeaveNotify,       Grp::CROSSING,    'Leave'                 ],
63      [  9,  :FocusIn,           Grp::FOCUS,       'FocusIn'               ],
64      [ 10,  :FocusOut,          Grp::FOCUS,       'FocusOut'              ],
65      [ 11,  :KeymapNotify,      0,                                        ],
66      [ 12,  :Expose,            Grp::EXPOSE,      'Expose'                ],
67      [ 13,  :GraphicsExpose,    Grp::EXPOSE,                              ],
68      [ 14,  :NoExpose,          0,                                        ],
69      [ 15,  :VisibilityNotify,  Grp::VISIBILITY,  'Visibility'            ],
70      [ 16,  :CreateNotify,      Grp::CREATE,      'Create'                ],
71      [ 17,  :DestroyNotify,     Grp::DESTROY,     'Destroy'               ],
72      [ 18,  :UnmapNotify,       Grp::UNMAP,       'Unmap'                 ],
73      [ 19,  :MapNotify,         Grp::MAP,         'Map'                   ],
74      [ 20,  :MapRequest,        Grp::MAPREQ,      'MapRequest'            ],
75      [ 21,  :ReparentNotify,    Grp::REPARENT,    'Reparent'              ],
76      [ 22,  :ConfigureNotify,   Grp::CONFIG,      'Configure'             ],
77      [ 23,  :ConfigureRequest,  Grp::CONFIGREQ,   'ConfigureRequest'      ],
78      [ 24,  :GravityNotify,     Grp::GRAVITY,     'Gravity'               ],
79      [ 25,  :ResizeRequest,     Grp::RESIZEREQ,   'ResizeRequest'         ],
80      [ 26,  :CirculateNotify,   Grp::CIRC,        'Circulate'             ],
81      [ 27,  :CirculateRequest,  0,                'CirculateRequest'      ],
82      [ 28,  :PropertyNotify,    Grp::PROP,        'Property'              ],
83      [ 29,  :SelectionClear,    0,                                        ],
84      [ 30,  :SelectionRequest,  0,                                        ],
85      [ 31,  :SelectionNotify,   0,                                        ],
86      [ 32,  :ColormapNotify,    Grp::COLORMAP,    'Colormap'              ],
87      [ 33,  :ClientMessage,     0,                                        ],
88      [ 34,  :MappingNotify,     0,                                        ],
89      [ 35,  :VirtualEvent,      Grp::VIRTUAL,                             ],
90      [ 36,  :ActivateNotify,    Grp::ACTIVATE,    'Activate'              ],
91      [ 37,  :DeactivateNotify,  Grp::ACTIVATE,    'Deactivate'            ],
92      [ 38,  :MouseWheelEvent,   Grp::MWHEEL,      'MouseWheel'            ],
93      [ 39,  :TK_LASTEVENT,      0,                                        ]
94    ]
95
96    module TypeNum
97    end
98
99    TYPE_NAME_TBL  = Hash.new
100    TYPE_ID_TBL    = Hash.new
101    TYPE_GROUP_TBL = Hash.new
102
103    type_data.each{|id, c_name, g_flag, *t_names|
104      TypeNum.const_set(c_name, id)
105      t_names.each{|t_name| t_name.freeze; TYPE_NAME_TBL[t_name] = id }
106      TYPE_ID_TBL[id]    = t_names
107      TYPE_GROUP_TBL[id] = g_flag
108    }
109
110    TYPE_NAME_TBL.freeze
111    TYPE_ID_TBL.freeze
112
113    def self.type_id(name)
114      TYPE_NAME_TBL[name.to_s]
115    end
116
117    def self.type_name(id)
118      TYPE_ID_TBL[id] && TYPE_ID_TBL[id][0]
119    end
120
121    def self.group_flag(id)
122      TYPE_GROUP_TBL[id] || 0
123    end
124
125    #############################################
126
127    module StateMask
128      ShiftMask      =        (1<<0)
129      LockMask       =        (1<<1)
130      ControlMask    =        (1<<2)
131      Mod1Mask       =        (1<<3)
132      Mod2Mask       =        (1<<4)
133      Mod3Mask       =        (1<<5)
134      Mod4Mask       =        (1<<6)
135      Mod5Mask       =        (1<<7)
136      Button1Mask    =        (1<<8)
137      Button2Mask    =        (1<<9)
138      Button3Mask    =        (1<<10)
139      Button4Mask    =        (1<<11)
140      Button5Mask    =        (1<<12)
141
142      AnyModifier    =        (1<<15)
143
144      META_MASK      =  (AnyModifier<<1)
145      ALT_MASK       =  (AnyModifier<<2)
146      EXTENDED_MASK  =  (AnyModifier<<3)
147
148      CommandMask    =  Mod1Mask
149      OptionMask     =  Mod2Mask
150    end
151
152    #############################################
153
154    FIELD_FLAG = {
155      # key  =>  flag
156      'above'       => Grp::CONFIG,
157      'borderwidth' => (Grp::CREATE|Grp::CONFIG),
158      'button'      => Grp::BUTTON,
159      'count'       => Grp::EXPOSE,
160      'data'        => (Grp::VIRTUAL|Grp::STRING_DATA),
161      'delta'       => Grp::MWHEEL,
162      'detail'      => (Grp::FOCUS|Grp::CROSSING),
163      'focus'       => Grp::CROSSING,
164      'height'      => (Grp::EXPOSE|Grp::CONFIG),
165      'keycode'     => Grp::KEY,
166      'keysym'      => Grp::KEY,
167      'mode'        => (Grp::CROSSING|Grp::FOCUS),
168      'override'    => (Grp::CREATE|Grp::MAP|Grp::REPARENT|Grp::CONFIG),
169      'place'       => Grp::CIRC,
170      'root'        => (Grp::KEY_BUTTON_MOTION_VIRTUAL|Grp::CROSSING),
171      'rootx'       => (Grp::KEY_BUTTON_MOTION_VIRTUAL|Grp::CROSSING),
172      'rooty'       => (Grp::KEY_BUTTON_MOTION_VIRTUAL|Grp::CROSSING),
173      'sendevent'   => Grp::ALL,
174      'serial'      => Grp::ALL,
175      'state'       => (Grp::KEY_BUTTON_MOTION_VIRTUAL|
176                        Grp::CROSSING|Grp::VISIBILITY),
177      'subwindow'   => (Grp::KEY_BUTTON_MOTION_VIRTUAL|Grp::CROSSING),
178      'time'        => (Grp::KEY_BUTTON_MOTION_VIRTUAL|Grp::CROSSING|
179                        Grp::PROP),
180      'warp'        => Grp::KEY_BUTTON_MOTION_VIRTUAL,
181      'width'       => (Grp::EXPOSE|Grp::CREATE|Grp::CONFIG),
182      'window'      => (Grp::CREATE|Grp::UNMAP|Grp::MAP|Grp::REPARENT|
183                        Grp::CONFIG|Grp::GRAVITY|Grp::CIRC),
184      'when'        => Grp::ALL,
185      'x'           => (Grp::KEY_BUTTON_MOTION_VIRTUAL|Grp::CROSSING|
186                        Grp::EXPOSE|Grp::CREATE|Grp::CONFIG|Grp::GRAVITY|
187                        Grp::REPARENT),
188      'y'           => (Grp::KEY_BUTTON_MOTION_VIRTUAL|Grp::CROSSING|
189                        Grp::EXPOSE|Grp::CREATE|Grp::CONFIG|Grp::GRAVITY|
190                        Grp::REPARENT),
191    }
192
193    FIELD_OPERATION = {
194      'root' => proc{|val|
195        begin
196          Tk.tk_call_without_enc('winfo', 'pathname', val)
197          val
198        rescue
199          nil
200        end
201      },
202
203      'subwindow' => proc{|val|
204        begin
205          Tk.tk_call_without_enc('winfo', 'pathname', val)
206          val
207        rescue
208          nil
209        end
210      },
211
212      'window' => proc{|val| nil}
213    }
214
215    #-------------------------------------------
216
217    def valid_fields(group_flag=nil)
218      group_flag = self.class.group_flag(self.type) unless group_flag
219
220      fields = {}
221      FIELD_FLAG.each{|key, flag|
222        next if (flag & group_flag) == 0
223        begin
224          val = self.__send__(key)
225        rescue
226          next
227        end
228        # next if !val || val == '??'
229        next if !val || (val == '??' && (flag & Grp::STRING_DATA))
230        fields[key] = val
231      }
232
233      fields
234    end
235
236    def valid_for_generate(group_flag=nil)
237      fields = valid_fields(group_flag)
238
239      FIELD_OPERATION.each{|key, cmd|
240        next unless fields.has_key?(key)
241        val = FIELD_OPERATION[key].call(fields[key])
242        if val
243          fields[key] = val
244        else
245          fields.delete(key)
246        end
247      }
248
249      fields
250    end
251
252    def generate(win, modkeys={})
253      klass = self.class
254
255      if modkeys.has_key?(:type) || modkeys.has_key?('type')
256        modkeys = TkComm._symbolkey2str(modkeys)
257        type_id = modkeys.delete('type')
258      else
259        type_id = self.type
260      end
261
262      type_name  = klass.type_name(type_id)
263      unless type_name
264        fail RuntimeError, "type_id #{type_id} is invalid"
265      end
266
267      group_flag = klass.group_flag(type_id)
268
269      opts = valid_for_generate(group_flag)
270
271      modkeys.each{|key, val|
272        if val
273          opts[key.to_s] = val
274        else
275          opts.delete(key.to_s)
276        end
277      }
278
279      if group_flag != Grp::KEY
280        Tk.event_generate(win, type_name, opts)
281      else
282        # If type is KEY event, focus should be set to target widget.
283        # If not set, original widget will get the same event.
284        # That will make infinite loop.
285        w = Tk.tk_call_without_enc('focus')
286        begin
287          Tk.tk_call_without_enc('focus', win)
288          Tk.event_generate(win, type_name, opts)
289        ensure
290          Tk.tk_call_without_enc('focus', w)
291        end
292      end
293    end
294
295    #############################################
296
297    # [ <'%' subst-key char>, <proc type char>, <instance var (accessor) name>]
298    KEY_TBL = [
299      [ ?#, ?n, :serial ],
300      [ ?a, ?s, :above ],
301      [ ?b, ?n, :num ],
302      [ ?c, ?n, :count ],
303      [ ?d, ?s, :detail ],
304      # ?e
305      [ ?f, ?b, :focus ],
306      # ?g
307      [ ?h, ?n, :height ],
308      [ ?i, ?s, :win_hex ],
309      # ?j
310      [ ?k, ?n, :keycode ],
311      # ?l
312      [ ?m, ?s, :mode ],
313      # ?n
314      [ ?o, ?b, :override ],
315      [ ?p, ?s, :place ],
316      # ?q
317      # ?r
318      [ ?s, ?x, :state ],
319      [ ?t, ?n, :time ],
320      # ?u
321      [ ?v, ?n, :value_mask ],
322      [ ?w, ?n, :width ],
323      [ ?x, ?n, :x ],
324      [ ?y, ?n, :y ],
325      # ?z
326      [ ?A, ?s, :char ],
327      [ ?B, ?n, :borderwidth ],
328      # ?C
329      [ ?D, ?n, :wheel_delta ],
330      [ ?E, ?b, :send_event ],
331      # ?F
332      # ?G
333      # ?H
334      # ?I
335      # ?J
336      [ ?K, ?s, :keysym ],
337      # ?L
338      # ?M
339      [ ?N, ?n, :keysym_num ],
340      # ?O
341      [ ?P, ?s, :property ],
342      # ?Q
343      [ ?R, ?s, :rootwin_id ],
344      [ ?S, ?s, :subwindow ],
345      [ ?T, ?n, :type ],
346      # ?U
347      # ?V
348      [ ?W, ?w, :widget ],
349      [ ?X, ?n, :x_root ],
350      [ ?Y, ?n, :y_root ],
351      # ?Z
352      nil
353    ]
354
355    # [ <'%' subst-key str>, <proc type char>, <instance var (accessor) name>]
356    #   the subst-key string will be converted to a bytecode (128+idx).
357    LONGKEY_TBL = [
358      # for example, for %CTT and %CST subst-key on tkdnd-2.0
359      # ['CTT', ?l, :drop_target_type],
360      # ['CST', ?l, :drop_source_type],
361    ]
362
363    # [ <proc type char>, <proc/method to convert tcl-str to ruby-obj>]
364    PROC_TBL = [
365      [ ?n, TkComm.method(:num_or_str) ],
366      [ ?s, TkComm.method(:string) ],
367      [ ?b, TkComm.method(:bool) ],
368      [ ?w, TkComm.method(:window) ],
369
370      [ ?x, proc{|val|
371          begin
372            TkComm::number(val)
373          rescue ArgumentError
374            val
375          end
376        }
377      ],
378
379      nil
380    ]
381
382=begin
383    # for Ruby m17n :: ?x --> String --> char-code ( getbyte(0) )
384    KEY_TBL.map!{|inf|
385      if inf.kind_of?(Array)
386        inf[0] = inf[0].getbyte(0) if inf[0].kind_of?(String)
387        inf[1] = inf[1].getbyte(0) if inf[1].kind_of?(String)
388      end
389      inf
390    }
391
392    PROC_TBL.map!{|inf|
393      if inf.kind_of?(Array)
394        inf[0] = inf[0].getbyte(0) if inf[0].kind_of?(String)
395      end
396      inf
397    }
398=end
399
400    # setup tables to be used by scan_args, _get_subst_key, _get_all_subst_keys
401    #
402    #     _get_subst_key() and _get_all_subst_keys() generates key-string
403    #     which describe how to convert callback arguments to ruby objects.
404    #     When binding parameters are given, use _get_subst_key().
405    #     But when no parameters are given, use _get_all_subst_keys() to
406    #     create a Event class object as a callback parameter.
407    #
408    #     scan_args() is used when doing callback. It convert arguments
409    #     ( which are Tcl strings ) to ruby objects based on the key string
410    #     that is generated by _get_subst_key() or _get_all_subst_keys().
411    #
412    _setup_subst_table(KEY_TBL, PROC_TBL)
413    # _setup_subst_table(KEY_TBL, LONGKEY_TBL, PROC_TBL) # if use longname-keys
414
415    #
416    # NOTE: The order of parameters which passed to callback procedure is
417    #        <extra_arg>, <extra_arg>, ... , <subst_arg>, <subst_arg>, ...
418    #
419
420    # If you need support extra arguments given by Tcl/Tk,
421    # please override _get_extra_args_tbl
422    #
423    #def self._get_extra_args_tbl
424    #  # return an array of convert procs
425    #  []
426    #end
427
428=begin
429    alias button num
430    alias delta  wheel_delta
431    alias root   rootwin_id
432    alias rootx  x_root
433    alias root_x x_root
434    alias rooty  y_root
435    alias root_y y_root
436    alias sendevent send_event
437=end
438    ALIAS_TBL = {
439      :button    => :num,
440      :data      => :detail,
441      :delta     => :wheel_delta,
442      :root      => :rootwin_id,
443      :rootx     => :x_root,
444      :root_x    => :x_root,
445      :rooty     => :y_root,
446      :root_y    => :y_root,
447      :sendevent => :send_event,
448      :window    => :widget
449    }
450
451    _define_attribute_aliases(ALIAS_TBL)
452
453  end
454
455  ###############################################
456
457  def install_bind_for_event_class(klass, cmd, *args)
458    extra_args_tbl = klass._get_extra_args_tbl
459
460    if args.compact.size > 0
461      args.map!{|arg| klass._sym2subst(arg)}
462      args = args.join(' ')
463      keys = klass._get_subst_key(args)
464
465      if cmd.kind_of?(String)
466        id = cmd
467      elsif cmd.kind_of?(TkCallbackEntry)
468        id = install_cmd(cmd)
469      else
470        id = install_cmd(proc{|*arg|
471          ex_args = []
472          extra_args_tbl.reverse_each{|conv| ex_args << conv.call(arg.pop)}
473          begin
474            TkUtil.eval_cmd(cmd, *(ex_args.concat(klass.scan_args(keys, arg))))
475          rescue Exception=>e
476            if TkCore::INTERP.kind_of?(TclTkIp)
477              fail e
478            else
479              # MultiTkIp
480              fail Exception, "#{e.class}: #{e.message.dup}"
481            end
482          end
483        })
484      end
485    elsif cmd.respond_to?(:arity) && cmd.arity == 0  # args.size == 0
486      args = ''
487      if cmd.kind_of?(String)
488        id = cmd
489      elsif cmd.kind_of?(TkCallbackEntry)
490        id = install_cmd(cmd)
491      else
492        id = install_cmd(proc{
493                           begin
494                             TkUtil.eval_cmd(cmd)
495                           rescue Exception=>e
496                             if TkCore::INTERP.kind_of?(TclTkIp)
497                               fail e
498                             else
499                               # MultiTkIp
500                               fail Exception, "#{e.class}: #{e.message.dup}"
501                             end
502                           end
503                         })
504      end
505    else
506      keys, args = klass._get_all_subst_keys
507
508      if cmd.kind_of?(String)
509        id = cmd
510      elsif cmd.kind_of?(TkCallbackEntry)
511        id = install_cmd(cmd)
512      else
513        id = install_cmd(proc{|*arg|
514          ex_args = []
515          extra_args_tbl.reverse_each{|conv| ex_args << conv.call(arg.pop)}
516          begin
517            TkUtil.eval_cmd(cmd, *(ex_args << klass.new(*klass.scan_args(keys, arg))))
518          rescue Exception=>e
519            if TkCore::INTERP.kind_of?(TclTkIp)
520              fail e
521            else
522              # MultiTkIp
523              fail Exception, "#{e.class}: #{e.message.dup}"
524            end
525          end
526        })
527      end
528    end
529
530    if TkCore::INTERP.kind_of?(TclTkIp)
531      id + ' ' + args
532    else
533      # MultiTkIp
534      "if {[set st [catch {#{id} #{args}} ret]] != 0} {
535         if {$st == 4} {
536           return -code continue $ret
537         } elseif {$st == 3} {
538           return -code break $ret
539         } elseif {$st == 2} {
540           return -code return $ret
541         } elseif {[regexp {^Exception: (TkCallbackContinue: .*)$} \
542                                                               $ret m msg]} {
543           return -code continue $msg
544         } elseif {[regexp {^Exception: (TkCallbackBreak: .*)$} $ret m msg]} {
545           return -code break $msg
546         } elseif {[regexp {^Exception: (TkCallbackReturn: .*)$} $ret m msg]} {
547           return -code return $msg
548         } elseif {[regexp {^Exception: (\\S+: .*)$} $ret m msg]} {
549           return -code return $msg
550         } else {
551           return -code error $ret
552         }
553       } else {
554          set ret
555       }"
556    end
557  end
558
559  def install_bind(cmd, *args)
560    install_bind_for_event_class(TkEvent::Event, cmd, *args)
561  end
562end
563