summaryrefslogtreecommitdiff
path: root/Master/tlpkg/lib
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2008-01-13 18:38:54 +0000
committerNorbert Preining <preining@logic.at>2008-01-13 18:38:54 +0000
commita5ef1b8118d74c0365a700eca71a691819ea47c7 (patch)
tree65722004d65c7a73baa895c79b843833d2448372 /Master/tlpkg/lib
parentcd19406a59274abc69e8a79af7cc747bd0895782 (diff)
update Perl5_lib-TL_inst from what Siep told us
git-svn-id: svn://tug.org/texlive/trunk@6211 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/lib')
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/Carp/Heavy.pm241
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/List/Util.pm277
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/Scalar/Util.pm147
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Checkbutton.pm42
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Clipboard.pm122
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Dialog.pm70
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/DialogBox.pm135
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Entry.pm615
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Radiobutton.pm45
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/Env.pm169
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/CancelRepeat.al15
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Clipboard/autosplit.ix6
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Clipboard/getSelected.al15
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Entry/Entry.bs0
-rwxr-xr-xMaster/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Entry/Entry.dllbin0 -> 41472 bytes
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Error.al20
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/RepeatId.al16
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/AnchorAdjust.al17
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/FullScreen.al29
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/Popup.al50
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/Post.al20
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/iconposition.al24
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/unicore/lib/gc_sc/Uppercas.pl490
23 files changed, 2565 insertions, 0 deletions
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/Carp/Heavy.pm b/Master/tlpkg/lib/Perl5_lib-TL_inst/Carp/Heavy.pm
new file mode 100644
index 00000000000..55bca2b421a
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/Carp/Heavy.pm
@@ -0,0 +1,241 @@
+# Carp::Heavy uses some variables in common with Carp.
+package Carp;
+
+=head1 NAME
+
+Carp::Heavy - heavy machinery, no user serviceable parts inside
+
+=cut
+
+# use strict; # not yet
+
+# On one line so MakeMaker will see it.
+use Carp; our $VERSION = $Carp::VERSION;
+
+our ($CarpLevel, $MaxArgNums, $MaxEvalLen, $MaxArgLen, $Verbose);
+
+sub caller_info {
+ my $i = shift(@_) + 1;
+ package DB;
+ my %call_info;
+ @call_info{
+ qw(pack file line sub has_args wantarray evaltext is_require)
+ } = caller($i);
+
+ unless (defined $call_info{pack}) {
+ return ();
+ }
+
+ my $sub_name = Carp::get_subname(\%call_info);
+ if ($call_info{has_args}) {
+ my @args = map {Carp::format_arg($_)} @DB::args;
+ if ($MaxArgNums and @args > $MaxArgNums) { # More than we want to show?
+ $#args = $MaxArgNums;
+ push @args, '...';
+ }
+ # Push the args onto the subroutine
+ $sub_name .= '(' . join (', ', @args) . ')';
+ }
+ $call_info{sub_name} = $sub_name;
+ return wantarray() ? %call_info : \%call_info;
+}
+
+# Transform an argument to a function into a string.
+sub format_arg {
+ my $arg = shift;
+ if (ref($arg)) {
+ $arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
+ }elsif (not defined($arg)) {
+ $arg = 'undef';
+ }
+ $arg =~ s/'/\\'/g;
+ $arg = str_len_trim($arg, $MaxArgLen);
+
+ # Quote it?
+ $arg = "'$arg'" unless $arg =~ /^-?[\d.]+\z/;
+
+ # The following handling of "control chars" is direct from
+ # the original code - it is broken on Unicode though.
+ # Suggestions?
+ utf8::is_utf8($arg)
+ or $arg =~ s/([[:cntrl:]]|[[:^ascii:]])/sprintf("\\x{%x}",ord($1))/eg;
+ return $arg;
+}
+
+# Takes an inheritance cache and a package and returns
+# an anon hash of known inheritances and anon array of
+# inheritances which consequences have not been figured
+# for.
+sub get_status {
+ my $cache = shift;
+ my $pkg = shift;
+ $cache->{$pkg} ||= [{$pkg => $pkg}, [trusts_directly($pkg)]];
+ return @{$cache->{$pkg}};
+}
+
+# Takes the info from caller() and figures out the name of
+# the sub/require/eval
+sub get_subname {
+ my $info = shift;
+ if (defined($info->{evaltext})) {
+ my $eval = $info->{evaltext};
+ if ($info->{is_require}) {
+ return "require $eval";
+ }
+ else {
+ $eval =~ s/([\\\'])/\\$1/g;
+ return "eval '" . str_len_trim($eval, $MaxEvalLen) . "'";
+ }
+ }
+
+ return ($info->{sub} eq '(eval)') ? 'eval {...}' : $info->{sub};
+}
+
+# Figures out what call (from the point of view of the caller)
+# the long error backtrace should start at.
+sub long_error_loc {
+ my $i;
+ my $lvl = $CarpLevel;
+ {
+ my $pkg = caller(++$i);
+ unless(defined($pkg)) {
+ # This *shouldn't* happen.
+ if (%Internal) {
+ local %Internal;
+ $i = long_error_loc();
+ last;
+ }
+ else {
+ # OK, now I am irritated.
+ return 2;
+ }
+ }
+ redo if $CarpInternal{$pkg};
+ redo unless 0 > --$lvl;
+ redo if $Internal{$pkg};
+ }
+ return $i - 1;
+}
+
+
+sub longmess_heavy {
+ return @_ if ref($_[0]); # don't break references as exceptions
+ my $i = long_error_loc();
+ return ret_backtrace($i, @_);
+}
+
+# Returns a full stack backtrace starting from where it is
+# told.
+sub ret_backtrace {
+ my ($i, @error) = @_;
+ my $mess;
+ my $err = join '', @error;
+ $i++;
+
+ my $tid_msg = '';
+ if (defined &Thread::tid) {
+ my $tid = Thread->self->tid;
+ $tid_msg = " thread $tid" if $tid;
+ }
+
+ my %i = caller_info($i);
+ $mess = "$err at $i{file} line $i{line}$tid_msg\n";
+
+ while (my %i = caller_info(++$i)) {
+ $mess .= "\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
+ }
+
+ return $mess;
+}
+
+sub ret_summary {
+ my ($i, @error) = @_;
+ my $err = join '', @error;
+ $i++;
+
+ my $tid_msg = '';
+ if (defined &Thread::tid) {
+ my $tid = Thread->self->tid;
+ $tid_msg = " thread $tid" if $tid;
+ }
+
+ my %i = caller_info($i);
+ return "$err at $i{file} line $i{line}$tid_msg\n";
+}
+
+
+sub short_error_loc {
+ my $cache;
+ my $i = 1;
+ my $lvl = $CarpLevel;
+ {
+ my $called = caller($i++);
+ my $caller = caller($i);
+ return 0 unless defined($caller); # What happened?
+ redo if $Internal{$caller};
+ redo if $CarpInternal{$called};
+ redo if trusts($called, $caller, $cache);
+ redo if trusts($caller, $called, $cache);
+ redo unless 0 > --$lvl;
+ }
+ return $i - 1;
+}
+
+sub shortmess_heavy {
+ return longmess_heavy(@_) if $Verbose;
+ return @_ if ref($_[0]); # don't break references as exceptions
+ my $i = short_error_loc();
+ if ($i) {
+ ret_summary($i, @_);
+ }
+ else {
+ longmess_heavy(@_);
+ }
+}
+
+# If a string is too long, trims it with ...
+sub str_len_trim {
+ my $str = shift;
+ my $max = shift || 0;
+ if (2 < $max and $max < length($str)) {
+ substr($str, $max - 3) = '...';
+ }
+ return $str;
+}
+
+# Takes two packages and an optional cache. Says whether the
+# first inherits from the second.
+#
+# Recursive versions of this have to work to avoid certain
+# possible endless loops, and when following long chains of
+# inheritance are less efficient.
+sub trusts {
+ my $child = shift;
+ my $parent = shift;
+ my $cache = shift || {};
+ my ($known, $partial) = get_status($cache, $child);
+ # Figure out consequences until we have an answer
+ while (@$partial and not exists $known->{$parent}) {
+ my $anc = shift @$partial;
+ next if exists $known->{$anc};
+ $known->{$anc}++;
+ my ($anc_knows, $anc_partial) = get_status($cache, $anc);
+ my @found = keys %$anc_knows;
+ @$known{@found} = ();
+ push @$partial, @$anc_partial;
+ }
+ return exists $known->{$parent};
+}
+
+# Takes a package and gives a list of those trusted directly
+sub trusts_directly {
+ my $class = shift;
+ no strict 'refs';
+ no warnings 'once';
+ return @{"$class\::CARP_NOT"}
+ ? @{"$class\::CARP_NOT"}
+ : @{"$class\::ISA"};
+}
+
+1;
+
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/List/Util.pm b/Master/tlpkg/lib/Perl5_lib-TL_inst/List/Util.pm
new file mode 100644
index 00000000000..cfe31f70123
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/List/Util.pm
@@ -0,0 +1,277 @@
+# List::Util.pm
+#
+# Copyright (c) 1997-2005 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package List::Util;
+
+use strict;
+use vars qw(@ISA @EXPORT_OK $VERSION $XS_VERSION $TESTING_PERL_ONLY);
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(first min max minstr maxstr reduce sum shuffle);
+$VERSION = "1.18";
+$XS_VERSION = $VERSION;
+$VERSION = eval $VERSION;
+
+eval {
+ # PERL_DL_NONLAZY must be false, or any errors in loading will just
+ # cause the perl code to be tested
+ local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
+ eval {
+ require XSLoader;
+ XSLoader::load('List::Util', $XS_VERSION);
+ 1;
+ } or do {
+ require DynaLoader;
+ local @ISA = qw(DynaLoader);
+ bootstrap List::Util $XS_VERSION;
+ };
+} unless $TESTING_PERL_ONLY;
+
+
+# This code is only compiled if the XS did not load
+# of for perl < 5.6.0
+
+if (!defined &reduce) {
+eval <<'ESQ'
+
+sub reduce (&@) {
+ my $code = shift;
+ no strict 'refs';
+
+ return shift unless @_ > 1;
+
+ use vars qw($a $b);
+
+ my $caller = caller;
+ local(*{$caller."::a"}) = \my $a;
+ local(*{$caller."::b"}) = \my $b;
+
+ $a = shift;
+ foreach (@_) {
+ $b = $_;
+ $a = &{$code}();
+ }
+
+ $a;
+}
+
+sub first (&@) {
+ my $code = shift;
+
+ foreach (@_) {
+ return $_ if &{$code}();
+ }
+
+ undef;
+}
+
+ESQ
+}
+
+# This code is only compiled if the XS did not load
+eval <<'ESQ' if !defined &sum;
+
+use vars qw($a $b);
+
+sub sum (@) { reduce { $a + $b } @_ }
+
+sub min (@) { reduce { $a < $b ? $a : $b } @_ }
+
+sub max (@) { reduce { $a > $b ? $a : $b } @_ }
+
+sub minstr (@) { reduce { $a lt $b ? $a : $b } @_ }
+
+sub maxstr (@) { reduce { $a gt $b ? $a : $b } @_ }
+
+sub shuffle (@) {
+ my @a=\(@_);
+ my $n;
+ my $i=@_;
+ map {
+ $n = rand($i--);
+ (${$a[$n]}, $a[$n] = $a[$i])[0];
+ } @_;
+}
+
+ESQ
+
+1;
+
+__END__
+
+=head1 NAME
+
+List::Util - A selection of general-utility list subroutines
+
+=head1 SYNOPSIS
+
+ use List::Util qw(first max maxstr min minstr reduce shuffle sum);
+
+=head1 DESCRIPTION
+
+C<List::Util> contains a selection of subroutines that people have
+expressed would be nice to have in the perl core, but the usage would
+not really be high enough to warrant the use of a keyword, and the size
+so small such that being individual extensions would be wasteful.
+
+By default C<List::Util> does not export any subroutines. The
+subroutines defined are
+
+=over 4
+
+=item first BLOCK LIST
+
+Similar to C<grep> in that it evaluates BLOCK setting C<$_> to each element
+of LIST in turn. C<first> returns the first element where the result from
+BLOCK is a true value. If BLOCK never returns true or LIST was empty then
+C<undef> is returned.
+
+ $foo = first { defined($_) } @list # first defined value in @list
+ $foo = first { $_ > $value } @list # first value in @list which
+ # is greater than $value
+
+This function could be implemented using C<reduce> like this
+
+ $foo = reduce { defined($a) ? $a : wanted($b) ? $b : undef } undef, @list
+
+for example wanted() could be defined() which would return the first
+defined value in @list
+
+=item max LIST
+
+Returns the entry in the list with the highest numerical value. If the
+list is empty then C<undef> is returned.
+
+ $foo = max 1..10 # 10
+ $foo = max 3,9,12 # 12
+ $foo = max @bar, @baz # whatever
+
+This function could be implemented using C<reduce> like this
+
+ $foo = reduce { $a > $b ? $a : $b } 1..10
+
+=item maxstr LIST
+
+Similar to C<max>, but treats all the entries in the list as strings
+and returns the highest string as defined by the C<gt> operator.
+If the list is empty then C<undef> is returned.
+
+ $foo = maxstr 'A'..'Z' # 'Z'
+ $foo = maxstr "hello","world" # "world"
+ $foo = maxstr @bar, @baz # whatever
+
+This function could be implemented using C<reduce> like this
+
+ $foo = reduce { $a gt $b ? $a : $b } 'A'..'Z'
+
+=item min LIST
+
+Similar to C<max> but returns the entry in the list with the lowest
+numerical value. If the list is empty then C<undef> is returned.
+
+ $foo = min 1..10 # 1
+ $foo = min 3,9,12 # 3
+ $foo = min @bar, @baz # whatever
+
+This function could be implemented using C<reduce> like this
+
+ $foo = reduce { $a < $b ? $a : $b } 1..10
+
+=item minstr LIST
+
+Similar to C<min>, but treats all the entries in the list as strings
+and returns the lowest string as defined by the C<lt> operator.
+If the list is empty then C<undef> is returned.
+
+ $foo = minstr 'A'..'Z' # 'A'
+ $foo = minstr "hello","world" # "hello"
+ $foo = minstr @bar, @baz # whatever
+
+This function could be implemented using C<reduce> like this
+
+ $foo = reduce { $a lt $b ? $a : $b } 'A'..'Z'
+
+=item reduce BLOCK LIST
+
+Reduces LIST by calling BLOCK multiple times, setting C<$a> and C<$b>
+each time. The first call will be with C<$a> and C<$b> set to the first
+two elements of the list, subsequent calls will be done by
+setting C<$a> to the result of the previous call and C<$b> to the next
+element in the list.
+
+Returns the result of the last call to BLOCK. If LIST is empty then
+C<undef> is returned. If LIST only contains one element then that
+element is returned and BLOCK is not executed.
+
+ $foo = reduce { $a < $b ? $a : $b } 1..10 # min
+ $foo = reduce { $a lt $b ? $a : $b } 'aa'..'zz' # minstr
+ $foo = reduce { $a + $b } 1 .. 10 # sum
+ $foo = reduce { $a . $b } @bar # concat
+
+=item shuffle LIST
+
+Returns the elements of LIST in a random order
+
+ @cards = shuffle 0..51 # 0..51 in a random order
+
+=item sum LIST
+
+Returns the sum of all the elements in LIST. If LIST is empty then
+C<undef> is returned.
+
+ $foo = sum 1..10 # 55
+ $foo = sum 3,9,12 # 24
+ $foo = sum @bar, @baz # whatever
+
+This function could be implemented using C<reduce> like this
+
+ $foo = reduce { $a + $b } 1..10
+
+=back
+
+=head1 KNOWN BUGS
+
+With perl versions prior to 5.005 there are some cases where reduce
+will return an incorrect result. This will show up as test 7 of
+reduce.t failing.
+
+=head1 SUGGESTED ADDITIONS
+
+The following are additions that have been requested, but I have been reluctant
+to add due to them being very simple to implement in perl
+
+ # One argument is true
+
+ sub any { $_ && return 1 for @_; 0 }
+
+ # All arguments are true
+
+ sub all { $_ || return 0 for @_; 1 }
+
+ # All arguments are false
+
+ sub none { $_ && return 0 for @_; 1 }
+
+ # One argument is false
+
+ sub notall { $_ || return 1 for @_; 0 }
+
+ # How many elements are true
+
+ sub true { scalar grep { $_ } @_ }
+
+ # How many elements are false
+
+ sub false { scalar grep { !$_ } @_ }
+
+=head1 COPYRIGHT
+
+Copyright (c) 1997-2005 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/Scalar/Util.pm b/Master/tlpkg/lib/Perl5_lib-TL_inst/Scalar/Util.pm
new file mode 100644
index 00000000000..4ae525a17c0
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/Scalar/Util.pm
@@ -0,0 +1,147 @@
+# Scalar::Util.pm
+#
+# Copyright (c) 1997-2005 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package Scalar::Util;
+
+use strict;
+use vars qw(@ISA @EXPORT_OK $VERSION);
+require Exporter;
+require List::Util; # List::Util loads the XS
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype);
+$VERSION = "1.18";
+$VERSION = eval $VERSION;
+
+sub export_fail {
+ if (grep { /^(weaken|isweak)$/ } @_ ) {
+ require Carp;
+ Carp::croak("Weak references are not implemented in the version of perl");
+ }
+ if (grep { /^(isvstring)$/ } @_ ) {
+ require Carp;
+ Carp::croak("Vstrings are not implemented in the version of perl");
+ }
+ if (grep { /^(dualvar|set_prototype)$/ } @_ ) {
+ require Carp;
+ Carp::croak("$1 is only avaliable with the XS version");
+ }
+
+ @_;
+}
+
+sub openhandle ($) {
+ my $fh = shift;
+ my $rt = reftype($fh) || '';
+
+ return defined(fileno($fh)) ? $fh : undef
+ if $rt eq 'IO';
+
+ if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA)
+ $fh = \(my $tmp=$fh);
+ }
+ elsif ($rt ne 'GLOB') {
+ return undef;
+ }
+
+ (tied(*$fh) or defined(fileno($fh)))
+ ? $fh : undef;
+}
+
+eval <<'ESQ' unless defined &dualvar;
+
+use vars qw(@EXPORT_FAIL);
+push @EXPORT_FAIL, qw(weaken isweak dualvar isvstring set_prototype);
+
+# The code beyond here is only used if the XS is not installed
+
+# Hope nobody defines a sub by this name
+sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }
+
+sub blessed ($) {
+ local($@, $SIG{__DIE__}, $SIG{__WARN__});
+ length(ref($_[0]))
+ ? eval { $_[0]->a_sub_not_likely_to_be_here }
+ : undef
+}
+
+sub refaddr($) {
+ my $pkg = ref($_[0]) or return undef;
+ if (blessed($_[0])) {
+ bless $_[0], 'Scalar::Util::Fake';
+ }
+ else {
+ $pkg = undef;
+ }
+ "$_[0]" =~ /0x(\w+)/;
+ my $i = do { local $^W; hex $1 };
+ bless $_[0], $pkg if defined $pkg;
+ $i;
+}
+
+sub reftype ($) {
+ local($@, $SIG{__DIE__}, $SIG{__WARN__});
+ my $r = shift;
+ my $t;
+
+ length($t = ref($r)) or return undef;
+
+ # This eval will fail if the reference is not blessed
+ eval { $r->a_sub_not_likely_to_be_here; 1 }
+ ? do {
+ $t = eval {
+ # we have a GLOB or an IO. Stringify a GLOB gives it's name
+ my $q = *$r;
+ $q =~ /^\*/ ? "GLOB" : "IO";
+ }
+ or do {
+ # OK, if we don't have a GLOB what parts of
+ # a glob will it populate.
+ # NOTE: A glob always has a SCALAR
+ local *glob = $r;
+ defined *glob{ARRAY} && "ARRAY"
+ or defined *glob{HASH} && "HASH"
+ or defined *glob{CODE} && "CODE"
+ or length(ref(${$r})) ? "REF" : "SCALAR";
+ }
+ }
+ : $t
+}
+
+sub tainted {
+ local($@, $SIG{__DIE__}, $SIG{__WARN__});
+ local $^W = 0;
+ eval { kill 0 * $_[0] };
+ $@ =~ /^Insecure/;
+}
+
+sub readonly {
+ return 0 if tied($_[0]) || (ref(\($_[0])) ne "SCALAR");
+
+ local($@, $SIG{__DIE__}, $SIG{__WARN__});
+ my $tmp = $_[0];
+
+ !eval { $_[0] = $tmp; 1 };
+}
+
+sub looks_like_number {
+ local $_ = shift;
+
+ # checks from perlfaq4
+ return 0 if !defined($_) or ref($_);
+ return 1 if (/^[+-]?\d+$/); # is a +/- integer
+ return 1 if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/); # a C float
+ return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
+
+ 0;
+}
+
+ESQ
+
+1;
+
+__END__
+
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Checkbutton.pm b/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Checkbutton.pm
new file mode 100644
index 00000000000..491d8cd2444
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Checkbutton.pm
@@ -0,0 +1,42 @@
+package Tk::Checkbutton;
+# Conversion from Tk4.0 button.tcl competed.
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+# This program is free software; you can redistribute it and/or
+
+
+use vars qw($VERSION);
+$VERSION = '4.006'; # $Id: //depot/Tkutf8/Tk/Checkbutton.pm#6 $
+
+# modify it under the same terms as Perl itself, subject
+# to additional disclaimer in license.terms due to partial
+# derivation from Tk4.0 sources.
+
+require Tk::Widget;
+require Tk::Button;
+
+use base qw(Tk::Button);
+
+Construct Tk::Widget 'Checkbutton';
+
+sub Tk_cmd { \&Tk::checkbutton }
+
+
+sub ClassInit
+{
+ my ($class,$mw) = @_;
+ $mw->bind($class,'<Enter>', 'Enter');
+ $mw->bind($class,'<Leave>', 'Leave');
+ $mw->bind($class,'<1>', 'Invoke');
+ $mw->bind($class,'<space>', 'Invoke');
+ return $class;
+}
+
+sub Invoke
+{
+ my $w = shift;
+ $w->invoke() unless($w->cget('-state') eq 'disabled');
+}
+
+1;
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Clipboard.pm b/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Clipboard.pm
new file mode 100644
index 00000000000..b0eb0ea2b07
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Clipboard.pm
@@ -0,0 +1,122 @@
+# Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+package Tk::Clipboard;
+use strict;
+
+use vars qw($VERSION);
+$VERSION = sprintf '4.%03d', q$Revision: #8 $ =~ /\D(\d+)\s*$/;
+
+use AutoLoader qw(AUTOLOAD);
+use Tk qw(catch);
+
+sub clipEvents
+{
+ return qw[Copy Cut Paste];
+}
+
+sub ClassInit
+{
+ my ($class,$mw) = @_;
+ foreach my $op ($class->clipEvents)
+ {
+ $mw->Tk::bind($class,"<<$op>>","clipboard$op");
+ }
+ return $class;
+}
+
+sub clipboardSet
+{
+ my $w = shift;
+ $w->clipboardClear;
+ $w->clipboardAppend(@_);
+}
+
+sub clipboardCopy
+{
+ my $w = shift;
+ my $val = $w->getSelected;
+ if (defined $val)
+ {
+ $w->clipboardSet('--',$val);
+ }
+ return $val;
+}
+
+sub clipboardCut
+{
+ my $w = shift;
+ my $val = $w->clipboardCopy;
+ if (defined $val)
+ {
+ $w->deleteSelected;
+ }
+ return $val;
+}
+
+sub clipboardGet
+{
+ my $w = shift;
+ $w->SelectionGet('-selection','CLIPBOARD',@_);
+}
+
+sub clipboardPaste
+{
+ my $w = shift;
+ local $@;
+ catch
+ {
+## Different from Tcl/Tk version:
+# if ($w->windowingsystem eq 'x11')
+# {
+# catch
+# {
+# $w->deleteSelected;
+# };
+# }
+ $w->insert("insert", $w->clipboardGet);
+ $w->SeeInsert if $w->can('SeeInsert');
+ };
+}
+
+sub clipboardOperations
+{
+ my @class = ();
+ my $mw = shift;
+ if (ref $mw)
+ {
+ $mw = $mw->DelegateFor('bind');
+ }
+ else
+ {
+ push(@class,$mw);
+ $mw = shift;
+ }
+ while (@_)
+ {
+ my $op = shift;
+ $mw->Tk::bind(@class,"<<$op>>","clipboard$op");
+ }
+}
+
+# These methods work for Entry and Text
+# and can be overridden where they don't work
+
+sub deleteSelected
+{
+ my $w = shift;
+ catch { $w->delete('sel.first','sel.last') };
+}
+
+
+1;
+__END__
+
+sub getSelected
+{
+ my $w = shift;
+ my $val = Tk::catch { $w->get('sel.first','sel.last') };
+ return $val;
+}
+
+
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Dialog.pm b/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Dialog.pm
new file mode 100644
index 00000000000..8173f4a5acc
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Dialog.pm
@@ -0,0 +1,70 @@
+package Tk::Dialog;
+
+use vars qw($VERSION);
+$VERSION = '4.004'; # $Id: //depot/Tkutf8/Tk/Dialog.pm#4 $
+
+# Dialog - a translation of `tk_dialog' from Tcl/Tk to TkPerl (based on
+# John Stoffel's idea).
+#
+# Stephen O. Lidie, Lehigh University Computing Center. 94/12/27
+# lusol@Lehigh.EDU
+
+# Documentation after __END__
+
+use Carp;
+use strict;
+use base qw(Tk::DialogBox);
+
+Construct Tk::Widget 'Dialog';
+
+sub Populate
+{
+
+ # Dialog object constructor. Uses `new' method from base class
+ # to create object container then creates the dialog toplevel.
+
+ my($cw, $args) = @_;
+
+ $cw->SUPER::Populate($args);
+
+ my ($w_bitmap,$w_but,$pad1,$pad2);
+
+ # Create the Toplevel window and divide it into top and bottom parts.
+
+ my (@pl) = (-side => 'top', -fill => 'both');
+
+ ($pad1, $pad2) =
+ ([-padx => '3m', -pady => '3m'], [-padx => '3m', -pady => '2m']);
+
+
+ $cw->iconname('Dialog');
+
+ my $w_top = $cw->Subwidget('top');
+
+ # Fill the top part with the bitmap and message.
+
+ @pl = (-side => 'left');
+
+ $w_bitmap = $w_top->Label(Name => 'bitmap');
+ $w_bitmap->pack(@pl, @$pad1);
+
+ my $w_msg = $w_top->Label( -wraplength => '3i', -justify => 'left' );
+
+ $w_msg->pack(-side => 'right', -expand => 1, -fill => 'both', @$pad1);
+
+ $cw->Advertise(message => $w_msg);
+ $cw->Advertise(bitmap => $w_bitmap );
+
+ $cw->ConfigSpecs( -image => ['bitmap',undef,undef,undef],
+ -bitmap => ['bitmap',undef,undef,undef],
+ -font => ['message','font','Font', '-*-Times-Medium-R-Normal--*-180-*-*-*-*-*-*'],
+ DEFAULT => ['message',undef,undef,undef]
+ );
+}
+
+1;
+
+__END__
+
+=cut
+
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/DialogBox.pm b/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/DialogBox.pm
new file mode 100644
index 00000000000..13335404e15
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/DialogBox.pm
@@ -0,0 +1,135 @@
+#
+# DialogBox is similar to Dialog except that it allows any widget
+# in the top frame. Widgets can be added with the add method. Currently
+# there exists no way of deleting a widget once it has been added.
+
+package Tk::DialogBox;
+
+use strict;
+use Carp;
+
+use vars qw($VERSION);
+$VERSION = sprintf '4.%03d', q$Revision: #13 $ =~ /\D(\d+)\s*$/;
+
+use base qw(Tk::Toplevel);
+
+Tk::Widget->Construct('DialogBox');
+
+sub Populate {
+ my ($cw, $args) = @_;
+
+ $cw->SUPER::Populate($args);
+ my $buttons = delete $args->{'-buttons'};
+ $buttons = ['OK'] unless defined $buttons;
+ my $default_button = delete $args->{'-default_button'};
+ $default_button = $buttons->[0] unless defined $default_button;
+
+ $cw->{'selected_button'} = '';
+ $cw->transient($cw->Parent->toplevel);
+ $cw->withdraw;
+ if (@$buttons == 1) {
+ $cw->protocol('WM_DELETE_WINDOW' => sub { $cw->{'default_button'}->invoke });
+ } else {
+ $cw->protocol('WM_DELETE_WINDOW' => sub {});
+ }
+
+ # create the two frames
+ my $top = $cw->Component('Frame', 'top');
+ $top->configure(-relief => 'raised', -bd => 1) unless $Tk::platform eq 'MSWin32';
+ my $bot = $cw->Component('Frame', 'bottom');
+ $bot->configure(-relief => 'raised', -bd => 1) unless $Tk::platform eq 'MSWin32';
+ $bot->pack(qw/-side bottom -fill both -ipady 3 -ipadx 3/);
+ $top->pack(qw/-side top -fill both -ipady 3 -ipadx 3 -expand 1/);
+
+ # create a row of buttons in the bottom.
+ my $bl; # foreach my $var: perl > 5.003_08
+ foreach $bl (@$buttons)
+ {
+ my $b = $bot->Button(-text => $bl, -command => sub { $cw->{'selected_button'} = "$bl" } );
+ $b->bind('<Return>' => [ $b, 'Invoke']);
+ $cw->Advertise("B_$bl" => $b);
+ if ($Tk::platform eq 'MSWin32')
+ {
+ $b->configure(-width => 10, -pady => 0);
+ }
+ if ($bl eq $default_button) {
+ if ($Tk::platform eq 'MSWin32') {
+ $b->pack(-side => 'left', -expand => 1, -padx => 1, -pady => 1);
+ } else {
+ my $db = $bot->Frame(-relief => 'sunken', -bd => 1);
+ $b->raise($db);
+ $b->pack(-in => $db, -padx => '2', -pady => '2');
+ $db->pack(-side => 'left', -expand => 1, -padx => 1, -pady => 1);
+ }
+ $cw->{'default_button'} = $b;
+ $cw->bind('<Return>' => [ $b, 'Invoke']);
+ } else {
+ $b->pack(-side => 'left', -expand => 1, -padx => 1, -pady => 1);
+ }
+ }
+ $cw->ConfigSpecs(-command => ['CALLBACK', undef, undef, undef ],
+ -foreground => ['DESCENDANTS', 'foreground','Foreground', 'black'],
+ -background => ['DESCENDANTS', 'background','Background', undef],
+ -focus => ['PASSIVE', undef, undef, undef],
+ -showcommand => ['CALLBACK', undef, undef, undef],
+ );
+ $cw->Delegates('Construct',$top);
+}
+
+sub add {
+ my ($cw, $wnam, @args) = @_;
+ my $w = $cw->Subwidget('top')->$wnam(@args);
+ $cw->Advertise("\L$wnam" => $w);
+ return $w;
+}
+
+sub Wait
+{
+ my $cw = shift;
+ $cw->Callback(-showcommand => $cw);
+ $cw->waitVariable(\$cw->{'selected_button'});
+ $cw->grabRelease;
+ $cw->withdraw;
+ $cw->Callback(-command => $cw->{'selected_button'});
+}
+
+sub Show {
+
+ croak 'DialogBox: "Show" method requires at least 1 argument'
+ if scalar @_ < 1;
+ my $cw = shift;
+ my ($grab) = @_;
+ my $old_focus = $cw->focusSave;
+ my $old_grab = $cw->grabSave;
+
+ shift if defined $grab && length $grab && ($grab =~ /global/);
+ $cw->Popup(@_);
+
+ Tk::catch {
+ if (defined $grab && length $grab && ($grab =~ /global/)) {
+ $cw->grabGlobal;
+ } else {
+ $cw->grab;
+ }
+ };
+ if (my $focusw = $cw->cget(-focus)) {
+ $focusw->focus;
+ } elsif (defined $cw->{'default_button'}) {
+ $cw->{'default_button'}->focus;
+ } else {
+ $cw->focus;
+ }
+ $cw->Wait;
+ &$old_focus;
+ &$old_grab;
+ return $cw->{'selected_button'};
+}
+
+sub Exit
+{
+ my $cw = shift;
+ #kill the dialogbox, by faking a 'DONE'
+ $cw->{'selected_button'} = $cw->{'default_button'}->cget(-text);
+}
+
+1;
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Entry.pm b/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Entry.pm
new file mode 100644
index 00000000000..51b3f0c6767
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Entry.pm
@@ -0,0 +1,615 @@
+package Tk::Entry;
+
+# Converted from entry.tcl --
+#
+# This file defines the default bindings for Tk entry widgets.
+#
+# @(#) entry.tcl 1.22 94/12/17 16:05:14
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+# This program is free software; you can redistribute it and/or
+
+use vars qw($VERSION);
+use strict;
+$VERSION = sprintf '4.%03d',q$Revision: #17 $ =~ /#(\d+)/;
+
+# modify it under the same terms as Perl itself, subject
+# to additional disclaimer in license.terms due to partial
+# derivation from Tk4.0 sources.
+
+use Tk::Widget ();
+use Tk::Clipboard ();
+use base qw(Tk::Clipboard Tk::Widget);
+
+import Tk qw(Ev $XS_VERSION);
+
+Construct Tk::Widget 'Entry';
+
+bootstrap Tk::Entry;
+
+sub Tk_cmd { \&Tk::entry }
+
+Tk::Methods('bbox','delete','get','icursor','index','insert','scan',
+ 'selection','validate','xview');
+
+use Tk::Submethods ( 'selection' => [qw(clear range adjust present to from)],
+ 'xview' => [qw(moveto scroll)],
+ );
+
+sub wordstart
+{my ($w,$pos) = @_;
+ my $string = $w->get;
+ $pos = $w->index('insert')-1 unless(defined $pos);
+ $string = substr($string,0,$pos);
+ $string =~ s/\S*$//;
+ length $string;
+}
+
+sub wordend
+{my ($w,$pos) = @_;
+ my $string = $w->get;
+ my $anc = length $string;
+ $pos = $w->index('insert') unless(defined $pos);
+ $string = substr($string,$pos);
+ $string =~ s/^(?:((?=\s)\s*|(?=\S)\S*))//x;
+ $anc - length($string);
+}
+
+sub deltainsert
+{
+ my ($w,$d) = @_;
+ return $w->index('insert')+$d;
+}
+
+#
+# Bind --
+# This procedure is invoked the first time the mouse enters an
+# entry widget or an entry widget receives the input focus. It creates
+# all of the class bindings for entries.
+#
+# Arguments:
+# event - Indicates which event caused the procedure to be invoked
+# (Enter or FocusIn). It is used so that we can carry out
+# the functions of that event in addition to setting up
+# bindings.
+sub ClassInit
+{
+ my ($class,$mw) = @_;
+
+ $class->SUPER::ClassInit($mw);
+
+ # <<Cut>>, <<Copy>> and <<Paste>> defined in Tk::Clipboard
+ $mw->bind($class,'<<Clear>>' => sub {
+ my $w = shift;
+ $w->delete("sel.first", "sel.last");
+ });
+ $mw->bind($class,'<<PasteSelection>>' => [sub {
+ my($w, $x) = @_;
+ # XXX logic in Tcl/Tk version screwed up?
+ if (!$Tk::strictMotif && !$Tk::mouseMoved) {
+ $w->Paste($x);
+ }
+ }, Ev('x')]);
+
+ # Standard Motif bindings:
+ # The <Escape> binding is different from the Tcl/Tk version:
+ $mw->bind($class,'<Escape>','selectionClear');
+
+ $mw->bind($class,'<1>',['Button1',Ev('x'),Ev('y')]);
+ $mw->bind($class,'<ButtonRelease-1>',['Button1Release',Ev('x'),Ev('y')]);
+ $mw->bind($class,'<B1-Motion>',['Motion',Ev('x'),Ev('y')]);
+
+ $mw->bind($class,'<Double-1>',['MouseSelect',Ev('x'),'word','sel.first']);
+ $mw->bind($class,'<Double-Shift-1>',['MouseSelect',Ev('x'),'word']);
+ $mw->bind($class,'<Triple-1>',['MouseSelect',Ev('x'),'line',0]);
+ $mw->bind($class,'<Triple-Shift-1>',['MouseSelect',Ev('x'),'line']);
+
+ $mw->bind($class,'<Shift-1>','Shift_1');
+
+
+ $mw->bind($class,'<B1-Leave>',['AutoScan',Ev('x')]);
+ $mw->bind($class,'<B1-Enter>','CancelRepeat');
+ $mw->bind($class,'<Control-1>','Control_1');
+ $mw->bind($class,'<Left>', ['SetCursor',Ev('deltainsert',-1)]);
+ $mw->bind($class,'<Right>',['SetCursor',Ev('deltainsert',1)]);
+ $mw->bind($class,'<Shift-Left>',['KeySelect',Ev('deltainsert',-1)]);
+ $mw->bind($class,'<Shift-Right>',['KeySelect',Ev('deltainsert',1)]);
+ $mw->bind($class,'<Control-Left>',['SetCursor',Ev(['wordstart'])]);
+ $mw->bind($class,'<Control-Right>',['SetCursor',Ev(['wordend'])]);
+ $mw->bind($class,'<Shift-Control-Left>',['KeySelect',Ev(['wordstart'])]);
+ $mw->bind($class,'<Shift-Control-Right>',['KeySelect',Ev(['wordend'])]);
+ $mw->bind($class,'<Home>',['SetCursor',0]);
+ $mw->bind($class,'<Shift-Home>',['KeySelect',0]);
+ $mw->bind($class,'<End>',['SetCursor','end']);
+ $mw->bind($class,'<Shift-End>',['KeySelect','end']);
+ $mw->bind($class,'<Delete>','Delete');
+
+ $mw->bind($class,'<BackSpace>','Backspace');
+
+ $mw->bind($class,'<Control-space>',['selectionFrom','insert']);
+ $mw->bind($class,'<Select>',['selectionFrom','insert']);
+ $mw->bind($class,'<Control-Shift-space>',['selectionAdjust','insert']);
+ $mw->bind($class,'<Shift-Select>',['selectionAdjust','insert']);
+
+ $mw->bind($class,'<Control-slash>',['selectionRange',0,'end']);
+ $mw->bind($class,'<Control-backslash>','selectionClear');
+
+ # $class->clipboardOperations($mw,qw[Copy Cut Paste]);
+
+ $mw->bind($class,'<KeyPress>', ['Insert',Ev('A')]);
+
+ # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
+ # Otherwise, if a widget binding for one of these is defined, the
+ # <KeyPress> class binding will also fire and insert the character,
+ # which is wrong. Ditto for Return, and Tab.
+
+ $mw->bind($class,'<Alt-KeyPress>' ,'NoOp');
+ $mw->bind($class,'<Meta-KeyPress>' ,'NoOp');
+ $mw->bind($class,'<Control-KeyPress>' ,'NoOp');
+ $mw->bind($class,'<Return>' ,'NoOp');
+ $mw->bind($class,'<KP_Enter>' ,'NoOp');
+ $mw->bind($class,'<Tab>' ,'NoOp');
+ if ($mw->windowingsystem =~ /^(?:classic|aqua)$/)
+ {
+ $mw->bind($class,'<Command-KeyPress>', 'NoOp');
+ }
+
+ # On Windows, paste is done using Shift-Insert. Shift-Insert already
+ # generates the <<Paste>> event, so we don't need to do anything here.
+ if ($Tk::platform ne 'MSWin32')
+ {
+ $mw->bind($class,'<Insert>','InsertSelection');
+ }
+
+ if (!$Tk::strictMotif)
+ {
+ # Additional emacs-like bindings:
+ $mw->bind($class,'<Control-a>',['SetCursor',0]);
+ $mw->bind($class,'<Control-b>',['SetCursor',Ev('deltainsert',-1)]);
+ $mw->bind($class,'<Control-d>',['delete','insert']);
+ $mw->bind($class,'<Control-e>',['SetCursor','end']);
+ $mw->bind($class,'<Control-f>',['SetCursor',Ev('deltainsert',1)]);
+ $mw->bind($class,'<Control-h>','Backspace');
+ $mw->bind($class,'<Control-k>',['delete','insert','end']);
+
+ $mw->bind($class,'<Control-t>','Transpose');
+
+ # XXX The original Tcl/Tk bindings use NextWord/PreviousWord instead
+ $mw->bind($class,'<Meta-b>',['SetCursor',Ev(['wordstart'])]);
+ $mw->bind($class,'<Meta-d>',['delete','insert',Ev(['wordend'])]);
+ $mw->bind($class,'<Meta-f>',['SetCursor',Ev(['wordend'])]);
+ $mw->bind($class,'<Meta-BackSpace>',['delete',Ev(['wordstart']),'insert']);
+ $mw->bind($class,'<Meta-Delete>',['delete',Ev(['wordstart']),'insert']);
+
+ # A few additional bindings from John Ousterhout.
+# XXX conflicts with <<Copy>>: $mw->bind($class,'<Control-w>',['delete',Ev(['wordstart']),'insert']);
+ $mw->bind($class,'<2>','Button_2');
+ $mw->bind($class,'<B2-Motion>','B2_Motion');
+# XXX superseded by <<PasteSelection>>: $mw->bind($class,'<ButtonRelease-2>','ButtonRelease_2');
+ }
+ return $class;
+}
+
+
+sub Shift_1
+{
+ my $w = shift;
+ my $Ev = $w->XEvent;
+ $Tk::selectMode = 'char';
+ $w->selectionAdjust('@' . $Ev->x)
+}
+
+
+sub Control_1
+{
+ my $w = shift;
+ my $Ev = $w->XEvent;
+ $w->icursor('@' . $Ev->x)
+}
+
+
+sub Delete
+{
+ my $w = shift;
+ if ($w->selectionPresent)
+ {
+ $w->deleteSelected
+ }
+ else
+ {
+ $w->delete('insert')
+ }
+}
+
+
+sub InsertSelection
+{
+ my $w = shift;
+ eval {local $SIG{__DIE__}; $w->Insert($w->GetSelection)}
+}
+
+
+# Original is ::tk::EntryScanMark
+sub Button_2
+{
+ my $w = shift;
+ my $Ev = $w->XEvent;
+ $w->scan('mark',$Ev->x);
+ $Tk::x = $Ev->x;
+ $Tk::y = $Ev->y;
+ $Tk::mouseMoved = 0
+}
+
+
+# Original is ::tk::EntryScanDrag
+sub B2_Motion
+{
+ my $w = shift;
+ my $Ev = $w->XEvent;
+ # Make sure these exist, as some weird situations can trigger the
+ # motion binding without the initial press. [Tcl/Tk Bug #220269]
+ if (!defined $Tk::x) { $Tk::x = $Ev->x }
+ if (abs(($Ev->x-$Tk::x)) > 2)
+ {
+ $Tk::mouseMoved = 1
+ }
+ $w->scan('dragto',$Ev->x)
+}
+
+
+# XXX Not needed anymore
+sub ButtonRelease_2
+{
+ my $w = shift;
+ my $Ev = $w->XEvent;
+ if (!$Tk::mouseMoved)
+ {
+ eval
+ {local $SIG{__DIE__};
+ $w->insert('insert',$w->SelectionGet);
+ $w->SeeInsert;
+ }
+ }
+}
+
+sub Button1Release
+{
+ shift->CancelRepeat;
+}
+
+# ::tk::EntryClosestGap --
+# Given x and y coordinates, this procedure finds the closest boundary
+# between characters to the given coordinates and returns the index
+# of the character just after the boundary.
+#
+# Arguments:
+# w - The entry window.
+# x - X-coordinate within the window.
+sub ClosestGap
+{
+ my($w, $x) = @_;
+ my $pos = $w->index('@'.$x);
+ my @bbox = $w->bbox($pos);
+ if ($x - $bbox[0] < $bbox[2] / 2)
+ {
+ return $pos;
+ }
+ $pos + 1;
+}
+
+# Button1 --
+# This procedure is invoked to handle button-1 presses in entry
+# widgets. It moves the insertion cursor, sets the selection anchor,
+# and claims the input focus.
+#
+# Arguments:
+# w - The entry window in which the button was pressed.
+# x - The x-coordinate of the button press.
+sub Button1
+{
+ my $w = shift;
+ my $x = shift;
+ $Tk::selectMode = 'char';
+ $Tk::mouseMoved = 0;
+ $Tk::pressX = $x;
+ $w->icursor($w->ClosestGap($x));
+ $w->selectionFrom('insert');
+ $w->selectionClear;
+ if ($w->cget('-state') ne 'disabled')
+ {
+ $w->focus()
+ }
+}
+
+sub Motion
+{
+ my ($w,$x,$y) = @_;
+ $Tk::x = $x; # XXX ?
+ $w->MouseSelect($x);
+}
+
+# MouseSelect --
+# This procedure is invoked when dragging out a selection with
+# the mouse. Depending on the selection mode (character, word,
+# line) it selects in different-sized units. This procedure
+# ignores mouse motions initially until the mouse has moved from
+# one character to another or until there have been multiple clicks.
+#
+# Arguments:
+# w - The entry window in which the button was pressed.
+# x - The x-coordinate of the mouse.
+sub MouseSelect
+{
+
+ my $w = shift;
+ my $x = shift;
+ return if UNIVERSAL::isa($w, 'Tk::Spinbox') and $w->{_element} ne 'entry';
+ $Tk::selectMode = shift if (@_);
+ my $cur = $w->index($w->ClosestGap($x));
+ return unless defined $cur;
+ my $anchor = $w->index('anchor');
+ return unless defined $anchor;
+ $Tk::pressX ||= $x; # XXX Better use "if !defined $Tk::pressX"?
+ if (($cur != $anchor) || (abs($Tk::pressX - $x) >= 3))
+ {
+ $Tk::mouseMoved = 1
+ }
+ my $mode = $Tk::selectMode;
+ return unless $mode;
+ if ($mode eq 'char')
+ {
+ # The Tcl version uses selectionRange here XXX
+ if ($Tk::mouseMoved)
+ {
+ if ($cur < $anchor)
+ {
+ $w->selectionTo($cur)
+ }
+ else
+ {
+ $w->selectionTo($cur+1)
+ }
+ }
+ }
+ elsif ($mode eq 'word')
+ {
+ # The Tcl version uses tcl_wordBreakBefore/After here XXX
+ if ($cur < $w->index('anchor'))
+ {
+ $w->selectionRange($w->wordstart($cur),$w->wordend($anchor-1))
+ }
+ else
+ {
+ $w->selectionRange($w->wordstart($anchor),$w->wordend($cur))
+ }
+ }
+ elsif ($mode eq 'line')
+ {
+ $w->selectionRange(0,'end')
+ }
+ if (@_)
+ {
+ my $ipos = shift;
+ eval {local $SIG{__DIE__}; $w->icursor($ipos) };
+ }
+ $w->idletasks;
+}
+# ::tk::EntryPaste --
+# This procedure sets the insertion cursor to the current mouse position,
+# pastes the selection there, and sets the focus to the window.
+#
+# Arguments:
+# w - The entry window.
+# x - X position of the mouse.
+sub Paste
+{
+ my($w, $x) = @_;
+ $w->icursor($w->ClosestGap($x));
+ eval { local $SIG{__DIE__};
+ $w->insert("insert", $w->GetSelection);
+ $w->SeeInsert; # Perl/Tk extension
+ };
+ if ($w->cget(-state) ne 'disabled')
+ {
+ $w->focus;
+ }
+}
+# AutoScan --
+# This procedure is invoked when the mouse leaves an entry window
+# with button 1 down. It scrolls the window left or right,
+# depending on where the mouse is, and reschedules itself as an
+# 'after' command so that the window continues to scroll until the
+# mouse moves back into the window or the mouse button is released.
+#
+# Arguments:
+# w - The entry window.
+# x - The x-coordinate of the mouse when it left the window.
+sub AutoScan
+{
+ my $w = shift;
+ my $x = shift;
+ return if !Tk::Exists($w);
+ if ($x >= $w->width)
+ {
+ $w->xview('scroll',2,'units')
+ }
+ elsif ($x < 0)
+ {
+ $w->xview('scroll',-2,'units')
+ }
+ else
+ {
+ return;
+ }
+ $w->MouseSelect($x);
+ $w->RepeatId($w->after(50,['AutoScan',$w,$x]))
+}
+# KeySelect
+# This procedure is invoked when stroking out selections using the
+# keyboard. It moves the cursor to a new position, then extends
+# the selection to that position.
+#
+# Arguments:
+# w - The entry window.
+# new - A new position for the insertion cursor (the cursor hasn't
+# actually been moved to this position yet).
+sub KeySelect
+{
+ my $w = shift;
+ my $new = shift;
+ if (!$w->selectionPresent)
+ {
+ $w->selectionFrom('insert');
+ $w->selectionTo($new)
+ }
+ else
+ {
+ $w->selectionAdjust($new)
+ }
+ $w->icursor($new);
+ $w->SeeInsert;
+}
+# Insert --
+# Insert a string into an entry at the point of the insertion cursor.
+# If there is a selection in the entry, and it covers the point of the
+# insertion cursor, then delete the selection before inserting.
+#
+# Arguments:
+# w - The entry window in which to insert the string
+# s - The string to insert (usually just a single character)
+sub Insert
+{
+ my $w = shift;
+ my $s = shift;
+ return unless (defined $s && $s ne '');
+ eval
+ {local $SIG{__DIE__};
+ my $insert = $w->index('insert');
+ if ($w->index('sel.first') <= $insert && $w->index('sel.last') >= $insert)
+ {
+ $w->deleteSelected
+ }
+ };
+ $w->insert('insert',$s);
+ $w->SeeInsert
+}
+# Backspace --
+# Backspace over the character just before the insertion cursor.
+#
+# Arguments:
+# w - The entry window in which to backspace.
+sub Backspace
+{
+ my $w = shift;
+ if ($w->selectionPresent)
+ {
+ $w->deleteSelected
+ }
+ else
+ {
+ my $x = $w->index('insert')-1;
+ $w->delete($x) if ($x >= 0);
+ # XXX Missing repositioning part from Tcl/Tk source
+ }
+}
+# SeeInsert
+# Make sure that the insertion cursor is visible in the entry window.
+# If not, adjust the view so that it is.
+#
+# Arguments:
+# w - The entry window.
+sub SeeInsert
+{
+ my $w = shift;
+ my $c = $w->index('insert');
+#
+# Probably a bug in your version of tcl/tk (I've not this problem
+# when I test Entry in the widget demo for tcl/tk)
+# index('\@0') give always 0. Consequence :
+# if you make <Control-E> or <Control-F> view is adapted
+# but with <Control-A> or <Control-B> view is not adapted
+#
+ my $left = $w->index('@0');
+ if ($left > $c)
+ {
+ $w->xview($c);
+ return;
+ }
+ my $x = $w->width;
+ while ($w->index('@' . $x) <= $c && $left < $c)
+ {
+ $left += 1;
+ $w->xview($left)
+ }
+}
+# SetCursor
+# Move the insertion cursor to a given position in an entry. Also
+# clears the selection, if there is one in the entry, and makes sure
+# that the insertion cursor is visible.
+#
+# Arguments:
+# w - The entry window.
+# pos - The desired new position for the cursor in the window.
+sub SetCursor
+{
+ my $w = shift;
+ my $pos = shift;
+ $w->icursor($pos);
+ $w->selectionClear;
+ $w->SeeInsert;
+}
+# Transpose
+# This procedure implements the 'transpose' function for entry widgets.
+# It tranposes the characters on either side of the insertion cursor,
+# unless the cursor is at the end of the line. In this case it
+# transposes the two characters to the left of the cursor. In either
+# case, the cursor ends up to the right of the transposed characters.
+#
+# Arguments:
+# w - The entry window.
+sub Transpose
+{
+ my $w = shift;
+ my $i = $w->index('insert');
+ $i++ if ($i < $w->index('end'));
+ my $first = $i-2;
+ return if ($first < 0);
+ my $str = $w->get;
+ my $new = substr($str,$i-1,1) . substr($str,$first,1);
+ $w->delete($first,$i);
+ $w->insert('insert',$new);
+ $w->SeeInsert;
+}
+
+sub tabFocus
+{
+ my $w = shift;
+ $w->selectionRange(0,'end');
+ $w->icursor('end');
+ $w->SUPER::tabFocus;
+}
+
+# ::tk::EntryGetSelection --
+#
+# Returns the selected text of the entry with respect to the -show option.
+#
+# Arguments:
+# w - The entry window from which the text to get
+sub getSelected
+{
+ my $w = shift;
+ return undef unless $w->selectionPresent;
+ my $str = $w->get;
+ my $show = $w->cget('-show');
+ $str = $show x length($str) if (defined $show);
+ my $s = $w->index('sel.first');
+ my $e = $w->index('sel.last');
+ return substr($str,$s,$e-$s);
+}
+
+
+1;
+
+__END__
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Radiobutton.pm b/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Radiobutton.pm
new file mode 100644
index 00000000000..d09d41b4208
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/Tk/Radiobutton.pm
@@ -0,0 +1,45 @@
+# Conversion from Tk4.0 button.tcl competed.
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+# This program is free software; you can redistribute it and/or
+
+package Tk::Radiobutton;
+
+use vars qw($VERSION);
+$VERSION = '4.006'; # $Id: //depot/Tkutf8/Tk/Radiobutton.pm#6 $
+
+# modify it under the same terms as Perl itself, subject
+# to additional disclaimer in license.terms due to partial
+# derivation from Tk4.0 sources.
+
+require Tk::Button;
+
+
+use base qw(Tk::Button);
+Construct Tk::Widget 'Radiobutton';
+
+sub Tk_cmd { \&Tk::radiobutton }
+
+sub CreateOptions
+{
+ return (shift->SUPER::CreateOptions,'-variable');
+}
+
+sub ClassInit
+{
+ my ($class,$mw) = @_;
+ $mw->bind($class,'<Enter>', 'Enter');
+ $mw->bind($class,'<Leave>', 'Leave');
+ $mw->bind($class,'<1>', 'Invoke');
+ $mw->bind($class,'<space>', 'Invoke');
+ return $class;
+}
+
+sub Invoke
+{
+ my $w = shift;
+ $w->invoke() unless($w->cget('-state') eq 'disabled');
+}
+
+1;
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/Env.pm b/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/Env.pm
new file mode 100644
index 00000000000..c5420718175
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/Env.pm
@@ -0,0 +1,169 @@
+package Win32::Env;
+our $VERSION='0.01';
+
+=head1 NAME
+
+Win32::Env - get and set global system and user enviroment varialbes under Win32.
+
+=head1 VERSION
+
+Version 0.01
+
+=head1 SYNOPSIS
+
+ use Win32::Env;
+
+ my $user_path=GetEnv(ENV_USER, 'PATH');
+ # Limit PATH for other programs to system path and specified directory for 10 seconds
+ SetEnv(ENV_USER, 'PATH', 'C:\\Perl\\bin');
+ BroadcastEnv();
+ sleep(10);
+ # Restore everything back
+ SetEnv(ENV_USER, 'PATH', $user_path);
+ BroadcastEnv();
+
+=cut
+
+
+use warnings;
+use strict;
+
+use Win32::TieRegistry(FixSzNulls=>1);
+
+use Exporter qw(import);
+our @EXPORT=qw(SetEnv GetEnv BroadcastEnv ENV_USER ENV_SYSTEM);
+
+use constant ENV_USER =>0;
+use constant ENV_SYSTEM =>1;
+
+use constant ENVKEY_USER => 'HKEY_CURRENT_USER\\Environment';
+use constant ENVKEY_SYSTEM => 'HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment';
+
+=head1 EXPORT
+
+SetEnv GetEnv BroadcastEnv ENV_USER ENV_SYSTEM
+
+=head1 FUNCTIONS
+
+=cut
+
+sub _NWA{
+ my $lib=shift,
+ my @proto=@_;
+ require Win32::API;
+ return(new Win32::API($lib, @proto) or die "Can't import API $proto[0] from $lib: $^E\n");
+}
+
+# TODO: error/sanity checks for other args
+sub _num_to_key($){
+ my $sysusr=shift;
+ if($sysusr==ENV_USER) { $sysusr=ENVKEY_USER; }
+ elsif($sysusr==ENV_SYSTEM) { $sysusr=ENVKEY_SYSTEM; }
+ else { return; } # And Carp!
+ return $sysusr;
+}
+
+=head2 SetEnv($sys_or_usr, $variable, $value)
+
+Sets variable in enviroment to specified value. C<$sys_or_usr> specifies either
+current user's enviroment with exported constant C<ENV_USER> or system's global environment
+with C<ENV_SYSTEM>.
+
+=cut
+
+sub SetEnv($$$){
+ my ($sysusr, $var, $value)=@_;
+ $sysusr=(_num_to_key($sysusr) or return);
+ $Registry->{"$sysusr\\$var"}=$value;
+}
+
+=head2 GetEnv($sys_or_usr, $variable)
+
+Returns value of enviroment variable. Its difference from plain C<$ENV{$variable}> is that
+you can (and must) select current user's or system's global enviroment with C<$sys_or_usr>.
+It is selected with same constants as in L<#SetEnv>.
+
+=cut
+
+sub GetEnv($$){
+ my ($sysusr, $var, $value)=@_;
+ $sysusr=(_num_to_key($sysusr) or return);
+ return $Registry->{"$sysusr\\$var"};
+}
+
+=head2 BroadcastEnv()
+
+Broadcasts system message that enviroment has changed. This will make system processes responsible for
+enviroment aware of change, otherwise your changes will be noticed only on next reboot. Note that most
+user programs still won't see changes until next run and that your changes will not be available in C<%ENV>
+to either your process or any processes you spawn. Assign to C<%ENV> yourself in addition to C<SetEnv> if
+need it.
+
+=cut
+
+sub BroadcastEnv(){
+ use constant HWND_BROADCAST => 0xffff;
+ use constant WM_SETTINGCHANGE => 0x001A;
+ print "Broadcasting \"Enviroment settings changed\" message...\n";
+ # SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0, (LPARAM) "Environment", SMTO_ABORTIFHUNG, 5000, &dwReturnValue);
+ my $SendMessage=_NWA('user32', 'SendMessage', 'LLPP', 'L');
+ $SendMessage->Call(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 'Environment');
+ print "Broadcast complete.\n";
+}
+
+1;
+
+=head1 AUTHOR
+
+Oleg "Rowaa[SR13]" V. Volkov, C<< <ROWAA at cpan.org> >>
+
+=head1 BUGS / TODO
+
+Only first argument to C<GetEnv>/C<SetEnv> is checked right now. Considering that functions work with
+Windows registry, more sanity checks should be added to other arguments.
+
+Any limitations of Win32::TieRegistry apply to this module too, because it is used to write all
+changes to the registry.
+
+Please report any bugs or feature requests to
+C<bug-win32-env at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Win32-Env>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Win32::Env
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Win32-Env>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Win32-Env>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Win32-Env>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Win32-Env>
+
+=back
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2006 Oleg "Rowaa[SR13]" V. Volkov, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/CancelRepeat.al b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/CancelRepeat.al
new file mode 100644
index 00000000000..d0d6bb1b2a3
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/CancelRepeat.al
@@ -0,0 +1,15 @@
+# NOTE: Derived from blib\lib\Tk.pm.
+# Changes made here will be lost when autosplit is run again.
+# See AutoSplit.pm.
+package Tk;
+
+#line 491 "blib\lib\Tk.pm (autosplit into blib\lib\auto\Tk\CancelRepeat.al)"
+sub CancelRepeat
+{
+ my $w = shift->MainWindow;
+ my $id = delete $w->{_afterId_};
+ $w->after('cancel',$id) if (defined $id);
+}
+
+# end of Tk::CancelRepeat
+1;
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Clipboard/autosplit.ix b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Clipboard/autosplit.ix
new file mode 100644
index 00000000000..9831f74facb
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Clipboard/autosplit.ix
@@ -0,0 +1,6 @@
+# Index created by AutoSplit for blib\lib\Tk\Clipboard.pm
+# (file acts as timestamp)
+package Tk::Clipboard;
+sub getSelected
+;
+1;
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Clipboard/getSelected.al b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Clipboard/getSelected.al
new file mode 100644
index 00000000000..44ba7b74bf0
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Clipboard/getSelected.al
@@ -0,0 +1,15 @@
+# NOTE: Derived from blib\lib\Tk\Clipboard.pm.
+# Changes made here will be lost when autosplit is run again.
+# See AutoSplit.pm.
+package Tk::Clipboard;
+
+#line 115 "blib\lib\Tk\Clipboard.pm (autosplit into blib\lib\auto\Tk\Clipboard\getSelected.al)"
+sub getSelected
+{
+ my $w = shift;
+ my $val = Tk::catch { $w->get('sel.first','sel.last') };
+ return $val;
+}
+
+1;
+# end of Tk::Clipboard::getSelected
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Entry/Entry.bs b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Entry/Entry.bs
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Entry/Entry.bs
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Entry/Entry.dll b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Entry/Entry.dll
new file mode 100755
index 00000000000..9b1c07a7792
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Entry/Entry.dll
Binary files differ
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Error.al b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Error.al
new file mode 100644
index 00000000000..7efe2c7043d
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Error.al
@@ -0,0 +1,20 @@
+# NOTE: Derived from blib\lib\Tk.pm.
+# Changes made here will be lost when autosplit is run again.
+# See AutoSplit.pm.
+package Tk;
+
+#line 479 "blib\lib\Tk.pm (autosplit into blib\lib\auto\Tk\Error.al)"
+sub Error
+{my $w = shift;
+ my $error = shift;
+ if (Exists($w))
+ {
+ my $grab = $w->grab('current');
+ $grab->Unbusy if (defined $grab);
+ }
+ chomp($error);
+ warn "Tk::Error: $error\n " . join("\n ",@_)."\n";
+}
+
+# end of Tk::Error
+1;
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/RepeatId.al b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/RepeatId.al
new file mode 100644
index 00000000000..e71d2a337a0
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/RepeatId.al
@@ -0,0 +1,16 @@
+# NOTE: Derived from blib\lib\Tk.pm.
+# Changes made here will be lost when autosplit is run again.
+# See AutoSplit.pm.
+package Tk;
+
+#line 498 "blib\lib\Tk.pm (autosplit into blib\lib\auto\Tk\RepeatId.al)"
+sub RepeatId
+{
+ my ($w,$id) = @_;
+ $w = $w->MainWindow;
+ $w->CancelRepeat;
+ $w->{_afterId_} = $id;
+}
+
+# end of Tk::RepeatId
+1;
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/AnchorAdjust.al b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/AnchorAdjust.al
new file mode 100644
index 00000000000..538612878ed
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/AnchorAdjust.al
@@ -0,0 +1,17 @@
+# NOTE: Derived from blib\lib\Tk\Wm.pm.
+# Changes made here will be lost when autosplit is run again.
+# See AutoSplit.pm.
+package Tk::Wm;
+
+#line 87 "blib\lib\Tk\Wm.pm (autosplit into blib\lib\auto\Tk\Wm\AnchorAdjust.al)"
+sub AnchorAdjust
+{
+ my ($anchor,$X,$Y,$w,$h) = @_;
+ $anchor = 'c' unless (defined $anchor);
+ $Y += ($anchor =~ /s/) ? $h : ($anchor =~ /n/) ? 0 : $h/2;
+ $X += ($anchor =~ /e/) ? $w : ($anchor =~ /w/) ? 0 : $w/2;
+ return ($X,$Y);
+}
+
+# end of Tk::Wm::AnchorAdjust
+1;
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/FullScreen.al b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/FullScreen.al
new file mode 100644
index 00000000000..4d5702cc60d
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/FullScreen.al
@@ -0,0 +1,29 @@
+# NOTE: Derived from blib\lib\Tk\Wm.pm.
+# Changes made here will be lost when autosplit is run again.
+# See AutoSplit.pm.
+package Tk::Wm;
+
+#line 138 "blib\lib\Tk\Wm.pm (autosplit into blib\lib\auto\Tk\Wm\FullScreen.al)"
+sub FullScreen
+{
+ my $w = shift;
+ my $over = (@_) ? shift : 0;
+ my $width = $w->screenwidth;
+ my $height = $w->screenheight;
+ $w->GeometryRequest($width,$height);
+ $w->overrideredirect($over & 1);
+ $w->Post(0,0);
+ $w->update;
+ if ($over & 2)
+ {
+ my $x = $w->rootx;
+ my $y = $w->rooty;
+ $width -= 2*$x;
+ $height -= $x + $y;
+ $w->GeometryRequest($width,$height);
+ $w->update;
+ }
+}
+
+# end of Tk::Wm::FullScreen
+1;
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/Popup.al b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/Popup.al
new file mode 100644
index 00000000000..3f460c5bac6
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/Popup.al
@@ -0,0 +1,50 @@
+# NOTE: Derived from blib\lib\Tk\Wm.pm.
+# Changes made here will be lost when autosplit is run again.
+# See AutoSplit.pm.
+package Tk::Wm;
+
+#line 96 "blib\lib\Tk\Wm.pm (autosplit into blib\lib\auto\Tk\Wm\Popup.al)"
+sub Popup
+{
+ my $w = shift;
+ $w->configure(@_) if @_;
+ $w->idletasks;
+ my ($mw,$mh) = ($w->reqwidth,$w->reqheight);
+ my ($rx,$ry,$rw,$rh) = (0,0,0,0);
+ my $base = $w->cget('-popover');
+ my $outside = 0;
+ if (defined $base)
+ {
+ if ($base eq 'cursor')
+ {
+ ($rx,$ry) = $w->pointerxy;
+ }
+ else
+ {
+ $rx = $base->rootx;
+ $ry = $base->rooty;
+ $rw = $base->Width;
+ $rh = $base->Height;
+ }
+ }
+ else
+ {
+ my $sc = ($w->parent) ? $w->parent->toplevel : $w;
+ $rx = -$sc->vrootx;
+ $ry = -$sc->vrooty;
+ $rw = $w->screenwidth;
+ $rh = $w->screenheight;
+ }
+ my ($X,$Y) = AnchorAdjust($w->cget('-overanchor'),$rx,$ry,$rw,$rh);
+ ($X,$Y) = AnchorAdjust($w->cget('-popanchor'),$X,$Y,-$mw,-$mh);
+ # adjust to not cross screen borders
+ if ($X < 0) { $X = 0 }
+ if ($Y < 0) { $Y = 0 }
+ if ($mw > $w->screenwidth) { $X = 0 }
+ if ($mh > $w->screenheight) { $Y = 0 }
+ $w->Post($X,$Y);
+ $w->waitVisibility;
+}
+
+# end of Tk::Wm::Popup
+1;
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/Post.al b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/Post.al
new file mode 100644
index 00000000000..f3f5c8e3e08
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/Post.al
@@ -0,0 +1,20 @@
+# NOTE: Derived from blib\lib\Tk\Wm.pm.
+# Changes made here will be lost when autosplit is run again.
+# See AutoSplit.pm.
+package Tk::Wm;
+
+#line 75 "blib\lib\Tk\Wm.pm (autosplit into blib\lib\auto\Tk\Wm\Post.al)"
+sub Post
+{
+ my ($w,$X,$Y) = @_;
+ $X = int($X);
+ $Y = int($Y);
+ $w->positionfrom('user');
+ $w->geometry("+$X+$Y");
+ # $w->MoveToplevelWindow($X,$Y);
+ $w->deiconify;
+ $w->raise;
+}
+
+# end of Tk::Wm::Post
+1;
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/iconposition.al b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/iconposition.al
new file mode 100644
index 00000000000..9254968f61c
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Tk/Wm/iconposition.al
@@ -0,0 +1,24 @@
+# NOTE: Derived from blib\lib\Tk\Wm.pm.
+# Changes made here will be lost when autosplit is run again.
+# See AutoSplit.pm.
+package Tk::Wm;
+
+#line 159 "blib\lib\Tk\Wm.pm (autosplit into blib\lib\auto\Tk\Wm\iconposition.al)"
+sub iconposition
+{
+ my $w = shift;
+ if (@_ == 1)
+ {
+ return $w->wm('iconposition',$1,$2) if $_[0] =~ /^(\d+),(\d+)$/;
+ if ($_[0] =~ /^([+-])(\d+)([+-])(\d+)$/)
+ {
+ my $x = ($1 eq '-') ? $w->screenwidth-$2 : $2;
+ my $y = ($3 eq '-') ? $w->screenheight-$4 : $4;
+ return $w->wm('iconposition',$x,$y);
+ }
+ }
+ $w->wm('iconposition',@_);
+}
+
+1;
+# end of Tk::Wm::iconposition
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/unicore/lib/gc_sc/Uppercas.pl b/Master/tlpkg/lib/Perl5_lib-TL_inst/unicore/lib/gc_sc/Uppercas.pl
new file mode 100644
index 00000000000..4778dc3ab52
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/unicore/lib/gc_sc/Uppercas.pl
@@ -0,0 +1,490 @@
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables from e.g. UnicodeData.txt.
+# Any changes made here will be lost!
+
+#
+# This file supports:
+# \p{Uppercase} (and fuzzy permutations)
+#
+# Meaning: [\p{Lu}\p{Other_Uppercase}]
+#
+return <<'END';
+0041 005A
+00C0 00D6
+00D8 00DE
+0100
+0102
+0104
+0106
+0108
+010A
+010C
+010E
+0110
+0112
+0114
+0116
+0118
+011A
+011C
+011E
+0120
+0122
+0124
+0126
+0128
+012A
+012C
+012E
+0130
+0132
+0134
+0136
+0139
+013B
+013D
+013F
+0141
+0143
+0145
+0147
+014A
+014C
+014E
+0150
+0152
+0154
+0156
+0158
+015A
+015C
+015E
+0160
+0162
+0164
+0166
+0168
+016A
+016C
+016E
+0170
+0172
+0174
+0176
+0178 0179
+017B
+017D
+0181 0182
+0184
+0186 0187
+0189 018B
+018E 0191
+0193 0194
+0196 0198
+019C 019D
+019F 01A0
+01A2
+01A4
+01A6 01A7
+01A9
+01AC
+01AE 01AF
+01B1 01B3
+01B5
+01B7 01B8
+01BC
+01C4
+01C7
+01CA
+01CD
+01CF
+01D1
+01D3
+01D5
+01D7
+01D9
+01DB
+01DE
+01E0
+01E2
+01E4
+01E6
+01E8
+01EA
+01EC
+01EE
+01F1
+01F4
+01F6 01F8
+01FA
+01FC
+01FE
+0200
+0202
+0204
+0206
+0208
+020A
+020C
+020E
+0210
+0212
+0214
+0216
+0218
+021A
+021C
+021E
+0220
+0222
+0224
+0226
+0228
+022A
+022C
+022E
+0230
+0232
+023A 023B
+023D 023E
+0241
+0386
+0388 038A
+038C
+038E 038F
+0391 03A1
+03A3 03AB
+03D2 03D4
+03D8
+03DA
+03DC
+03DE
+03E0
+03E2
+03E4
+03E6
+03E8
+03EA
+03EC
+03EE
+03F4
+03F7
+03F9 03FA
+03FD 042F
+0460
+0462
+0464
+0466
+0468
+046A
+046C
+046E
+0470
+0472
+0474
+0476
+0478
+047A
+047C
+047E
+0480
+048A
+048C
+048E
+0490
+0492
+0494
+0496
+0498
+049A
+049C
+049E
+04A0
+04A2
+04A4
+04A6
+04A8
+04AA
+04AC
+04AE
+04B0
+04B2
+04B4
+04B6
+04B8
+04BA
+04BC
+04BE
+04C0 04C1
+04C3
+04C5
+04C7
+04C9
+04CB
+04CD
+04D0
+04D2
+04D4
+04D6
+04D8
+04DA
+04DC
+04DE
+04E0
+04E2
+04E4
+04E6
+04E8
+04EA
+04EC
+04EE
+04F0
+04F2
+04F4
+04F6
+04F8
+0500
+0502
+0504
+0506
+0508
+050A
+050C
+050E
+0531 0556
+10A0 10C5
+1E00
+1E02
+1E04
+1E06
+1E08
+1E0A
+1E0C
+1E0E
+1E10
+1E12
+1E14
+1E16
+1E18
+1E1A
+1E1C
+1E1E
+1E20
+1E22
+1E24
+1E26
+1E28
+1E2A
+1E2C
+1E2E
+1E30
+1E32
+1E34
+1E36
+1E38
+1E3A
+1E3C
+1E3E
+1E40
+1E42
+1E44
+1E46
+1E48
+1E4A
+1E4C
+1E4E
+1E50
+1E52
+1E54
+1E56
+1E58
+1E5A
+1E5C
+1E5E
+1E60
+1E62
+1E64
+1E66
+1E68
+1E6A
+1E6C
+1E6E
+1E70
+1E72
+1E74
+1E76
+1E78
+1E7A
+1E7C
+1E7E
+1E80
+1E82
+1E84
+1E86
+1E88
+1E8A
+1E8C
+1E8E
+1E90
+1E92
+1E94
+1EA0
+1EA2
+1EA4
+1EA6
+1EA8
+1EAA
+1EAC
+1EAE
+1EB0
+1EB2
+1EB4
+1EB6
+1EB8
+1EBA
+1EBC
+1EBE
+1EC0
+1EC2
+1EC4
+1EC6
+1EC8
+1ECA
+1ECC
+1ECE
+1ED0
+1ED2
+1ED4
+1ED6
+1ED8
+1EDA
+1EDC
+1EDE
+1EE0
+1EE2
+1EE4
+1EE6
+1EE8
+1EEA
+1EEC
+1EEE
+1EF0
+1EF2
+1EF4
+1EF6
+1EF8
+1F08 1F0F
+1F18 1F1D
+1F28 1F2F
+1F38 1F3F
+1F48 1F4D
+1F59
+1F5B
+1F5D
+1F5F
+1F68 1F6F
+1FB8 1FBB
+1FC8 1FCB
+1FD8 1FDB
+1FE8 1FEC
+1FF8 1FFB
+2102
+2107
+210B 210D
+2110 2112
+2115
+2119 211D
+2124
+2126
+2128
+212A 212D
+2130 2131
+2133
+213E 213F
+2145
+2160 216F
+24B6 24CF
+2C00 2C2E
+2C80
+2C82
+2C84
+2C86
+2C88
+2C8A
+2C8C
+2C8E
+2C90
+2C92
+2C94
+2C96
+2C98
+2C9A
+2C9C
+2C9E
+2CA0
+2CA2
+2CA4
+2CA6
+2CA8
+2CAA
+2CAC
+2CAE
+2CB0
+2CB2
+2CB4
+2CB6
+2CB8
+2CBA
+2CBC
+2CBE
+2CC0
+2CC2
+2CC4
+2CC6
+2CC8
+2CCA
+2CCC
+2CCE
+2CD0
+2CD2
+2CD4
+2CD6
+2CD8
+2CDA
+2CDC
+2CDE
+2CE0
+2CE2
+FF21 FF3A
+10400 10427
+1D400 1D419
+1D434 1D44D
+1D468 1D481
+1D49C
+1D49E 1D49F
+1D4A2
+1D4A5 1D4A6
+1D4A9 1D4AC
+1D4AE 1D4B5
+1D4D0 1D4E9
+1D504 1D505
+1D507 1D50A
+1D50D 1D514
+1D516 1D51C
+1D538 1D539
+1D53B 1D53E
+1D540 1D544
+1D546
+1D54A 1D550
+1D56C 1D585
+1D5A0 1D5B9
+1D5D4 1D5ED
+1D608 1D621
+1D63C 1D655
+1D670 1D689
+1D6A8 1D6C0
+1D6E2 1D6FA
+1D71C 1D734
+1D756 1D76E
+1D790 1D7A8
+END