/usr/local/CPAN/Tk-Gauge/Tk/Labelled.pm

• package Tk::Labelled
  • Populate
  • Tk::Widget::Labelled
• EOF

$Tk::Labelled::VERSION = '0.2';

package Tk::Labelled;

use base  qw/ Tk::Frame /;
use Tk::widgets qw/ Label /;

Construct Tk::Widget '_Labelled';

sub Populate {

    my( $self, $args ) = @_;

    $self->SUPER::Populate( $args );
    my $widget = delete $args->{ -widget };
    die( '-widget option required.' ) unless $widget;
    my $labelled = $self->$widget->pack( -side => 'left' );
    $self->Advertise( 'labelled' => $labelled );
    $self->Delegates( 'DEFAULT' => $labelled );
    $self->ConfigSpecs( 'DEFAULT' => [ $labelled ] );

} # end Populate

sub Tk::Widget::Labelled {
    my( $pw, $widget, %args ) = @_;
    $args{ -labelPack } = [ -side => 'left' ] if not exists $args{ -labelPack };
    $pw->_Labelled( -widget => $widget, %args );
}

1;