package Tk::MyCheckbutton;
require Tk::Checkbutton;
@ISA = qw(Tk::Checkbutton);
Construct Tk::Widget 'MyCheckbutton';

#公開したいサブルーチン
#@EXPORT = qw();

use strict;
#use base  qw(Tk::Widget);

sub Status { my ($this)=@_; return ${$this->{pVariable}}; } #shift->{status}; }
sub SetStatus { my ($this,$s)=@_; return shift->{status} = $s; }
sub Select {
	my ($this, $f) = @_;
	return $this->Deselect() if(!$f);
	$this->select();
	return ${$this->{pVariable}} = $this->{status} = 1;
}

sub Deselect {
	my ($this, $f) = @_;
	return $this->Select() if($f);
	$this->select();
	return ${$this->{pVariable}} = $this->{status} = 0;
}

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

	$cw->SUPER::Populate($args);
return;
#	my $b = $cw->Button();
#	$b->pack(-expand => 1, -fill => 'both');
#	$cw->Advertise('MyButton', => $b);
#	$cw->ConfigSpecs(DEFAULT => [$b]);
#	$cw->Delegates(DEFAULT => $b);
}

sub ClassInit
{
	my ($class, $mw) = @_;
	return $class;
}

sub new
{
	my $class = shift;
	my ($parent,@args) = @_;
#print "new: parent=$parent\n";

	my @newargs;
	push(@newargs, $_[0]);
	my $text = '';
	my $pTextVar = \$text;;
	my $pVar;
	for(my $i = 0 ; $i < @args ; $i += 2) {
#print "new:arg$i: $args[$i] => $args[$i+1]\n";
		if($args[$i] eq '-variable') {
			$pVar = $args[$i+1];
			next;
		}
		elsif($args[$i] eq '-text') {
			$text = $args[$i+1];
			next;
		}
		elsif($args[$i] eq '-textvariable') {
			$pTextVar = $args[$i+1];
			next;
		}
		push(@newargs, $args[$i]);
		push(@newargs, $args[$i+1]);
	}
	my $self = Tk::Checkbutton->new(@newargs);
	my $var = 0;
	$$pVar = '' if(!defined $pVar);
	$self->{pVariable}     = $pVar;
	$self->{pTextVariable} = $pTextVar;
	$self->configure( -textvariable => $self->{pTextVariable} ) if($self->{pTextVariable});
	$self->configure( -variable => $self->{pVariable});

	my $this = bless $self, ref($class) || $class;

	if(${$self->{pVariable}}) {
		$self->select();
	}
	else {
		$self->deselect();
	}
#	$this->SetTitle($$pTextVar);
	return $this;
}

sub DESTROY
{
	my $this = shift;
	$this->SUPER::DESTROY(@_);
}

sub SetTitle
{
	my ($this, $title) = @_;
	my $p = $this->{pTextVariable};
	return $$p unless(defined $title);
	my ($s1, $s2) = ($title =~ /^(.*?)&(.*)$/);
	if(defined $s1) {
		$this->configure(-underline => length($s1));
	}
	else {
		$this->configure(-underline => -1);
	}
	$title =~ s/&//g;
	return $$p = $title;
}

sub GetTitle
{
	my ($this) = @_;
	my $p = $this->{pTextVariable};
	return $$p;
}

sub SetText
{
	my ($this, $title) = @_;
	return $this->SetTitle($title);
}

sub GetText
{
	my ($this) = @_;
	return $this->GetTitle();
}

1;