1 files changed, 63 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/lib/Tk/LabRadio.pm b/Master/tlpkg/tlperl0/lib/Tk/LabRadio.pm
new file mode 100755
index 00000000000..69e07b12f01
--- /dev/null
+++ b/Master/tlpkg/tlperl0/lib/Tk/LabRadio.pm
@@ -0,0 +1,63 @@
+# Class LabeledRadiobutton
+
+package Tk::LabRadiobutton;
+
+use vars qw($VERSION);
+$VERSION = '4.004'; # $Id: //depot/Tkutf8/Tk/LabRadio.pm#4 $
+
+require Tk::Frame;
+use base  qw(Tk::Frame);
+
+Construct Tk::Widget 'LabRadiobutton';
+
+
+# Although there is no fundamental reason why -radiobuttons
+# should be fixed at create time converting to METHOD form
+# is extra work an this can serve as an example of CreateArgs
+# checking.
+
+sub CreateArgs
+{
+ my ($package,$parent,$args) = @_;
+ $parent->BackTrace("Must specify -radiobuttons for $package")
+    unless (defined $args->{'-radiobuttons'});
+ return $package->SUPER::CreateArgs($parent,$args);
+}
+
+sub Populate
+{
+    require Tk::Radiobutton;
+
+    my ($cw,$args) = @_;
+    $cw->SUPER::Populate($args);
+
+    # LabeledRadiobutton(s) constructor.
+    #
+    # Advertised subwidgets:  the name(s) of your radiobutton(s).
+
+
+
+    my (@widgets) = ();
+
+    my $rl;
+    foreach $rl (@{$args->{'-radiobuttons'}})
+     {
+       my $r = $cw->Component( Radiobutton => $rl,
+                               -text     => $rl,
+                               -value    => $rl );
+       $r->pack(-side => 'left', -expand => 1, -fill => 'both');
+       push(@widgets,$r);
+       $cw->{Configure}{-value} = $rl;
+     }
+
+    $cw->BackTrace('No buttons') unless (@widgets);
+
+    $cw->ConfigSpecs('-variable'     => [ \@widgets, undef, undef, \$cw->{Configure}{-value} ],
+                     '-radiobuttons' => [ 'PASSIVE', undef, undef, undef ],
+                     '-value'        => [ 'PASSIVE', undef, undef, $cw->{Configure}{-value} ],
+                     'DEFAULT'       => [ \@widgets ]
+                    );
+}
+
+
+1;