diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/Submethods.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Tk/Submethods.pm | 45 |
1 files changed, 45 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/Submethods.pm b/Master/tlpkg/tlperl/lib/Tk/Submethods.pm new file mode 100755 index 00000000000..2741611172e --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Tk/Submethods.pm @@ -0,0 +1,45 @@ +package Tk::Submethods; + +use vars qw($VERSION); +$VERSION = '4.005'; # $Id: //depot/Tkutf8/Tk/Submethods.pm#4 $ + +sub import +{ + my $class = shift; + no strict 'refs'; + my $package = caller(0); + while (@_) + { + my $fn = shift; + my $sm = shift; + foreach my $sub (@{$sm}) + { + my ($suffix) = $sub =~ /(\w+)$/; + my $pfn = $package.'::'.$fn; + *{$pfn."\u$suffix"} = sub { shift->$pfn($sub,@_) }; + } + } +} + +sub Direct +{ + my $class = shift; + no strict 'refs'; + my $package = caller(0); + while (@_) + { + my $fn = shift; + my $sm = shift; + my $sub; + foreach $sub (@{$sm}) + { + # eval "sub ${package}::${sub} { shift->$fn('$sub',\@_) }"; + *{$package.'::'.$sub} = sub { shift->$fn($sub,@_) }; + } + } +} + +1; + +__END__ + |