Maybe not, but here's one anyway :)

--Ala

package Tk::Radioentry;

use strict;

use vars qw/$VERSION/;
$VERSION = 0.01;

use base qw/Tk::Frame/;
use Tk::widgets qw(Frame Radiobutton Entry);

Construct Tk::Widget 'Radioentry';

sub ClassInit {
    my ($class, $mw) = @_;
    $class-> SUPER::ClassInit($mw);
}

sub Populate {
    my ($self, $args) = @_;

    $self-> SUPER::Populate();

    my $p  = $self-> parent;
    my $r  = $p-> Radiobutton;
    my $e  = $p-> Entry;

    $self-> ConfigSpecs(
	       DEFAULT       =>  [$e],
	       -text         =>  [$r, qw/text Text/, ''],
	       -command      =>  [$r, qw/command Command/, undef],
	       -indicatoron  =>  [$r, qw/indicatorOn IndicatorOn/, 1],
	       -selectcolor  =>  [$r, qw/selectColor SelectColor/, undef],
	       -selectimage  =>  [$r, qw/selectImage SelectImage/, undef],
	       -state        =>  [[$e,$r], qw/state State normal/],
	       -variable     =>  [$r, qw/variable Variable/, undef],
	       -textvariable =>  [$e, qw/textVariable TextVariable/, undef],
	       -value        =>  [$r, qw/value Value/, undef],
	       -anchor       =>  [[$r, $e], qw/anchor Anchor/, undef],
	       );

    $_-> pack(qw/-side left -in/, $self) for $r, $e;

    $self-> Advertise(entry       => $e);
    $self-> Advertise(radiobutton => $r);

    $self-> Delegates($_ => $r) for qw/deselect flash invoke select/;
    $self-> Delegates(DEFAULT => $e);
}

1;

-++**==--++**==--++**==--++**==--++**==--++**==--++**==
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the
message body of "unsubscribe ptk" to majordomo@lists.stanford.edu