summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/_charnames.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/_charnames.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/_charnames.pm110
1 files changed, 71 insertions, 39 deletions
diff --git a/Master/tlpkg/tlperl/lib/_charnames.pm b/Master/tlpkg/tlperl/lib/_charnames.pm
index c6169d16f86..b38028d24a7 100644
--- a/Master/tlpkg/tlperl/lib/_charnames.pm
+++ b/Master/tlpkg/tlperl/lib/_charnames.pm
@@ -6,7 +6,7 @@
package _charnames;
use strict;
use warnings;
-our $VERSION = '1.45';
+our $VERSION = '1.48';
use unicore::Name; # mktables-generated algorithmically-defined names
use bytes (); # for $bytes::hint_bits
@@ -21,22 +21,22 @@ $Carp::Internal{ (__PACKAGE__) } = 1;
#
# The official names with their code points are stored in a table in
# lib/unicore/Name.pl which is read in as a large string (almost 3/4 Mb in
-# Unicode 6.0). Each code point/name combination is separated by a \n in the
-# string. (Some of the CJK and the Hangul syllable names are instead
-# determined algorithmically via subroutines stored instead in
-# lib/unicore/Name.pm). Because of the large size of this table, it isn't
-# converted into hashes for faster lookup.
+# Unicode 6.0). Each code point sequence appears on a line by itself, with
+# its corresponding name occupying the next line in the string. (Some of the
+# CJK and the Hangul syllable names are instead determined algorithmically via
+# subroutines stored instead in lib/unicore/Name.pm). Because of the large
+# size of this table, it isn't converted into hashes for faster lookup.
#
# But, user defined aliases are stored in their own hashes, as are Perl
# extensions to the official names. These are checked first before looking at
# the official table.
#
# Basically, the table is grepped for the input code point (viacode()) or
-# name (the other functions), and the corresponding value on the same line is
-# returned. The grepping is done by turning the input into a regular
-# expression. Thus, the same table does double duty, used by both name and
-# code point lookup. (If we were to have hashes, we would need two, one for
-# each lookup direction.)
+# name (the other functions), and the corresponding value on the next or
+# previous line is returned. The grepping is done by turning the input into a
+# regular expression. Thus, the same table does double duty, used by both
+# name and code point lookup. (If we were to have hashes, we would need two,
+# one for each lookup direction.)
#
# For loose name matching, the logical thing would be to have a table
# with all the ignorable characters squeezed out, and then grep it with the
@@ -48,9 +48,9 @@ $Carp::Internal{ (__PACKAGE__) } = 1;
# regular expression of the input name is modified to have optional spaces and
# dashes between characters. For example, in strict matching, the regular
# expression would be:
-# qr/\tDIGIT ONE$/m
+# qr/^DIGIT ONE$/m
# Under loose matching, the blank would be squeezed out, and the re would be:
-# qr/\tD[- ]?I[- ]?G[- ]?I[- ]?T[- ]?O[- ]?N[- ]?E$/m
+# qr/^D[- ]?I[- ]?G[- ]?I[- ]?T[- ]?O[- ]?N[- ]?E$/m
# which matches a blank or dash between any characters in the official table.
#
# This is also how script lookup is done. Basically the re looks like
@@ -59,7 +59,7 @@ $Carp::Internal{ (__PACKAGE__) } = 1;
# The hashes are stored as utf8 strings. This makes it easier to deal with
# sequences. I (khw) also tried making Name.pl utf8, but it slowed things
-# down by a factor of 7. I then tried making Name.pl store the ut8
+# down by a factor of 7. I then tried making Name.pl store the utf8
# equivalents but not calling them utf8. That led to similar speed as leaving
# it alone, but since that is harder for a human to parse, I left it as-is.
@@ -140,6 +140,14 @@ sub carp
require Carp; goto &Carp::carp;
} # carp
+sub populate_txt()
+{
+ return if $txt;
+
+ $txt = do "unicore/Name.pl";
+ Internals::SvREADONLY($txt, 1);
+}
+
sub alias (@) # Set up a single alias
{
my @errors;
@@ -263,8 +271,9 @@ my %dummy_H = (
);
-sub lookup_name ($$$) {
- my ($name, $wants_ord, $runtime) = @_;
+sub lookup_name ($$$;$) {
+ my ($name, $wants_ord, $runtime, $regex_loose) = @_;
+ $regex_loose //= 0;
# Lookup the name or sequence $name in the tables. If $wants_ord is false,
# returns the string equivalent of $name; if true, returns the ordinal value
@@ -281,7 +290,7 @@ sub lookup_name ($$$) {
my $result; # The string result
my $save_input;
- if ($runtime) {
+ if ($runtime && ! $regex_loose) {
my $hints_ref = (caller($runtime))[10];
@@ -307,16 +316,16 @@ sub lookup_name ($$$) {
$^H{charnames_short} = $hints_ref->{charnames_short};
}
- my $loose = $^H{charnames_loose};
+ my $loose = $regex_loose || $^H{charnames_loose};
my $lookup_name; # Input name suitably modified for grepping for in the
# table
# User alias should be checked first or else can't override ours, and if we
# were to add any, could conflict with theirs.
- if (exists $^H{charnames_ord_aliases}{$name}) {
+ if (! $regex_loose && exists $^H{charnames_ord_aliases}{$name}) {
$result = $^H{charnames_ord_aliases}{$name};
}
- elsif (exists $^H{charnames_name_aliases}{$name}) {
+ elsif (! $regex_loose && exists $^H{charnames_name_aliases}{$name}) {
$name = $^H{charnames_name_aliases}{$name};
$save_input = $lookup_name = $name; # Cache the result for any error
# message
@@ -403,11 +412,11 @@ sub lookup_name ($$$) {
my $cache_ref;
## Suck in the code/name list as a big string.
- ## Lines look like:
- ## "00052\tLATIN CAPITAL LETTER R\n"
+ ## Entries look like:
+ ## "00052\nLATIN CAPITAL LETTER R\n\n"
# or
- # "0052 0303\tLATIN CAPITAL LETTER R WITH TILDE\n"
- $txt = do "unicore/Name.pl" unless $txt;
+ # "0052 0303\nLATIN CAPITAL LETTER R WITH TILDE\n\n"
+ populate_txt() unless $txt;
## @off will hold the index into the code/name string of the start and
## end of the name as we find it.
@@ -422,7 +431,7 @@ sub lookup_name ($$$) {
# the other way around slows down finding these immensely.
# Algorithmically determinables are not placed in the cache because
# that uses up memory, and finding these again is fast.
- if (($loose || $^H{charnames_full})
+ if ( ($loose || $^H{charnames_full})
&& (defined (my $ord = charnames::name_to_code_point_special($lookup_name, $loose))))
{
$result = chr $ord;
@@ -460,10 +469,14 @@ sub lookup_name ($$$) {
# Do the lookup in the full table if asked for, and if succeeds
# save the offsets and set where to cache the result.
- if (($loose || $^H{charnames_full}) && $txt =~ /\t$lookup_name$/m) {
- @off = ($-[0] + 1, $+[0]); # The 1 is for the tab
+ if (($loose || $^H{charnames_full}) && $txt =~ /^$lookup_name$/m) {
+ @off = ($-[0], $+[0]);
$cache_ref = ($loose) ? \%loose_names_cache : \%full_names_cache;
}
+ elsif ($regex_loose) {
+ # Currently don't allow :short when this is set
+ return;
+ }
else {
# Here, didn't look for, or didn't find the name.
@@ -501,18 +514,18 @@ sub lookup_name ($$$) {
my $case = $name_has_uppercase ? "CAPITAL" : "SMALL";
return if (! $scripts_trie || $txt !~
- /\t (?: $scripts_trie ) \ (?:$case\ )? LETTER \ \U$lookup_name $/xm);
+ /^ (?: $scripts_trie ) \ (?:$case\ )? LETTER \ \U$lookup_name $/xm);
# Here have found the input name in the table.
- @off = ($-[0] + 1, $+[0]); # The 1 is for the tab
+ @off = ($-[0], $+[0]);
}
# Here, the input name has been found; we haven't set up the output,
# but we know where in the string
# the name starts. The string is set up so that for single characters
- # (and not named sequences), the name is preceded immediately by a
- # tab and 5 hex digits for its code, with a \n before those. Named
- # sequences won't have the 7th preceding character be a \n.
+ # (and not named sequences), the name is on a line by itself, and the
+ # previous line contains precisely 5 hex digits for its code point.
+ # Named sequences won't have the 7th preceding character be a \n.
# (Actually, for the very first entry in the table this isn't strictly
# true: subtracting 7 will yield -1, and the substr below will
# therefore yield the very last character in the table, which should
@@ -572,9 +585,11 @@ sub lookup_name ($$$) {
# Here, wants string output. If utf8 is acceptable, just return what
# we've got; otherwise attempt to convert it to non-utf8 and return that.
- my $in_bytes = ($runtime)
- ? (caller $runtime)[8] & $bytes::hint_bits
- : $^H & $bytes::hint_bits;
+ my $in_bytes = ! $regex_loose # \p{name=} doesn't currently care if
+ # in bytes or not
+ && (($runtime)
+ ? (caller $runtime)[8] & $bytes::hint_bits
+ : $^H & $bytes::hint_bits);
return $result if (! $in_bytes || utf8::downgrade($result, 1)) # The 1 arg
# means don't die on failure
}
@@ -617,6 +632,23 @@ sub charnames {
return lookup_name($_[0], 0, 0);
}
+sub _loose_regcomp_lookup {
+ # For use only by regcomp.c to compile \p{name=...}
+ # khw thinks it best to not do :short matching, and only official names.
+ # But that is only a guess, and if demand warrants, could be changed
+ return lookup_name($_[0], 0, 1,
+ 1 # Always use :loose matching
+ );
+}
+
+sub _get_names_info {
+ # For use only by regcomp.c to compile \p{name=/.../}
+ populate_txt() unless $txt;
+
+
+ return ( \$txt, \@charnames::code_points_ending_in_code_point );
+}
+
sub import
{
shift; ## ignore class name
@@ -679,10 +711,10 @@ sub import
## see if at least we can find one letter from each script.
##
if (warnings::enabled('utf8') && @scripts) {
- $txt = do "unicore/Name.pl" unless $txt;
+ populate_txt() unless $txt;
for my $script (@scripts) {
- if (not $txt =~ m/\t$script (?:CAPITAL |SMALL )?LETTER /) {
+ if (not $txt =~ m/^$script (?:CAPITAL |SMALL )?LETTER /m) {
warnings::warn('utf8', "No such script: '$script'");
$script = quotemeta $script; # Escape it, for use in the re.
}
@@ -757,7 +789,7 @@ sub viacode {
# If the code point is above the max in the table, there's no point
# looking through it. Checking the length first is slightly faster
if (length($hex) <= 5 || CORE::hex($hex) <= 0x10FFFF) {
- $txt = do "unicore/Name.pl" unless $txt;
+ populate_txt() unless $txt;
# See if the name is algorithmically determinable.
my $algorithmic = charnames::code_point_to_name_special(CORE::hex $hex);
@@ -769,7 +801,7 @@ sub viacode {
# Return the official name, if exists. It's unclear to me (khw) at
# this juncture if it is better to return a user-defined override, so
# leaving it as is for now.
- if ($txt =~ m/^$hex\t/m) {
+ if ($txt =~ m/^$hex\n/m) {
# The name starts with the next character and goes up to the
# next new-line. Using capturing parentheses above instead of