From 09732e2a06a89da7cdf68ad773d8db5122687379 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Sun, 22 Jun 2008 14:23:07 +0000 Subject: 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 --- Master/tlpkg/TeXLive/Splashscreen.pm | 188 ++++++++++++++++++++++++++++ Master/tlpkg/TeXLive/waitVariableX.pm | 81 ++++++++++++ Master/tlpkg/tlperl/lib/Tk/Splashscreen.pm | 185 --------------------------- Master/tlpkg/tlperl/lib/Tk/waitVariableX.pm | 80 ------------ 4 files changed, 269 insertions(+), 265 deletions(-) create mode 100644 Master/tlpkg/TeXLive/Splashscreen.pm create mode 100644 Master/tlpkg/TeXLive/waitVariableX.pm delete mode 100644 Master/tlpkg/tlperl/lib/Tk/Splashscreen.pm delete mode 100644 Master/tlpkg/tlperl/lib/Tk/waitVariableX.pm (limited to 'Master/tlpkg') 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('' => [$self => 'b3prs', Ev('x'), Ev('y')]); + $self->bind('' => [$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]); + +If B 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]); + +If B 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 + +Notifies the Splashscreen to set a mark for an impending move. + +=head2 + +Moves the Splashscreen from the mark to the cursor's current position. + +=head1 ADVERTISED WIDGETS + +Component subwidgets can be accessed via the B 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 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('' => [$self => 'b3prs', Ev('x'), Ev('y')]); - $self->bind('' => [$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]); - -If B 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]); - -If B 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 - -Notifies the Splashscreen to set a mark for an impending move. - -=head2 - -Moves the Splashscreen from the mark to the cursor's current position. - -=head1 ADVERTISED WIDGETS - -Component subwidgets can be accessed via the B 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 -- cgit v1.2.3