1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
#!/usr/local/bin/perl -w
use Tk;
{
# This could/should go in Tk/LEntry.pm
package Tk::LEntry;
require Tk::Entry;
use base qw(Tk::Derived Tk::Entry);
Construct Tk::Widget 'LEntry';
sub Populate
{
my ($w,$args) = @_;
$w->ConfigSpecs(-maxwidth => ['PASSIVE','maxWidth','MaxWidth',12]);
}
sub insert
{
my ($w,@args) = @_;
# Do the insert as Entry does it.
$w->SUPER::insert(@args);
# Now see if that is 'legal' ...
my $max = $w->cget('-maxwidth');
if (length($w->get) > $max)
{
$w->delete($max,'end');
$w->bell;
}
}
}
my $mw = MainWindow->new;
my $e = $mw->LEntry(-maxwidth => 5, -width => 5);
$e->pack;
MainLoop;
__END__
|
