...
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;
}
}
}
####
$callback, undef, undef, BINDPLUS_REF_BASE . $tcl_sub_ref_id++
##
##
sub { ... }
\&subname
$coderef
[sub { ... }]
[sub { ... }, @args]
[\&subname]
[\&subname, @args]
[$coderef]
[$coderef, @args]