Module: TkEvent

Included in:
TkComm, TkComm
Defined in:
lib/tk/event.rb,
lib/tk/event.rb

Overview

tk/event.rb - module for event

Defined Under Namespace

Classes: Event

Instance Method Summary collapse

Instance Method Details

#install_bind(cmd, *args) ⇒ Object 



485
486
487
 
# File 'lib/tk/event.rb', line 485

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

#install_bind_for_event_class(klass, cmd, *args) ⇒ Object 



404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
 
# File 'lib/tk/event.rb', line 404

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