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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
=head1 NAME
Tk::KeyEntry - perl/Tk Entry widget for entering single characters
=for pm Tk/KeyEntry.pm
=for category Derived Widgets
=head1 SYNOPSIS
use Tk::KeyEntry;
...
$ppe = $mw->KeyEntry(?options,...?);
=head1 DESCRIPTION
This "I<IS A>" entry widget with all bindings identical to the normal
entry widget. However, it only allows the entered string to be one
character long. Each keystroke replaces the contents of the widget
with the new key stroke. Only the first character of a clipboard
selection is inserted.
=head1 KEYS
widget, entry
=head1 SEE ALSO
L<Tk::Entry>
=cut
package Tk::KeyEntry;
use Tk::Entry;
use base qw(Tk::Entry);
Construct Tk::Widget 'KeyEntry';
sub Insert
{
my $w = shift;
my $s = shift;
return unless (defined $s && $s ne '');
$w -> delete(0, 'end');
$w->insert('insert',$s);
$w->SeeInsert
};
sub InsertSelection
{
my $w = shift;
eval {local $SIG{__DIE__};
$w -> delete(0, 'end');
$w->Insert(substr($w->SelectionGet,0,1))
}
};
sub ButtonRelease_2
{
my $w = shift;
my $Ev = $w->XEvent;
if (!$Tk::mouseMoved) {
eval
{local $SIG{__DIE__};
$w -> delete(0, 'end');
$w->insert('insert',substr($w->SelectionGet,0,1));
$w->SeeInsert;
}
}
}
1;
|
