diff options
author | Karl Berry <karl@freefriends.org> | 2016-04-05 22:27:26 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2016-04-05 22:27:26 +0000 |
commit | b56b320b5e2515160073fa1b469514002688fe11 (patch) | |
tree | 965a7100c5e45fca8ec803d22b8b6ce14fca4633 /Master/tlpkg/tlperl/lib/Tk/FloatEntry.pm | |
parent | d26c206452d2e285c3bbf949f34011e4a55fd8f9 (diff) |
tlperl 5.22.1 from siep
git-svn-id: svn://tug.org/texlive/trunk@40252 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/FloatEntry.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Tk/FloatEntry.pm | 109 |
1 files changed, 0 insertions, 109 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/FloatEntry.pm b/Master/tlpkg/tlperl/lib/Tk/FloatEntry.pm deleted file mode 100644 index eb6465dbe61..00000000000 --- a/Master/tlpkg/tlperl/lib/Tk/FloatEntry.pm +++ /dev/null @@ -1,109 +0,0 @@ -# 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__ - |