package Tk::MyEntry;
use Tk::Entry;
@ISA = qw(Tk::Entry);
Construct Tk::Widget 'MyEntry';

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

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

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

	$cw->SUPER::Populate($args);
return;
#	my $b = $cw->Entry();
#	$b->pack(-expand => 1, -fill => 'both');
#	$cw->Advertise('MyEntry', => $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 $format;
	my $name;
	my $textvar = '';
	my $pTextVariable= \$textvar;;
	for(my $i = 0 ; $i < @args ; $i += 2) {
#print "new:arg$i: $args[$i] => $args[$i+1]\n";
		if($args[$i] eq '-text') {
#			$textvar = $args[$i+1];
			$$pTextVariable = $args[$i+1];
			next;
		}
		if($args[$i] eq '-textvariable') {
#			$textvar = ${$args[$i+1]};
			$pTextVariable = $args[$i+1];
			next;
		}
		if($args[$i] eq '-format') {
			$format = $args[$i+1];
			next;
		}
		if($args[$i] eq '-name') {
			$name = $args[$i+1];
			next;
		}
		push(@newargs, $args[$i]);
		push(@newargs, $args[$i+1]);
	}
	my $self = Tk::Entry->new(@newargs);
#	$self->{'textvariable'} = $textvar;
#	$self->configure( -textvariable => \($self->{'textvariable'}) );
	$self->{'ptextvariable'} = $pTextVariable;
	$self->{Format} = $format if(defined $format);
	$self->{Name}   = $name   if(defined $name);
	$self->configure( -textvariable => $pTextVariable );

	return bless $self, ref($class) || $class;
}

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

sub Update
{
	my ($this) = @_;
	$this->SetTitle();
}

sub SetTitle
{
	my ($this, $title) = @_;
	$title = ${$this->{'ptextvariable'}} if(!defined $title);
#print "v[$this->{Name}]: [$title] (f=$this->{Format}) => ";
	if($this->{Format}) {
		$title = Utils::DelSpace(sprintf($this->{Format}, $title));
	}
#print "[$title]\n";
#	return $this->{'textvariable'} = $title;
	return ${$this->{'ptextvariable'}} = $title;
}

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

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

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

1;