File Coverage

blib/lib/Tk/FcyEntry.pm
Criterion Covered Total %
statement 9 11 81.8
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 13 15 86.6


line stmt bran cond sub pod time code
1             package Tk::FcyEntry;
2            
3 1     1   13867 use 5.008000;
  1         3  
4 1     1   3 use strict;
  1         1  
  1         20  
5 1     1   3 use warnings;
  1         3  
  1         19  
6            
7 1     1   273 use Tk;
  0            
  0            
8             use Tk::Widget;
9             use Tk::Derived;
10             use Tk::Entry;
11            
12             use base qw/ Tk::Derived Tk::Entry /;
13            
14             {
15             local($^W)=0; # suppress Entry overriden warning
16             Construct Tk::Widget 'Entry';
17             }
18            
19             our $VERSION = '1.8';
20            
21             =head1 NAME
22            
23             Tk::FcyEntry - Entry that reflects its state in the background color
24            
25             =head1 SYNOPSIS
26            
27             use Tk;
28             use Tk::FcyEntry; # replaces the standard Entry widget
29             ...
30             $fcye = $w->Entry( ... everything as usual ... );
31             ...
32            
33             =head1 DESCRIPTION
34            
35             This module is deprecated. Use L instead, it does the same thing.
36            
37             B is like a normal L widget except:
38            
39             =over 4
40            
41             =item *
42            
43             default background color is 'white'
44            
45             =item *
46            
47             if the state of the widget is disabled the background color is set
48             to be the same as the normal background and the foreground used is
49             the same as the disabledForeground of a button. (xxx: still not true,
50             values hardcoded)
51            
52             =back
53            
54             =cut
55            
56             sub Populate
57             {
58             my ($w,$args) = @_;
59            
60             $w->ConfigSpecs(
61             '-state', => ['METHOD', 'state', 'State', 'normal'],
62             '-editcolor' => ['PASSIVE', 'editColor', 'EditColor', Tk::WHITE()],
63             '-background' => ['PASSIVE', 'background', 'Background', Tk::NORMAL_BG()],
64             '-foreground' => ['PASSIVE', 'foreground*, *Foreground', Tk::BLACK()],
65             'DEFAULT' => ['SELF'],
66             );
67             $w;
68             };
69            
70             sub state {
71             my ($w) = shift;
72             if (@_) {
73             my $state = shift;
74             if ($state eq 'normal') {
75             $w->Tk::Entry::configure(-background => $w->{Configure}{-editcolor} || Tk::NORMAL_BG());
76             $w->Tk::Entry::configure(-foreground => $w->{Configure}{-foreground} || Tk::BLACK());
77             } else {
78             $w->Tk::Entry::configure(-background => $w->{Configure}{-background} );
79             $w->Tk::Entry::configure(-foreground => Tk::DISABLED());
80             }
81             $w->Tk::Entry::configure(-state => $state);
82             } else {
83             $w->Tk::Entry::cget('-state');
84             }
85             };
86            
87             =head1 BUGS
88            
89             background configuration honoured after next state change.
90            
91            
92             =head1 SEE ALSO
93            
94             L
95             L
96            
97             =head1 AUTHOR
98            
99             Written by Achim Bohnet >.
100             Maintained by Alexander Becker, Easb@cpan.orgE.
101            
102             =head1 COPYRIGHT AND LICENSE
103            
104             Copyright (C) 2016 by Alexander Becker,
105             Copyright (c) 1997-1998 Achim Bohnet.
106            
107             This library is free software; you can redistribute it and/or modify
108             it under the same terms as Perl itself, either Perl version 5.16.3 or,
109             at your option, any later version of Perl 5 you may have available.
110            
111            
112             =cut
113            
114            
115             1; # /Tk::FcyEntry