home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / LabRadio.pm < prev    next >
Encoding:
Perl POD Document  |  1997-08-10  |  1.5 KB  |  61 lines
  1. # Class LabeledRadiobutton
  2.  
  3. package Tk::LabRadiobutton;
  4. use Tk::Pretty;
  5. require Tk::Frame;
  6. @ISA = qw(Tk::Frame);
  7.  
  8. Construct Tk::Widget 'LabRadiobutton';
  9.  
  10.  
  11. # Although there is no fundamental reason why -radiobuttons
  12. # should be fixed at create time converting to METHOD form 
  13. # is extra work an this can serve as an example of CreateArgs
  14. # checking.
  15.  
  16. sub CreateArgs
  17. {
  18.  my ($package,$parent,$args) = @_;
  19.  $parent->BackTrace("Must specify -radiobuttons for $package") 
  20.     unless (defined $args->{'-radiobuttons'});
  21.  return $package->SUPER::CreateArgs($parent,$args);
  22. }
  23.  
  24. sub Populate
  25. {
  26.     require Tk::Radiobutton;
  27.  
  28.     my ($cw,$args) = @_;
  29.     $cw->SUPER::Populate($args);
  30.  
  31.     # LabeledRadiobutton(s) constructor.
  32.     #
  33.     # Advertised subwidgets:  the name(s) of your radiobutton(s).
  34.  
  35.  
  36.  
  37.     my (@widgets) = ();
  38.  
  39.     my $rl;
  40.     foreach $rl (@{$args->{'-radiobuttons'}}) 
  41.      {
  42.        my $r = $cw->Component( Radiobutton => $rl,
  43.                                -text     => $rl,
  44.                                -value    => $rl );
  45.        $r->pack(-side => 'left', -expand => 1, -fill => 'both');
  46.        push(@widgets,$r);
  47.        $cw->{Configure}{-value} = $rl;
  48.      }
  49.  
  50.     $cw->BackTrace("No buttons") unless (@widgets);
  51.  
  52.     $cw->ConfigSpecs('-variable'     => [ \@widgets, undef, undef, \$cw->{Configure}{-value} ],
  53.                      '-radiobuttons' => [ 'PASSIVE', undef, undef, undef ],
  54.                      '-value'        => [ 'PASSIVE', undef, undef, $cw->{Configure}{-value} ],
  55.                      'DEFAULT'       => [ \@widgets ]
  56.                     );
  57. } 
  58.  
  59.  
  60. 1;
  61.