summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/waitVariableX.pm
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2008-06-22 14:23:07 +0000
committerNorbert Preining <preining@logic.at>2008-06-22 14:23:07 +0000
commit09732e2a06a89da7cdf68ad773d8db5122687379 (patch)
tree0b0ee6248fd6122a0b6f9abaafad5dc3138888c9 /Master/tlpkg/TeXLive/waitVariableX.pm
parent3e9505749cf61218e1f9583e94600df3795e7001 (diff)
make Splashscreen and waitVariableX available for all platforms, and remove
the windows specific one. ALso change the incantation in tlmgrgui git-svn-id: svn://tug.org/texlive/trunk@8934 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive/waitVariableX.pm')
-rw-r--r--Master/tlpkg/TeXLive/waitVariableX.pm81
1 files changed, 81 insertions, 0 deletions
diff --git a/Master/tlpkg/TeXLive/waitVariableX.pm b/Master/tlpkg/TeXLive/waitVariableX.pm
new file mode 100644
index 00000000000..b6404c5350b
--- /dev/null
+++ b/Master/tlpkg/TeXLive/waitVariableX.pm
@@ -0,0 +1,81 @@
+$TeXLive::waitVariableX::VERSION = '1.0';
+
+package TeXLive::waitVariableX;
+
+use Carp;
+use Exporter;
+
+use base qw/Exporter/;
+@EXPORT = qw/waitVariableX/;
+use strict;
+
+sub waitVariableX {
+
+ use Tie::Watch;
+
+ my ($parent, $millis) = (shift, shift); # @_ has list of var refs
+
+ croak "waitVariableX: no milliseconds." unless defined $millis;
+ my ($callback, $st, $tid, @watch, $why);
+
+ if (ref $millis eq 'ARRAY') {
+ $callback = Tk::Callback->new($millis->[1]);
+ $millis = $millis->[0];
+ }
+
+ $st = sub {my $argv = $_[0]->Args('-store'); $why = $argv->[0]};
+ foreach my $vref (@_) {
+ push @watch,
+ Tie::Watch->new(-variable => $vref, -store => [$st, $vref]);
+ }
+ $tid = $parent->after($millis => sub {$why = 0}) unless $millis == 0;
+
+ $parent->waitVariable(\$why); # wait for timer or watchpoint(s)
+
+ $_->Unwatch foreach @watch;
+ $parent->afterCancel($tid);
+ $callback->Call($why) if defined $callback;
+
+ return $why; # why we stopped waiting: 0 or $vref
+
+} # end waitVariableX
+
+1;
+__END__
+
+=head1 NAME
+
+TeXLive::waitVariableX - a waitVariable with extensions.
+
+=head1 SYNOPSIS
+
+ use Tk::waitVariableX;
+
+ $splash->waitVariableX( [$millis, $destroy_splashscreen], \$v1, \$v2} );
+
+=head1 DESCRIPTION
+
+This subroutine waits for a list of variables, with a timeout - the
+subroutine returns when one of the variables changes value or the timeout
+expires, whichever occurs first.
+
+Although the millisecond parameter is required, it may be zero, which
+effects no timeout. The milliscond paramter may also be an array of
+two elements, the first the millisecond value, and the second a
+normal Per/Tk callback. The callback is invoked just before
+waitVariableX returns.
+
+Callback format is patterned after the Perl/Tk scheme: supply either a
+code reference, or, supply an array reference and pass the callback
+code reference in the first element of the array, followed by callback
+arguments.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000 - 2002 Stephen O. Lidie. All rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+This package is a literal copy of the original package only changing its name.
+=cut