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

2 files changed, 269 insertions, 0 deletions

diff --git a/Master/tlpkg/TeXLive/Splashscreen.pm b/Master/tlpkg/TeXLive/Splashscreen.pm
new file mode 100644
index 00000000000..b04802d772e
--- /dev/null
+++ b/Master/tlpkg/TeXLive/Splashscreen.pm
@@ -0,0 +1,188 @@
+$TeXLive::Splashscreen::VERSION = '1.0';
+
+package TeXLive::Splashscreen;
+
+use Tk qw/Ev/;
+use Tk qw/:eventtypes/;
+use TeXLive::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
+
+TeXLive::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.
+
+This package is a literal copy of the Splashscreen.pm code only changing
+the package name.
+
+=head1 KEYWORDS
+
+Splashscreen, Toplevel
+
+=cut
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