/usr/lib/perl5/Tk/FloatEntry.pm is in perl-tk 1:804.031-1build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 | # Tranlation of FloatEnt.tcl in Tix4.1
# TODO/IDEA:
# o extract a widget (SimpleEntry?) without post/unpost methods
# and derive FloatEntry fron this widget.
package Tk::FloatEntry;
use strict;
BEGIN
{
use vars '$DEBUG';
$DEBUG = (defined($ENV{USER}) and $ENV{USER} eq 'achx') ? 1 : 0;
print STDERR "tixGrid: debug = $DEBUG\n" if $DEBUG;
}
require Tk;
require Tk::Widget;
require Tk::Derived;
require Tk::Entry;
use vars qw($VERSION);
$VERSION = '4.004'; # $Id: //depot/Tkutf8/TixGrid/FloatEntry.pm#4 $
use base qw(Tk::Derived Tk::Entry);
Construct Tk::Widget 'FloatEntry';
sub ClassInit
{
my ($class, $mw) = @_;
$class->SUPER::ClassInit($mw);
$mw->bind($class, '<Return>', 'invoke');
$mw->bind($class, '<FocusIn>', 'FocusIn');
$class;
}
sub Populate
{
my ($e, $args) = @_;
$e->ConfigSpecs(
-value => ['METHOD', 'value', 'Value', undef],
-highlightthickness => [$e, 'highlightThickness', 'HighlightThickness', 0 ],
-command => ['CALLBACK', 'command', 'Command', undef],
);
print "FloatEntry Init: $e\n" if $DEBUG;
$e;
}
## option method
sub value
{
my $e = shift;
unless (@_)
{
return $e->get
}
$e->delete(0,'end');
$e->insert(0,$_[0]);
$e->selection('from', 0);
$e->selection('to', 'end');
}
## public methods
sub invoke
{
my ($e) = @_;
$e->Callback('-command', $e->get);
}
sub post
{
my ($e, $x, $y, $dx, $dy) = @_;
$dx = $e->reqwidth unless defined $dx;
$dy = $e->reqheight unless defined $dy;
$e->place('-x'=>$x, '-y'=>$y, -width=>$dx, -height=>$dy, -bordermode=>'ignore');
$e->raise;
$e->focus;
}
sub unpost
{
my ($e) = @_;
$e->place('forget');
}
## bindings
sub FocusIn
{
my ($e) = @_;
# FIX: xxx only if entry has not already focus
{
$e->focus;
$e->selection('from', 0);
$e->selection('to', 'end');
$e->icursor('end');
}
}
1;
__END__
|