package Tk::MyButton;
require Tk::Button;
@ISA = qw(Tk::Button);
Construct Tk::Widget 'MyButton';

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

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

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;;
	for(my $i = 0 ; $i < @args ; $i += 2) {
#print "new:arg$i: $args[$i] => $args[$i+1]\n";
		if($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::Button->new(@newargs);
#print "pt=$pTextVar,$$pTextVar\n";
	$self->{pTextVariable} = $pTextVar;
	$self->configure( -textvariable => $self->{pTextVariable} );

	my $this = bless $self, ref($class) || $class;
	$this->SetTitle($text);
	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;