Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Tk / FloatEntry.pm
CommitLineData
86530b38
AT
1# Tranlation of FloatEnt.tcl in Tix4.1
2
3# TODO/IDEA:
4# o extract a widget (SimpleEntry?) without post/unpost methods
5# and derive FloatEntry fron this widget.
6
7package Tk::FloatEntry;
8use strict;
9
10BEGIN
11 {
12 use vars '$DEBUG';
13 $DEBUG = (defined($ENV{USER}) and $ENV{USER} eq 'achx') ? 1 : 0;
14 print STDERR "tixGrid: debug = $DEBUG\n" if $DEBUG;
15 }
16
17require Tk;
18require Tk::Widget;
19require Tk::Derived;
20require Tk::Entry;
21
22use vars qw($VERSION);
23$VERSION = '3.006'; # $Id: //depot/Tk8/TixGrid/FloatEntry.pm#6 $
24
25use base qw(Tk::Derived Tk::Entry);
26
27Construct Tk::Widget 'FloatEntry';
28
29sub ClassInit
30 {
31 my ($class, $mw) = @_;
32 $class->SUPER::ClassInit($mw);
33 $mw->bind($class, '<Return>', 'invoke');
34 $mw->bind($class, '<FocusIn>', 'FocusIn');
35 $class;
36 }
37
38sub Populate
39 {
40 my ($e, $args) = @_;
41 $e->ConfigSpecs(
42 -value => ['METHOD', 'value', 'Value', undef],
43 -highlightthickness => [$e, 'highlightThickness', 'HighlightThickness', 0 ],
44 -command => ['CALLBACK', 'command', 'Command', undef],
45 );
46 print "FloatEntry Init: $e\n" if $DEBUG;
47 $e;
48 }
49
50## option method
51
52sub value
53 {
54 my $e = shift;
55 unless (@_)
56 {
57 return $e->get
58 }
59 $e->delete(0,'end');
60 $e->insert(0,$_[0]);
61 $e->selection('from', 0);
62 $e->selection('to', 'end');
63
64 }
65
66## public methods
67
68sub invoke
69 {
70 my ($e) = @_;
71 $e->Callback('-command', $e->get);
72 }
73
74sub post
75 {
76 my ($e, $x, $y, $dx, $dy) = @_;
77
78 $dx = $e->reqwidth unless defined $dx;
79 $dy = $e->reqheight unless defined $dy;
80
81 $e->place('-x'=>$x, '-y'=>$y, -width=>$dx, -height=>$dy, -bordermode=>'ignore');
82 $e->raise;
83 $e->focus;
84 }
85
86sub unpost
87 {
88 my ($e) = @_;
89 $e->place('forget');
90 }
91
92## bindings
93
94sub FocusIn
95 {
96 my ($e) = @_;
97
98 # FIX: xxx only if entry has not already focus
99 {
100 $e->focus;
101 $e->selection('from', 0);
102 $e->selection('to', 'end');
103 $e->icursor('end');
104 }
105 }
106
1071;
108__END__
109