view release on metacpan or  search on metacpan

Tk/TabbedForm.pm  view on Meta::CPAN

package Tk::TabbedForm;

use Tk;
use Tk::TabFrame;
use Tk::Frame;

use base qw (Tk::Derived Tk::Frame);
use vars qw ($VERSION);
use strict;
use Carp;

$VERSION = '0.01';

Tk::Widget->Construct ('TabbedForm');

*tabfont = \&Tk::TabbedForm::TabFont;
*Field = \&Tk::TabbedForm::Item;
*field = \&Tk::TabbedForm::Item;
*item = \&Tk::TabbedForm::Item;
*file = \&Tk::TabbedForm::File;

sub Populate
   {
    my $this = shift;

    my $l_TabWidget = $this->{m_TabWidget} = $this->Component
       (
        'TabFrame' => 'TabFrame',
       );

    $this->ConfigSpecs
       (
        '-TabFont' => ['METHOD', 'tabfont', 'TabFont', '-adobe-times-medium-r-normal--16-*-*-*-*-*-*-*'],
       );

    $l_TabWidget->pack
       (
        '-fill' => 'both',
        '-expand' => 'true',
       );

    return $this->SUPER::Populate (@_);
   }

sub Item
   {
    my ($this, $p_WidgetClass, @p_Parameters) = @_;

    my %l_Hash = @p_Parameters;

    my $l_SectionName = delete $l_Hash {'-section'} || 'Undefined';
    my $l_SectionFrame = $this->SectionFrame ($l_SectionName);
    my $l_Expression = delete $l_Hash {'-rule'} || delete $l_Hash {'-expression'};
    my $l_ItemName = delete $l_Hash {'-name'} || 'Undefined_'.++$Tk::TabbedForm::g_Undefined;
    my $l_Set = delete $l_Hash {'-set'} || sub {$_[0]->delete ('0', 'end'); $_[0]->insert ('0', $_[1]);};
    my $l_Get = delete $l_Hash {'-get'} || sub {$_[0]->get();};
    my $l_Default = delete $l_Hash {'-default'};

    my $l_Label = $l_SectionFrame->Label
       (
        '-text' => $l_ItemName,
       );

    my $l_Widget = $l_SectionFrame->$p_WidgetClass
       (
        %l_Hash,
       );