Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # Class LabeledRadiobutton |
2 | ||
3 | package Tk::LabRadiobutton; | |
4 | ||
5 | use vars qw($VERSION); | |
6 | $VERSION = '3.009'; # $Id: //depot/Tk8/Tk/LabRadio.pm#9 $ | |
7 | ||
8 | require Tk::Frame; | |
9 | use base qw(Tk::Frame); | |
10 | ||
11 | Construct Tk::Widget 'LabRadiobutton'; | |
12 | ||
13 | ||
14 | # Although there is no fundamental reason why -radiobuttons | |
15 | # should be fixed at create time converting to METHOD form | |
16 | # is extra work an this can serve as an example of CreateArgs | |
17 | # checking. | |
18 | ||
19 | sub CreateArgs | |
20 | { | |
21 | my ($package,$parent,$args) = @_; | |
22 | $parent->BackTrace("Must specify -radiobuttons for $package") | |
23 | unless (defined $args->{'-radiobuttons'}); | |
24 | return $package->SUPER::CreateArgs($parent,$args); | |
25 | } | |
26 | ||
27 | sub Populate | |
28 | { | |
29 | require Tk::Radiobutton; | |
30 | ||
31 | my ($cw,$args) = @_; | |
32 | $cw->SUPER::Populate($args); | |
33 | ||
34 | # LabeledRadiobutton(s) constructor. | |
35 | # | |
36 | # Advertised subwidgets: the name(s) of your radiobutton(s). | |
37 | ||
38 | ||
39 | ||
40 | my (@widgets) = (); | |
41 | ||
42 | my $rl; | |
43 | foreach $rl (@{$args->{'-radiobuttons'}}) | |
44 | { | |
45 | my $r = $cw->Component( Radiobutton => $rl, | |
46 | -text => $rl, | |
47 | -value => $rl ); | |
48 | $r->pack(-side => 'left', -expand => 1, -fill => 'both'); | |
49 | push(@widgets,$r); | |
50 | $cw->{Configure}{-value} = $rl; | |
51 | } | |
52 | ||
53 | $cw->BackTrace('No buttons') unless (@widgets); | |
54 | ||
55 | $cw->ConfigSpecs('-variable' => [ \@widgets, undef, undef, \$cw->{Configure}{-value} ], | |
56 | '-radiobuttons' => [ 'PASSIVE', undef, undef, undef ], | |
57 | '-value' => [ 'PASSIVE', undef, undef, $cw->{Configure}{-value} ], | |
58 | 'DEFAULT' => [ \@widgets ] | |
59 | ); | |
60 | } | |
61 | ||
62 | ||
63 | 1; |