File Coverage

blib/lib/Tk/FcyEntry.pm

Criterion	Covered	Total	%
statement	6	19	31.5
branch	0	4	0.0
condition			n/a
subroutine	2	4	50.0
pod			n/a
total	8	27	29.6

### $Source: FcyEntry.pm $ $Revision: 1.3 $
###
### Entry with bg color depending on state. POD after __END__

use strict;

package Tk::FcyEntry;

require Tk;
require Tk::Widget;
require Tk::Derived;
require Tk::Entry;

use vars qw(@ISA $VERSION);
@ISA = qw(Tk::Derived Tk::Entry);
$VERSION = substr q$Revision: 1.3 $, 10;

{
 local($^W)=0;  # suppress Entry overriden warning
 Construct Tk::Widget 'Entry';
}

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

    $w->ConfigSpecs(
	'-state',     => ['METHOD',  qw(state       State        normal) ],
	'-editcolor'  => ['PASSIVE', qw(editColor   EditColor),  Tk::WHITE()],
	'-background' => ['PASSIVE', qw(background  Background), Tk::NORMAL_BG()],
	'-foreground' => ['PASSIVE', qw(foreground  Foreground), Tk::BLACK()],
	'DEFAULT'     => ['SELF'],
	);
    $w;
};

sub state {
    my ($w) = shift;
    if (@_) {
        my $state = shift;
        if ($state eq 'normal') {
	    $w->Tk::Entry::configure(-background => $w->{Configure}{-editcolor});
	    $w->Tk::Entry::configure(-foreground => $w->{Configure}{-foreground});
        } else {
            $w->Tk::Entry::configure(-background => $w->{Configure}{-background});
	    $w->Tk::Entry::configure(-foreground => Tk::DISABLED());
        }
    	$w->Tk::Entry::configure(-state => $state);
    } else {
        $w->Tk::Entry::cget('-state');
    }
};

1;

__END__