diff options
author | Norbert Preining <preining@logic.at> | 2008-06-22 14:23:07 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2008-06-22 14:23:07 +0000 |
commit | 09732e2a06a89da7cdf68ad773d8db5122687379 (patch) | |
tree | 0b0ee6248fd6122a0b6f9abaafad5dc3138888c9 /Master/tlpkg/tlperl | |
parent | 3e9505749cf61218e1f9583e94600df3795e7001 (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.pm | 185 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Tk/waitVariableX.pm | 80 |
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 |