... use 5.026; ... use constant { ... ERR_CALLBACK_NOT_CODEREF => 'Callback is not a coderef.', }; ... use Scalar::Util 'reftype'; ... use Tkx; ... { use constant BINDPLUS_REF_BASE => 'bindplus_ref_base_'; my ($tcl_interp, $tcl_sub_ref_id); BEGIN { $tcl_interp = Tkx::i::interp(); $tcl_sub_ref_id = 0; } sub bindplus { my ($tag, $seq, $callback) = @_; my $callback_ref = reftype $callback; if ($callback_ref eq 'CODE') { Tkx::bind($tag, $seq, '+' . $tcl_interp->create_tcl_sub( $callback, undef, undef, BINDPLUS_REF_BASE . $tcl_sub_ref_id++ )); } elsif ($callback_ref eq 'ARRAY') { if (reftype $callback->[0] eq 'CODE') { Tkx::bind($tag, $seq, '+' . $tcl_interp->create_tcl_sub( sub { $callback->[0]->($callback->@[1 .. $callback->$#*]) }, undef, undef, BINDPLUS_REF_BASE . $tcl_sub_ref_id++ )); } else { croak ERR_CALLBACK_NOT_CODEREF; } } else { croak ERR_CALLBACK_NOT_CODEREF; } } }