summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/Spinbox.pm
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2010-05-12 16:54:37 +0000
committerNorbert Preining <preining@logic.at>2010-05-12 16:54:37 +0000
commit661c41a09e39a182865e0b51e34cc995a0dc96e8 (patch)
tree2f79bb1406e22fdcb2587be8ffda6c0c609d7932 /Master/tlpkg/tlperl/lib/Tk/Spinbox.pm
parentb645030efc22e13c2498a1522083634ab91b2de1 (diff)
move tlperl.straw to tlperl
git-svn-id: svn://tug.org/texlive/trunk@18210 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/Spinbox.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Tk/Spinbox.pm115
1 files changed, 115 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/Spinbox.pm b/Master/tlpkg/tlperl/lib/Tk/Spinbox.pm
new file mode 100755
index 00000000000..673a1e181ce
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Tk/Spinbox.pm
@@ -0,0 +1,115 @@
+package Tk::Spinbox;
+use strict;
+
+use vars qw($VERSION);
+$VERSION = sprintf '4.%03d',q$Revision: #6 $ =~ /#(\d+)/;
+
+use base 'Tk::Entry';
+
+sub Tk_cmd { \&Tk::spinbox }
+
+# Also inherits Entry's methods
+Tk::Methods( "identify", "invoke", "set" );
+use Tk::Submethods ( 'selection' => ["element"] );
+
+Construct Tk::Widget 'Spinbox';
+
+sub ClassInit
+{
+ my ($class,$mw) = @_;
+
+ $class->SUPER::ClassInit($mw);
+
+ $mw->bind($class, '<Up>', [invoke => 'buttonup']);
+ $mw->bind($class, '<4>', [invoke => 'buttonup']);
+ $mw->bind($class, '<Down>',[invoke => 'buttondown']);
+ $mw->bind($class, '<5>', [invoke => 'buttondown']);
+
+ return $class;
+}
+
+sub Invoke
+{
+ my ($w,$elem) = @_;
+ unless ($w->{_outside})
+ {
+ $w->invoke($elem);
+ $w->{_repeated}++;
+ }
+ my $delay = $w->cget('-repeatinterval');
+ if ($delay > 0)
+ {
+ $w->RepeatId($w->after($delay,[Invoke => $w,$elem]));
+ }
+}
+
+sub Button1
+{
+ my ($w,$x,$y) = @_;
+ my $elem = $w->identify($x,$y);
+ $w->{_element} = $elem || 'entry';
+ if ($w->{_element} eq 'entry')
+ {
+ $w->SUPER::Button1($x,$y);
+ }
+ elsif ($w->cget('-state') ne 'disabled')
+ {
+ $w->selectionElement($elem);
+ $w->{_repeated} = 0;
+ $w->{_outside} = 0;
+ $w->{_relief} = $w->cget("-${elem}relief");
+ $w->CancelRepeat;
+ my $delay = $w->cget('-repeatdelay');
+ $w->RepeatId($w->after($delay,[Invoke => $w,$elem])) if $delay > 0;
+ }
+}
+
+sub Motion
+{
+ my ($w,$x,$y) = @_;
+ my $elem = $w->identify($x,$y);
+ $w->{_element} = $elem || 'entry' unless $w->{_element};
+ if ($w->{_element} eq 'entry')
+ {
+ $w->SUPER::Motion($x,$y);
+ }
+ else
+ {
+ if (!defined($elem) || $elem ne $w->{_element})
+ {
+ # Moved outside the button
+ unless ($w->{_outside})
+ {
+ $w->{_outside} = 1;
+ $w->selectionElement('none');
+ }
+ }
+ elsif ($w->{_outside})
+ {
+ # Moved back over the button
+ $w->selectionElement($elem);
+ $w->{_outside} = 0;
+ }
+ }
+}
+
+sub Button1Release
+{
+ my ($w,$x,$y) = @_;
+ $w->SUPER::Button1Release($x,$y);
+ my $elem = $w->{_element};
+ if (defined($elem) && $elem ne 'entry')
+ {
+ my $repeated = $w->{_repeated};
+ if (defined($repeated) && !$repeated)
+ {
+ $w->invoke($elem);
+ }
+ my $relief = delete $w->{_relief};
+ $w->configure("-${elem}relief",$relief) if $relief
+ }
+ $w->selectionElement('none');
+}
+
+1;
+__END__