mirror of
https://git.lyx.org/repos/lyx.git
synced 2024-11-25 19:07:45 +00:00
Tools(listFontWithLang.pl): Amend ac039733
, Select fonts containig specified glyphs
Allow also values like -c Azß or -c u+65zu+xdf (Comma as a separator not needed, if the input is unambiguous)
This commit is contained in:
parent
dfb33eb569
commit
58dfb1d825
@ -83,11 +83,14 @@ my @optionsDef = (
|
|||||||
["c",
|
["c",
|
||||||
{fieldname => "Contains",
|
{fieldname => "Contains",
|
||||||
type => "=s", listsep => ',',
|
type => "=s", listsep => ',',
|
||||||
comment => "Select fonts containing all comma separated glyphs",}],
|
comment => "Select fonts containing all these (possibly comma separated) glyphs",}],
|
||||||
["l",
|
["l",
|
||||||
{fieldname => "Lang",
|
{fieldname => "Lang",
|
||||||
type => "=s", alias=>["lang"],
|
type => "=s", alias=>["lang"],
|
||||||
comment => "Comma separated list of desired languages"},],
|
comment => "Comma separated list of desired languages"},],
|
||||||
|
["pc",
|
||||||
|
{fieldname => "PrintCharset", alias => ["printcharset"],
|
||||||
|
comment => "Print intervals of supported unicode character values"},],
|
||||||
["pl",
|
["pl",
|
||||||
{fieldname => "PrintLangs", alias => ["printlangs"],
|
{fieldname => "PrintLangs", alias => ["printlangs"],
|
||||||
comment => "Print supported languages"},],
|
comment => "Print supported languages"},],
|
||||||
@ -120,6 +123,7 @@ if (defined($options{Contains})) {
|
|||||||
for my $a (@{$options{Contains}}) {
|
for my $a (@{$options{Contains}}) {
|
||||||
push(@glyphs, decimalUnicode($a));
|
push(@glyphs, decimalUnicode($a));
|
||||||
}
|
}
|
||||||
|
@glyphs = sort {$a <=> $b;} @glyphs;
|
||||||
}
|
}
|
||||||
|
|
||||||
my $cmd = "fc-list";
|
my $cmd = "fc-list";
|
||||||
@ -139,10 +143,10 @@ if (exists($options{PrintScripts}) || defined($options{Scripts}) || defined($opt
|
|||||||
if (exists($options{PrintLangs}) || defined($langs[0])) {
|
if (exists($options{PrintLangs}) || defined($langs[0])) {
|
||||||
$format .= " lang=\"%{lang}\"";
|
$format .= " lang=\"%{lang}\"";
|
||||||
}
|
}
|
||||||
if (exists($options{PrintProperties}) || defined($options{Property})) {
|
if (exists($options{PrintProperties}) || defined($options{Property}) || defined($options{NProperty})) {
|
||||||
$format .= " weight=%{weight} slant=%{slant} width=%{width} spacing=%{spacing}";
|
$format .= " weight=%{weight} slant=%{slant} width=%{width} spacing=%{spacing}";
|
||||||
}
|
}
|
||||||
if (defined($options{Contains})) {
|
if (defined($options{Contains}) || exists($options{PrintCharset})) {
|
||||||
$format .= " charset=\"%{charset}\"";
|
$format .= " charset=\"%{charset}\"";
|
||||||
}
|
}
|
||||||
$format .= " file=\"%{file}\" abcd\\n";
|
$format .= " file=\"%{file}\" abcd\\n";
|
||||||
@ -341,8 +345,8 @@ if (open(FI, "$cmd |")) {
|
|||||||
for my $lang (@langs) {
|
for my $lang (@langs) {
|
||||||
next NXTLINE if (! defined($usedlangs{$lang}));
|
next NXTLINE if (! defined($usedlangs{$lang}));
|
||||||
}
|
}
|
||||||
if (defined($options{Contains})) {
|
my @charlist = ();
|
||||||
my @charlist = ();
|
if (defined($options{Contains}) || exists($options{PrintCharset})) {
|
||||||
if ($l =~ / charset=\"([^\"]+)\"/) {
|
if ($l =~ / charset=\"([^\"]+)\"/) {
|
||||||
my @list = split(/\s+/, $1);
|
my @list = split(/\s+/, $1);
|
||||||
for my $e (@list) {
|
for my $e (@list) {
|
||||||
@ -351,8 +355,10 @@ if (open(FI, "$cmd |")) {
|
|||||||
push(@charlist, [hex($l), hex($h)]);
|
push(@charlist, [hex($l), hex($h)]);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
for my $g (@glyphs) {
|
if (defined($options{Contains})) {
|
||||||
next NXTLINE if (! contains($g, \@charlist));
|
for my $g (@glyphs) {
|
||||||
|
next NXTLINE if (! contains($g, \@charlist));
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
my $style = &getVal($l, "style", "stylelang");
|
my $style = &getVal($l, "style", "stylelang");
|
||||||
@ -408,6 +414,18 @@ if (open(FI, "$cmd |")) {
|
|||||||
if (exists($options{PrintLangs})) {
|
if (exists($options{PrintLangs})) {
|
||||||
$props .= '(' . join(',', sort keys %usedlangs) . ')';
|
$props .= '(' . join(',', sort keys %usedlangs) . ')';
|
||||||
}
|
}
|
||||||
|
if (exists($options{PrintCharset})) {
|
||||||
|
my @out = ();
|
||||||
|
for my $rE (@charlist) {
|
||||||
|
if ($rE->[0] != $rE->[1]) {
|
||||||
|
push(@out, $rE->[0] . '-' . $rE->[1]);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
push(@out, $rE->[0]);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$props .= '(' . join(',', @out) . ')';
|
||||||
|
}
|
||||||
if (exists($options{PrintScripts}) || defined($options{Scripts}) || defined($options{NScripts}) || exists($options{Math})) {
|
if (exists($options{PrintScripts}) || defined($options{Scripts}) || defined($options{NScripts}) || exists($options{Math})) {
|
||||||
my @scripts = ();
|
my @scripts = ();
|
||||||
my $scripts = "";
|
my $scripts = "";
|
||||||
@ -830,25 +848,35 @@ sub correctstyle($)
|
|||||||
return($style);
|
return($style);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# return list of unicode values of the input string
|
||||||
sub decimalUnicode($)
|
sub decimalUnicode($)
|
||||||
{
|
{
|
||||||
my ($a) = @_;
|
my ($a) = @_;
|
||||||
if ($a =~ /^u\+(.+)$/i) {
|
my @res = ();
|
||||||
$a = $1;
|
while ($a =~ s/u\+(0?x[\da-f]+|\d+)//i) {
|
||||||
if ($a =~ /^0?x(.+)$/) {
|
my $d = $1;
|
||||||
$a = hex($1);
|
if ($d =~ /^0?x(.+)$/) {
|
||||||
|
$d = hex($1);
|
||||||
}
|
}
|
||||||
return($a);
|
push(@res, $d);
|
||||||
}
|
}
|
||||||
return(ord(decode('utf-8', $a)));
|
# maybe $a is a string of unicode chars?
|
||||||
|
my $u = decode('utf-8', $a);
|
||||||
|
my @a = split(//, $u);
|
||||||
|
for my $x (@a) {
|
||||||
|
push(@res, ord($x));
|
||||||
|
}
|
||||||
|
return(@res);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# check if the glyph-value $d is contained
|
||||||
|
# in one of the (sorted) intervals
|
||||||
sub contains($$)
|
sub contains($$)
|
||||||
{
|
{
|
||||||
my ($d, $rList) = @_;
|
my ($d, $rList) = @_;
|
||||||
for my $re (@{$rList}) {
|
for my $re (@{$rList}) {
|
||||||
return 0 if ($re->[0] > $d);
|
next if ($re->[1] < $d);
|
||||||
return 1 if ($re->[1] >= $d);
|
return 1 if ($re->[0] <= $d);
|
||||||
}
|
}
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
Loading…
Reference in New Issue
Block a user