[LyX/master] Tools(listFontWithLang.pl): Amend 58dfb1d8, Select fonts containig specified glyphs

Kornel Benko kornel at lyx.org
Wed May 20 10:19:29 UTC 2020


commit f7ad823cb8c1d3f833c8b5ae1c4dbf681135f6f6
Author: Kornel Benko <kornel at lyx.org>
Date:   Wed May 20 12:38:30 2020 +0200

    Tools(listFontWithLang.pl): Amend 58dfb1d8, Select fonts containig specified glyphs
    
    Allow to specify also intervalls of charaters
    	e.g. -c a-z,u+70-u+200
---
 development/tools/listFontWithLang.pl |  117 +++++++++++++++++++++++++--------
 1 files changed, 89 insertions(+), 28 deletions(-)

diff --git a/development/tools/listFontWithLang.pl b/development/tools/listFontWithLang.pl
index 4b3a269..342e70e 100644
--- a/development/tools/listFontWithLang.pl
+++ b/development/tools/listFontWithLang.pl
@@ -118,12 +118,36 @@ for my $lg (@langs) {
   $lg = &convertlang($lg);
 }
 
-my @glyphs = ();
 if (defined($options{Contains})) {
-  for my $a (@{$options{Contains}}) {
-    push(@glyphs, decimalUnicode($a));
+  my %glyphs = ();         # To ignore duplicates
+  for my $a1 (@{$options{Contains}}) {
+    for my $e (decimalUnicode($a1)) {
+      $glyphs{$e} = 1;
+    }
+  }
+  # create intervalls
+  my @glyphs = sort {$a <=> $b;} keys %glyphs;
+
+  # $options{Contains} no longer needed, so use it for unicode-point intervalls
+  $options{Contains} = [];
+  my ($first, $last) = (undef, undef);
+  for my $i (@glyphs) {
+    if (! defined($last)) {
+      $first = $i;
+      $last = $i;
+      next;
+    }
+    if ($i == $last+1) {
+      $last = $i;
+      next;
+    }
+    push(@{$options{Contains}}, [$first, $last]);
+    $first = $i;
+    $last = $i;
+  }
+  if (defined($last)) {
+    push(@{$options{Contains}}, [$first, $last]);
   }
-  @glyphs = sort {$a <=> $b;} @glyphs;
 }
 
 my $cmd = "fc-list";
@@ -177,6 +201,7 @@ my %weights = (
   200 => "Bold",
   205 => "Extrabold",
   210 => "Black",
+  215 => "ExtraBlack",
 );
 
 my %slants = (
@@ -345,22 +370,6 @@ if (open(FI,  "$cmd |")) {
     for my $lang (@langs) {
       next NXTLINE if (! defined($usedlangs{$lang}));
     }
-    my @charlist = ();
-    if (defined($options{Contains}) || exists($options{PrintCharset})) {
-      if ($l =~ / charset=\"([^\"]+)\"/) {
-        my @list = split(/\s+/, $1);
-        for my $e (@list) {
-          my ($l, $h) = split('-', $e);
-          $h = $l if (! defined($h));
-          push(@charlist, [hex($l), hex($h)]);
-        }
-      }
-      if (defined($options{Contains})) {
-        for my $g (@glyphs) {
-          next NXTLINE if (! contains($g, \@charlist));
-        }
-      }
-    }
     my $style = &getVal($l, "style", "stylelang");
     $style =~ s/^\\040//;
     my $fullname = &getVal($l, "fn", "fnl");
@@ -392,6 +401,22 @@ if (open(FI,  "$cmd |")) {
         next NXTLINE if ($fontname !~ /$fn/i);
       }
     }
+    my @charlist = ();
+    if (defined($options{Contains}) || exists($options{PrintCharset})) {
+      if ($l =~ / charset=\"([^\"]+)\"/) {
+        my @list = split(/\s+/, $1);
+        for my $e (@list) {
+          my ($l, $h) = split('-', $e);
+          $h = $l if (! defined($h));
+          push(@charlist, [hex($l), hex($h)]);
+        }
+      }
+      if (defined($options{Contains})) {
+        for my $g (@{$options{Contains}}) {
+          next NXTLINE if (! contains($g, \@charlist));
+        }
+      }
+    }
     my $props = "";
     my @errors = ();
     if (exists($options{PrintProperties}) || defined($options{Property}) || defined($options{NProperty})) {
@@ -849,34 +874,70 @@ sub correctstyle($)
 }
 
 # return list of unicode values of the input string
+#Allow input of intervals (e.g. 'a-z')
 sub decimalUnicode($)
 {
   my ($a) = @_;
   my @res = ();
-  while ($a =~ s/u\+(0?x[\da-f]+|\d+)//i) {
-    my $d = $1;
+  # Convert to unicode chars first
+  while ($a =~ /^(.*)u\+(0?x[\da-f]+|\d+)(.*)$/i) {
+    my ($prev, $d, $post) = ($1, $2, $3);
     if ($d =~ /^0?x(.+)$/) {
       $d = hex($1);
     }
-    push(@res, $d);
+    my $chr = encode('utf-8', chr($d));
+    $a = $prev . $chr . $post;
   }
-  # maybe $a is a string of unicode chars?
+  # $a is now a string of unicode chars
   my $u = decode('utf-8', $a);
   my @a = split(//, $u);
+  my $interval = 0;
+  my $start = undef;
   for my $x (@a) {
-    push(@res, ord($x));
+    if ($x eq '-') {    # Interval
+      $interval = 1;
+      next;
+    }
+    if ($interval && defined($start)) {
+      if (ord($x) < $start) {
+        for (my $i = $start - 1; $i >= ord($x); $i--) {
+          push(@res, $i);
+        }
+      }
+      else {
+        for (my $i = $start + 1; $i <= ord($x); $i++) {
+          push(@res, $i);
+        }
+      }
+      $start = undef;
+    }
+    else {
+      $start = ord($x);
+      push(@res, $start);
+    }
+    $interval = 0;
   }
   return(@res);
 }
 
+
 # check if the glyph-value $d is contained
 # in one of the (sorted) intervals
+# Inputs as intervals
 sub contains($$)
 {
-  my ($d, $rList) = @_;
+  # ok if
+  # ...re0..........re1...
+  # ......start..end......
+  my ($ri, $rList) = @_;
+  my $start = $ri->[0];
+  my $end = $ri->[1];
+
   for my $re (@{$rList}) {
-    next if ($re->[1] < $d);
-    return 1 if ($re->[0] <= $d);
+    next if ($re->[1] < $start);
+    # now we found a possible matching interval
+    return 1 if (($start >= $re->[0]) && ($end <= $re->[1]));
+    return 0;
   }
   return 0;
 }


More information about the lyx-cvs mailing list