view release on metacpan or  search on metacpan

lib/Tk/Panel.pm  view on Meta::CPAN

#! /usr/bin/env perl

package Tk::Panel;

use 5.014000;
use warnings;
use strict;

use vars qw(@ISA $VERSION);

use Tk;
use Carp;
require Tk::Widget;

our $VERSION = '1.5';

Construct Tk::Widget 'Panel';
use base qw(Tk::Derived Tk::Frame);

sub debug {};

# Class initialisation function.
# Called exactly once for each MainWindow widget tree, just
# before the first widget is created.
sub ClassInit
{
	debug "args: @_\n";
	# nothing.
}

# Constructor.  Uses new inherited from base class
sub Populate
{
	debug "args: @_\n";

	my $self = shift;

	$self->SUPER::Populate(@_);

	# Create 2 more frames, boundary with groove, and inside.
	$self->{boundary}	= $self->Component('Frame', 'boundary');
	$self->{inside}		= $self->Component('Frame', 'inside');
	# Create the title widgets.
	$self->{label}	= $self->Component('Label', 'label');

	$self->{check}	= $self->Component('Checkbutton', 'check',
			-variable	=> \$self->{Configure}->{'-show'},
			-command	=> [ 'refresh', $self ],
		);

	#debug "boundary: $self->{boundary}\n";
	#debug "inside: $self->{inside}\n";
	#debug "check: $self->{check}\n";
	#debug "label: $self->{label}\n";

	# Set up extra configuration
	$self->ConfigSpecs(
		'-relief'	=> [$self->{boundary},'relief','Relief','groove'],
		'-border'	=> [$self->{boundary},'borderwidth','BorderWidth', 3],
		'-background'	=> [['SELF','DESCENDANTS'],undef,undef, undef],
		'-foreground'	=> [['SELF','DESCENDANTS'],undef,undef, undef],

		'-margin'	=> ['PASSIVE','margin','Margin', 10],

		'-text'		=> [
				[$self->{check}, $self->{label}],
				'text','Text', ''],

		'-show'		=> ['PASSIVE','','', 1],

		'-flatheight'	=> ['PASSIVE','','', 'standard'],

		'-state'	=> [$self->{check},'','', 'active'],
		'-toggle'	=> ['PASSIVE','','', 1],

		'-fg'		=> '-foreground',
		'-bg'		=> '-background',
	);