summaryrefslogtreecommitdiff
path: root/Master/perltl/site/lib/Tk/After.pm
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2008-01-06 17:27:49 +0000
committerNorbert Preining <preining@logic.at>2008-01-06 17:27:49 +0000
commitb6d71a48c3eb427a60bc1c9b4b8e3f16b695bf66 (patch)
tree374beef8c61dd2f05dc36686cd5f63c393ca1f9c /Master/perltl/site/lib/Tk/After.pm
parent7112ae868388a986572aec9c821f1971b2156351 (diff)
big perl removal, all the bin-perl related stuff is gone:
- Master/perltl the perl library - bin/win32/perl,tk the bin/dll - the bin-perl.tlpsrc - collection-perl.tlpsrc (where did this come from) - collection-perl removed from collection-wintools git-svn-id: svn://tug.org/texlive/trunk@6062 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/perltl/site/lib/Tk/After.pm')
-rw-r--r--Master/perltl/site/lib/Tk/After.pm88
1 files changed, 0 insertions, 88 deletions
diff --git a/Master/perltl/site/lib/Tk/After.pm b/Master/perltl/site/lib/Tk/After.pm
deleted file mode 100644
index e5eac8b20a8..00000000000
--- a/Master/perltl/site/lib/Tk/After.pm
+++ /dev/null
@@ -1,88 +0,0 @@
-# Copyright (c) 1995-1999 Nick Ing-Simmons. All rights reserved.
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-package Tk::After;
-use Carp;
-
-use vars qw($VERSION);
-$VERSION = '3.015'; # $Id: //depot/Tk8/Tk/After.pm#15 $
-
-sub _cancelAll
-{
- my $w = shift;
- my $h = delete $w->{_After_};
- foreach my $obj (values %$h)
- {
- # carp "Auto cancel ".$obj->[1]." for ".$obj->[0]->PathName;
- $obj->cancel;
- }
-}
-
-sub submit
-{
- my $obj = shift;
- my $w = $obj->[0];
- my $id = $obj->[1];
- my $t = $obj->[2];
- my $method = $obj->[3];
- delete($w->{_After_}{$id}) if (defined $id);
- $id = $w->Tk::after($t,[$method => $obj]);
- unless (exists $w->{_After_})
- {
- $w->{_After_} = {};
- $w->OnDestroy([\&_cancelAll, $w]);
- }
- $w->{_After_}{$id} = $obj;
- $obj->[1] = $id;
- return $obj;
-}
-
-sub DESTROY
-{
- my $obj = shift;
- @{$obj} = ();
-}
-
-sub new
-{
- my ($class,$w,$t,$method,@cb) = @_;
- my $cb = (@cb == 1) ? shift(@cb) : [@cb];
- my $obj = bless [$w,undef,$t,$method,Tk::Callback->new($cb)],$class;
- return $obj->submit;
-}
-
-sub cancel
-{
- my $obj = shift;
- my $id = $obj->[1];
- my $w = $obj->[0];
- if ($id)
- {
- $w->Tk::after('cancel'=> $id);
- delete $w->{_After_}{$id} if exists $w->{_After_};
- $obj->[1] = undef;
- }
- return $obj;
-}
-
-sub repeat
-{
- my $obj = shift;
- $obj->submit;
- local $Tk::widget = $obj->[0];
- $obj->[4]->Call;
-}
-
-sub once
-{
- my $obj = shift;
- my $w = $obj->[0];
- my $id = $obj->[1];
- delete $w->{_After_}{$id};
- local $Tk::widget = $w;
- $obj->[4]->Call;
-}
-
-1;
-__END__
-