summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/lib/_charnames.pm
diff options
context:
space:
mode:
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/_charnames.pm')
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/_charnames.pm53
1 files changed, 43 insertions, 10 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/_charnames.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/_charnames.pm
index b38028d24a..909109d624 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/_charnames.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/_charnames.pm
@@ -6,7 +6,7 @@
package _charnames;
use strict;
use warnings;
-our $VERSION = '1.48';
+our $VERSION = '1.50';
use unicore::Name; # mktables-generated algorithmically-defined names
use bytes (); # for $bytes::hint_bits
@@ -484,6 +484,7 @@ sub lookup_name ($$$;$) {
# Keep in mind that $lookup_name has had the metas quoted.
my $scripts_trie = "";
my $name_has_uppercase;
+ my @scripts;
if (($^H{charnames_short})
&& $lookup_name =~ /^ (?: \\ \s)* # Quoted space
(.+?) # $1 = the script
@@ -506,18 +507,33 @@ sub lookup_name ($$$;$) {
$name_has_uppercase = $name =~ /[[:upper:]]/;
}
else { # Otherwise look in allowed scripts
- $scripts_trie = $^H{charnames_scripts};
+ # We want to search first by script name then by letter name, so that
+ # if the user imported `use charnames qw(arabic hebrew)` and asked for
+ # \N{alef} they get ARABIC LETTER ALEF, and if they imported
+ # `... (hebrew arabic)` and ask for \N{alef} they get HEBREW LETTER ALEF.
+ # We can't rely on the regex engine to preserve ordering like that, so
+ # pick the pipe-seperated string apart so we can iterate over it.
+ @scripts = split(/\|/, $^H{charnames_scripts});
# Use original name to find its input casing
$name_has_uppercase = $name =~ /[[:upper:]]/;
}
-
my $case = $name_has_uppercase ? "CAPITAL" : "SMALL";
- return if (! $scripts_trie || $txt !~
- /^ (?: $scripts_trie ) \ (?:$case\ )? LETTER \ \U$lookup_name $/xm);
- # Here have found the input name in the table.
- @off = ($-[0], $+[0]);
+ if(@scripts) {
+ SCRIPTS: foreach my $script (@scripts) {
+ if($txt =~ /^ (?: $script ) \ (?:$case\ )? LETTER \ \U$lookup_name $/xm) {
+ @off = ($-[0], $+[0]);
+ last SCRIPTS;
+ }
+ }
+ return unless(@off);
+ }
+ else {
+ return if (! $scripts_trie || $txt !~
+ /^ (?: $scripts_trie ) \ (?:$case\ )? LETTER \ \U$lookup_name $/xm);
+ @off = ($-[0], $+[0]);
+ }
}
# Here, the input name has been found; we haven't set up the output,
@@ -653,6 +669,8 @@ sub import
{
shift; ## ignore class name
+ populate_txt() unless $txt;
+
if (not @_) {
carp("'use charnames' needs explicit imports list");
}
@@ -704,15 +722,13 @@ sub import
$^H{charnames_full} = delete $h{':full'} || 0;
$^H{charnames_loose} = delete $h{':loose'} || 0;
$^H{charnames_short} = delete $h{':short'} || 0;
- my @scripts = map { uc quotemeta } keys %h;
+ my @scripts = map { uc quotemeta } grep { /^[^:]/ } @args;
##
## If utf8? warnings are enabled, and some scripts were given,
## see if at least we can find one letter from each script.
##
if (warnings::enabled('utf8') && @scripts) {
- populate_txt() unless $txt;
-
for my $script (@scripts) {
if (not $txt =~ m/^$script (?:CAPITAL |SMALL )?LETTER /m) {
warnings::warn('utf8', "No such script: '$script'");
@@ -740,6 +756,23 @@ sub import
}
}
+ my %letters_by_script = map {
+ $_ => [
+ ($txt =~ m/$_(?: (?:small|capital))? letter (.*)/ig)
+ ]
+ } @scripts;
+ SCRIPTS: foreach my $this_script (@scripts) {
+ my @other_scripts = grep { $_ ne $this_script } @scripts;
+ my @this_script_letters = @{$letters_by_script{$this_script}};
+ my @other_script_letters = map { @{$letters_by_script{$_}} } @other_scripts;
+ foreach my $this_letter (@this_script_letters) {
+ if(grep { $_ eq $this_letter } @other_script_letters) {
+ warn "charnames: some short character names may clash in [".join(', ', sort @scripts)."], for example $this_letter\n";
+ last SCRIPTS;
+ }
+ }
+ }
+
$^H{charnames_scripts} = join "|", @scripts; # Stringifiy them as a trie
} # import