Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | package Tk::Submethods; |
2 | ||
3 | use vars qw($VERSION); | |
4 | $VERSION = '3.014'; # $Id: //depot/Tk8/Tk/Submethods.pm#14 $ | |
5 | ||
6 | sub import | |
7 | { | |
8 | my $class = shift; | |
9 | no strict 'refs'; | |
10 | my $package = caller(0); | |
11 | while (@_) | |
12 | { | |
13 | my $fn = shift; | |
14 | my $sm = shift; | |
15 | foreach my $sub (@{$sm}) | |
16 | { | |
17 | my ($suffix) = $sub =~ /(\w+)$/; | |
18 | my $pfn = $package.'::'.$fn; | |
19 | *{$pfn."\u$suffix"} = sub { shift->$pfn($sub,@_) }; | |
20 | } | |
21 | } | |
22 | } | |
23 | ||
24 | sub Direct | |
25 | { | |
26 | my $class = shift; | |
27 | no strict 'refs'; | |
28 | my $package = caller(0); | |
29 | while (@_) | |
30 | { | |
31 | my $fn = shift; | |
32 | my $sm = shift; | |
33 | my $sub; | |
34 | foreach $sub (@{$sm}) | |
35 | { | |
36 | # eval "sub ${package}::${sub} { shift->$fn('$sub',\@_) }"; | |
37 | *{$package.'::'.$sub} = sub { shift->$fn($sub,@_) }; | |
38 | } | |
39 | } | |
40 | } | |
41 | ||
42 | 1; | |
43 | ||
44 | __END__ | |
45 | ||
46 | =cut |