Hi, attached are the test for new convenience sub, and also small code to play with, it is really simple.
So the proposed convenience sub becomes this way:
=comment
An interpreter method, export_to_tcl, takes a hash as arguments, which
represents named parameters, with following allowed values:
namespace => '...', - tcl namespace, where commands and variables are to
be created, defaults to 'perl'. If '' is specified - then global
namespace is used. A possible '::' at end is stripped.
subs => { ... }, - anonymous hash of subs to be created in Tcl, in the
form /tcl name/ => /code ref/
vars => { ... }, - anonymous hash of vars to be created in Tcl, in the
form /tcl name/ => /code ref/
subs_from => '...', - a name of Perl namespace, from where all existing
subroutines will be searched and Tcl command will be created for each
of them.
vars_from => '...', - a name of Perl namespace, from where all existing
variables will be searched, and each such variable will be tied to Tcl.
An example:
use strict;
use Tcl;
my $int = new Tcl;
$tcl::foo = 'qwerty';
$int->export_to_tcl(subs_from=>'tcl',vars_from=>'tcl');
$int->Eval(<<'EOS');
package require Tk
button .b1 -text {a fluffy button} -command perl::fluffy_sub
button .b2 -text {a foo button} -command perl::foo
entry .e -textvariable perl::foo
pack .b1 .b2 .e
focus .b2
tkwait window .
EOS
sub tcl::fluffy_sub {
print "Hi, I am a fluffy sub\n";
}
sub tcl::foo {
print "Hi, I am foo\n";
$tcl::foo++;
}
=cut
sub export_to_tcl {
my $int = shift;
my %args = @_;
# name of Tcl package to hold tcl commands bound to perl subroutines
my $tcl_namespace = (exists $args{namespace} ? $args{namespace} : 'perl::');
$tcl_namespace=~s/(?:::)?$/::/;
# a batch of perl subroutines which tcl counterparts should be created
my $subs = $args{subs} || {};
# a batch of perl variables which tcl counterparts should be created
my $vars = $args{vars} || {};
# TBD:
# only => \@list_of_names
# argument to be able to limit the names to export to Tcl.
if (exists $args{subs_from}) {
# name of Perl package, which subroutines would be bound to tcl commands
my $subs_from = $args{subs_from};
$subs_from =~ s/::$//;
for my $name (keys %{"$subs_from\::"}) {
#print STDERR "$name;\n";
if (defined &{"$subs_from\::$name"}) {
if (exists $subs->{$name}) {
next;
}
#print STDERR "binding sub '$name'\n";
$int->CreateCommand("$tcl_namespace$name",
\&{"$subs_from\::$name"}, undef, undef, 1);
}
}
}
if (exists $args{vars_from}) {
# name of Perl package, which subroutines would be bound to tcl commands
my $vars_from = $args{vars_from};
$vars_from =~ s/::$//;
for my $name (keys %{"$vars_from\::"}) {
#print STDERR "$name;\n";
if (defined ${"$vars_from\::$name"}) {
if (exists $vars->{$name}) {
next;
}
#print STDERR "binding var '$name' in '$tcl_namespace'\n";
local $_ = ${"$vars_from\::$name"};
tie ${"$vars_from\::$name"}, 'Tcl::Var', $int,
"$tcl_namespace$name";
${"$vars_from\::$name"} = $_;
}
if (0) {
# array, hash - no need to do anything.
# (or should we?)
}
}
}
for my $subname (keys %$subs) {
#print STDERR "binding2 sub '$subname'\n";
$int->CreateCommand("$tcl_namespace$subname",$subs->{$subname}, undef,
undef, 1);
}
for my $varname (keys %$vars) {
#print STDERR "binding2 var '$varname'\n";
unless (ref($vars->{$varname})) {
require 'Carp.pm';
Carp::croak("should pass var ref as variable bind parameter");
}
local $_ = ${$vars->{$varname}};
tie ${$vars->{$varname}}, 'Tcl::Var', $int, "$tcl_namespace$varname";
${$vars->{$varname}} = $_;
}
}
# extra convenience sub, binds to tcl all subs and vars from perl tcl::
namespace
sub export_tcl_namespace {
my $int = shift;
$int->export_to_tcl(subs_from=>'tcl', vars_from=>'tcl');
}
I think this is good for inclusion.
I will change =comment/=cut to proper POD explanations afterwards.
Regards,
Vadim.
> -----Original Message-----
> From: Gisle Aas [mailto:gi...@activestate.com]
> Sent: Thursday, January 20, 2011 12:07 AM
> To: Konovalov, Vadim (Vadim)** CTR **
> Cc: Jeff Hobbs; tcltk@perl.org
> Subject: Re: bind some said tcl to perl - all at once
>
> On Jan 19, 2011, at 17:47 , Konovalov, Vadim (Vadim)** CTR ** wrote:
>
> > First, I did not liked the name bind_... either.
> > create_commands obviously better.
> > (or maybe create_tcl_commands?)
> >
> > However I think the idea could be extended to variables as
> well, how do
> > you think, is it possible to leave this name but add
> functionality to
> > variables also?
>
> Perhaps?
>
> $interp->export_to_tcl(
> namespace => "perl",
> subs => { ... },
> vars => { ... },
> subs_from => $ns,
> vars_from => $ns,
> );
>
> I think you should say it explicitly if you want to export
> vars from a namespace as well. You might for instance have
> some vars in that namespace that is shared between the perl
> subs without the intention to access it from Tcl.
>
> > And having default namespace to be 'perl' also seems
> reasonable to me.
>
> Fine with me as long as it's possible to pass "" or "::" to
> signal the root namespace.
>
> > Please see below the code I suggest, it is not finished,
> but all ideas are expressed.
> >
> > Opinions welcome.
> >
> > Best regards,
> > Vadim.
> >
> >
> > =comment
> > An interpreter method, bind_perl_to_tcl_commands, takes two optional
> > arguments - tcl package name (defaults to 'tcl') and perl
> package name
> > (defaults to 'tcl')
> >
> > Given a number of Perl sub's in said package, which is passed as the
> > second parameter, binds all of them into tcl, in the said
> package, which
> > is passed as the first parameter to the
> bind_perl_to_tcl_commands method.
> >
> > An example:
> >
> > use strict;
> > use Tcl;
> >
> > my $int = new Tcl;
> >
> > $tcl::foo = 'qwerty';
> > $int->create_tcl_commands(subs_from=>'tcl');
> >
> > $int->Eval(<<'EOS');
> >
> > package require Tk
> >
> > button .b1 -text {a fluffy button} -command perl::fluffy_sub
> > button .b2 -text {a foo button} -command perl::foo
> > entry .e -textvariable perl::foo
> > pack .b1 .b2 .e
> > focus .b2
> >
> > tkwait window .
> > EOS
> >
> > sub tcl::fluffy_sub {
> > print "Hi, I am a fluffy sub\n";
> > }
> > sub tcl::foo {
> > print "Hi, I am foo\n";
> > $tcl::foo++;
> > }
> > =cut
> >
> > sub create_tcl_commands {
> > my $int = shift;
> > my %args = @_;
> >
> > # name of Tcl package to hold tcl commands bound to perl
> subroutines
> > my $tcl_namespace = $args{namespace} || 'perl';
> >
> > # a batch of perl subroutines which tcl counterparts
> should be created
> > my $subs = $args{subs} || {};
> >
> > # name of Perl package, which subroutines would be bound
> to tcl commands
> > my $subs_from = $args{subs_from};
> >
> > if ($subs_from) {
> > for my $name (keys %{"$subs_from\::"}) {
> > print STDERR "$name;\n";
> > if (defined &{"$subs_from\::$name"}) {
> > if (exists $sub->{$name}) {
> > next;
> > }
> > # print STDERR "binding sub '$name'\n";
> >
> $int->CreateCommand("$tcl_namespace\::$name",\&{"$subs_from\::
> $name"});
>
> Call CreateCommand($tclname, \&sub, undef, undef, 1) to get
> avoid getting passed (undef, $int, $name) as the first 3
> arguments to the callback.
>
> > }
> > if (defined ${"$subs_from\::$name"}) {
> > # print STDERR "binding var '$name'\n";
> > local $_ = ${"$subs_from\::$name"};
> > tie ${"$subs_from\::$name"}, 'Tcl::Var', $int,
> "$tcl_namespace\::$name";
> > ${"$subs_from\::$name"} = $_;
> > }
> > {
> > # array, hash - no need to.
> > }
> > }
> > }
> >
> > for my $subname (keys %$subs) {
> >
> $int->CreateCommand("$tcl_namespace\::$subname",$subs{$subname});
> > }
> > }
>
> --Gisle
>
> >
> >
> >
> >> -----Original Message-----
> >> From: Gisle Aas [mailto:gi...@activestate.com]
> >> Sent: Tuesday, January 18, 2011 10:08 PM
> >> To: Konovalov, Vadim (Vadim)** CTR **
> >> Cc: Jeff Hobbs; tcltk@perl.org
> >> Subject: Re: bind some said tcl to perl - all at once
> >>
> >> I don't like to use the name 'bind_...' for this. To me it
> >> sounds like this would bind the namespace together so that
> >> subs created after the call also become visible to Tcl and
> >> perhaps even that commands created on the Tcl side become
> >> visible to Perl.
> >>
> >> My suggestion would be to make a convenience method like this one:
> >>
> >> $interp->create_commands(
> >> namespace => "perl",
> >> subs => {
> >> foo => sub { .... },
> >> bar => sub { .... },
> >> }
> >> );
> >>
> >> where the "namespace" argument is optional. It's the Tcl
> >> namespace where the commands will be created. If not provided
> >> the names will be registered in the root namespace. This
> >> would also always call the underlying $interp->CreateCommand
> >> with FLAGS=1 in order to suppress the confusing initial
> >> legacy arguments. The keys of the subs hash could also use
> >> "::ns::foo" style names in which case the namespace argument
> >> is ignored for that particular key.
> >>
> >> Your use case would then be covered by:
> >>
> >> $interp->create_commands(
> >> namespace => "perl",
> >> subs => \%{"tcl\::"},
> >> );
> >>
> >> which is a bit ugly to write so you might be able to provide
> >> some sugar like:
> >>
> >> $interp->create_commands(
> >> namespace => "perl",
> >> subs_from => "tcl",
> >> );
> >>
> >> if 'subs' and 'subs_from' are provided together they both
> >> contribute; with 'subs' taking preference in case there are
> >> conflicting names. Alternatively croak on conflicting names.
> >>
> >> I would also suggest a 'only => \@list_of_names' argument to
> >> be able to limit the names to export to Tcl.
> >>
> >> Regards,
> >> Gisle
> >>
> >>
> >>
> >> On Jan 18, 2011, at 17:20 , Konovalov, Vadim (Vadim)** CTR
> ** wrote:
> >>
> >>>> From: Jeff Hobbs [mailto:je...@activestate.com]
> >>>> On 15/01/2011 1:35 PM, Konovalov, Vadim (Vadim)** CTR ** wrote:
> >>>>> I wonder, is it reasonable for this approach to be
> >>>> "standartized" and included to, say, Tcl.pm module?
> >>>>>
> >>>>> For example - all Tcl names from some predefined Tcl
> >>>> namespace could be bound to perl subroutines all at once.
> >>>>
> >>>> I think it would be good to provide this as a standard
> convenience
> >>>> function, that would tie either a Perl or Tcl namespace to
> >> the other
> >>>> language. I don't think we'd want to pre-define the
> >> namespace (note
> >>>> that Tcl.pm already uses ::perl:: on the Tcl side), but
> >> let the user
> >>>> pick it with a single command invocation.
> >>>
> >>> Indeed, Tcl.pm uses ::perl:: in Tcl::call.
> >>>
> >>> All refs in this namespace have names like
> >> "SCALAR(0xXXXXXX)" or "CODE(0x######)", and it is very
> >> unlikely to have a collision. IOW, the collision could happen
> >> if a user have an intention to create a collision, but he/she
> >> could just create such a collision anyway, by creating
> >> conflicting names using another existing mechanisms.
> >>>
> >>> Ok, below is my suggestion to include to Tcl.pm,
> >>>
> >>>
> >>> =comment
> >>> An interpreter method, bind_perl_to_tcl_commands, takes
> two optional
> >>> arguments - tcl package name (defaults to 'tcl' and perl
> >> package name
> >>> (defaults to 'tcl')
> >>>
> >>> Given a number of Perl sub's in said package, which is
> passed as the
> >>> second parameter, binds all of them into tcl, in the said
> >> package, which
> >>> is passed as the first parameter to the
> >> bind_perl_to_tcl_commands method.
> >>>
> >>> An example:
> >>>
> >>> use Tcl;
> >>>
> >>> my $int = new Tcl;
> >>>
> >>> $int->bind_perl_to_tcl_commands;
> >>>
> >>> $int->Eval(<<'EOS');
> >>>
> >>> package require Tk
> >>>
> >>> button .b1 -text {a fluffy button} -command perl::fluffy_sub
> >>> button .b2 -text {a foo button} -command perl::foo
> >>> pack .b1 .b2
> >>>
> >>> tkwait window .
> >>> EOS
> >>>
> >>> sub tcl::fluffy_sub {
> >>> print "Hi, I am a fluffy sub\n";
> >>> }
> >>> sub tcl::foo {
> >>> print "Hi, I am foo\n";
> >>> }
> >>>
> >>> =cut
> >>>
> >>> sub bind_perl_to_tcl_commands {
> >>> my $int = shift;
> >>>
> >>> # name of Tcl package to hold tcl commands bound to perl
> >> subroutines
> >>> my $tcl_namespace = shift || 'perl';
> >>>
> >>> # name of Perl package, which subroutines would be bound
> >> to tcl commands
> >>> my $perl_namespace = shift || 'tcl';
> >>>
> >>> die "Shouldn't bind to main package"
> >>> if $perl_namespace eq "" || $perl_namespace eq "main";
> >>>
> >>> for my $subname (keys %{"$perl_namespace\::"}) {
> >>> # have no need to check if this is a sub name or a var
> >> name, as long
> >>> # as we're binding to CODE, \&{"..."}
> >>>
> >> $int->CreateCommand("$tcl_namespace\::$subname",\&{"$perl_name
> >> space\::$subname"});
> >>> }
> >>> }
> >>>
> >>>
> >>> Similar binding of variables could also be added.
> >>>
> >>> Best regards,
> >>> Vadim.
> >>
> >>
>
>
export_to_tcl.t
Description: export_to_tcl.t
p1.pl
Description: p1.pl
