summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl
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/tlperl
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/tlperl')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/Splashscreen.pm185
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/waitVariableX.pm80
2 files changed, 0 insertions, 265 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/Splashscreen.pm b/Master/tlpkg/tlperl/lib/Tk/Splashscreen.pm
deleted file mode 100644
index 3148c6b1131..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/Splashscreen.pm
+++ /dev/null
@@ -1,185 +0,0 @@
-$Tk::Splashscreen::VERSION = '1.0';
-
-package Tk::Splashscreen;
-
-use Tk qw/Ev/;
-use Tk qw/:eventtypes/;
-use Tk::waitVariableX;
-use Tk::widgets qw/Toplevel/;
-use base qw/Tk::Toplevel/;
-
-Construct Tk::Widget 'Splashscreen';
-
-sub Populate {
- my ($self, $args) = @_;
-
- $self->withdraw;
- $self->overrideredirect(1);
-
- $self->SUPER::Populate($args);
-
- $self->{ofx} = 0; # X offset from top-left corner to cursor
- $self->{ofy} = 0; # Y offset from top-left corner to cursor
- $self->{tm0} = 0; # microseconds time widget was Shown
-
- $self->ConfigSpecs(
- -milliseconds => [qw/PASSIVE milliseconds Milliseconds 0/],
- );
-
- $self->bind('<ButtonPress-3>' => [$self => 'b3prs', Ev('x'), Ev('y')]);
- $self->bind('<ButtonRelease-3>' => [$self => 'b3rls', Ev('X'), Ev('Y')]);
-
-} # end Populate
-
-# Object methods.
-
-sub Destroy {
-
-
- my ($self, $millis) = @_;
-
- $millis = $self->cget(-milliseconds) unless defined $millis;
- my $t = Tk::timeofday;
- $millis = $millis - ( ($t - $self->{tm0}) * 1000 );
- $millis = 0 if $millis < 0;
-
- my $destroy_splashscreen = sub {
- $self->update;
- $self->after(100); # ensure 100% of PB seen
- $self->destroy;
- };
-
- do { &$destroy_splashscreen; return } if $millis == 0;
-
- while ( $self->DoOneEvent (DONT_WAIT | TIMER_EVENTS)) {}
-
- $self->waitVariableX( [$millis, $destroy_splashscreen] );
-
-} # end Destroy
-
-sub Splash {
-
- my ($self, $millis) = @_;
-
- $millis = $self->cget(-milliseconds) unless defined $millis;
- $self->{tm0} = Tk::timeofday;
- $self->configure(-milliseconds => $millis);
- $self->Popup;
-
-} # end_splash
-
-# Private methods.
-
-sub b3prs {
- my ($self, $x, $y) = @_;
- $self->{ofx} = $x;
- $self->{ofy} = $y;
-} # end b3prs
-
-sub b3rls {
- my($self, $X, $Y) = @_;
- $X -= $self->{ofx};
- $Y -= $self->{ofy};
- $self->geometry("+${X}+${Y}");
-} # end b3rls
-
-1;
-__END__
-
-=head1 NAME
-
-Tk::Splashscreen - display a Splashscreen during program initialization.
-
-=head1 SYNOPSIS
-
- $splash = $parent->Splashscreen(-opt => val, ... );
-
-=head1 DESCRIPTION
-
-For programs that require large load times, it's a common practice to
-display a Splashscreen that occupies the user's attention. This
-Toplevel mega widget provides all the display, destroy and timing
-events. All you do it create the Splashscreen mega widget, populate
-it as you see fit, then invoke Splash() to display it and Destroy() to
-tear it down.
-
-Important note: be sure to sprinkle update() calls throughout your
-initialization code so that any Splashscreen events are handled.
-Remember, the screen may be animated, or the user may be simply moving
-the Splashscreen about.
-
-=head1 OPTIONS
-
-The following option/value pairs are supported:
-
-=over 4
-
-=item B<-milliseconds>
-
-The minimum number of milliseconds the Splashscreen should remain on
-the screen. Default is 0, which means that the Splashscreen is
-destroyed as soon as Destroy() is called. Otherwise, Destroy() waits
-for the specified time interval to elapse before destroying the
-Splashscreen.
-
-=back
-
-=head1 METHODS
-
-=head2 $splash->Splash([B<milliseconds>]);
-
-If B<milliseconds> is specified, it's the minimum number of
-milliseconds the Splashscreen should remain on the screen.
-This value takes precedence over that specified on the
-Splashscreen constructor call.
-
-=head2 $splash->Destroy([B<milliseconds>]);
-
-If B<milliseconds> is specified, it's the minimum number of
-milliseconds the Splashscreen should remain on the screen.
-This value takes precedence over that specified on the
-Splash() call, which takes precedence over that specified
-during Splashscreen construction.
-
-=head1 BINDINGS
-
-=head2 <ButtonPress-3>
-
-Notifies the Splashscreen to set a mark for an impending move.
-
-=head2 <ButtonRelease-3>
-
-Moves the Splashscreen from the mark to the cursor's current position.
-
-=head1 ADVERTISED WIDGETS
-
-Component subwidgets can be accessed via the B<Subwidget> method.
-This mega widget has no advertised subwidgets. Instead, treat the
-widget reference as a Toplevel and populate it as desired.
-
-=head1 EXAMPLE
-
- $splash = $mw->Splashscreen;
-
- ... populate the Splashscreen toplevel as desired ...
-
- $splash->Splash(4000);
-
- ... program initialization ...
-
- $splash->Destroy;
-
-=head1 AUTHOR
-
-Stephen.O.Lidie@Lehigh.EDU
-
-Copyright (C) 2001 - 2002, Steve Lidie. All rights reserved.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=head1 KEYWORDS
-
-Splashscreen, Toplevel
-
-=cut
diff --git a/Master/tlpkg/tlperl/lib/Tk/waitVariableX.pm b/Master/tlpkg/tlperl/lib/Tk/waitVariableX.pm
deleted file mode 100644
index 29dbae9cea5..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/waitVariableX.pm
+++ /dev/null
@@ -1,80 +0,0 @@
-$Tk::waitVariableX::VERSION = '1.0';
-
-package Tk::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
-
-Tk::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.
-
-=cut