This file is indexed.

/usr/share/perl5/Tk/Splashscreen.pm is in libtk-splashscreen-perl 1.0-3.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
$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