diff options
author | Norbert Preining <norbert@preining.info> | 2024-03-15 03:06:35 +0000 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2024-03-15 03:06:35 +0000 |
commit | 12679ab7d3c2a210f4123163671b532b8b55d5f9 (patch) | |
tree | 0060d13467186ad977f4e73488ee20dd6c0017ab /systems/texlive/tlnet/tlpkg/tlperl/lib/_charnames.pm | |
parent | 62170822e034fdd3f81de7274835d0d3b0467100 (diff) |
CTAN sync 202403150306
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/_charnames.pm')
-rw-r--r-- | systems/texlive/tlnet/tlpkg/tlperl/lib/_charnames.pm | 53 |
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 |