]> git.lyx.org Git - lyx.git/blobdiff - development/tools/listFontWithLang.pl
ctests: ignore Japanese dvi3 systemF tests
[lyx.git] / development / tools / listFontWithLang.pl
index 03f0c178614c9d2b414c5b263725d0401d0ee572..562ac4cb1d8fc9b31e6d30e630ccf6e55bbe360f 100644 (file)
@@ -30,11 +30,17 @@ BEGIN {
     unshift(@INC, $p);
 }
 
+my $lyxfontsdir = $INC[0];
+$lyxfontsdir =~ s/[\/\\]?[^\/\\]+$//;
+$lyxfontsdir =~ s/[\/\\]?[^\/\\]+$//;
+$lyxfontsdir .= "/lib/fonts";
+
 use strict;
 use warnings;
 use Encode;
 use GetOptions;
 use constant {
+  # for ftype
   SERIF => 1,
   SANS => 2,
   SCRIPT => 4,
@@ -44,8 +50,31 @@ use constant {
   INITIALS => 64,
   SYMBOL => 128,
   SMALLCAP => 256,
+
+  # for UseProperty (UP)
+  UPPROPERTY => 1,         # select
+  UPNPROPERTY => 2,        # deselect
+  UPPPROPERTIES => 4,      # print
+  UPWPROPERTIES => 8,      # write to a file
+
+  # for UseCharsets (UC)
+  UCCONTAINS => 1,         # select
+  UCNCONTAINS => 2,        # deselect
+  UCPCONTAINS => 4,        # print
+
+  # for UseScripts (US)
+  USSCRIPT => 1,           # select
+  USNSCRIPT => 2,          # deselect
+  USMSCRIPT => 4,          # math
+  USPSCRIPT => 8,          # print
+  USWSCRIPT => 16,         # write to a file
 };
 
+# These will be set according to options
+my $iproperty = 0;         # info for Use Properties
+my $icontains = 0;         # info for Use Charsets
+my $iscript = 0;           # info for Use Scripts
+
 sub convertlang($);
 sub extractlist($$$);  # my ($l, $islang, $txt, $rres) = @_;
 sub getIndexes($$);
@@ -127,6 +156,10 @@ my @optionsDef = (
   ["pw",
    {fieldname => "PrintWarnings",
     comment => "Print warnings about discarded/overwritten fonts, conflicting styles"},],
+  ["wf",
+   {fieldname => "Write",
+    type => "=s", alias => ["writefile"],
+    comment => "Write to a file for later use"},],
 );
 my %options = %{&handleOptions(\@optionsDef)};
 
@@ -147,6 +180,28 @@ for my $lg (@langs) {
   $lg = &convertlang($lg);
 }
 
+$iproperty |= UPPROPERTY if (defined($options{Property}));
+$iproperty |= UPNPROPERTY if (defined($options{NProperty}));
+$iproperty |= UPPPROPERTIES if (exists($options{PrintProperties}));
+
+$icontains |= UCCONTAINS if (defined($options{Contains}));
+$icontains |= UCNCONTAINS if (defined($options{NContains}));
+$icontains |= UCPCONTAINS if (exists($options{PrintCharset}));
+
+$iscript |= USSCRIPT if (defined($options{Scripts}));
+$iscript |= USNSCRIPT if (defined($options{NScripts}));
+$iscript |= USMSCRIPT if (exists($options{Math}));
+$iscript |= USPSCRIPT if (exists($options{PrintScripts}));
+
+if (defined($options{Write})) {
+  if (! open(INFOS, '>', $options{Write})) {
+    die("Could not open file $options{Write} for write");
+  }
+  $iproperty |= UPWPROPERTIES;
+  # not yet ...
+  # $iscript |= USWSCRIPT;
+}
+
 for my $charFld ("Contains", "NContains") {
   if (defined($options{$charFld})) {
     my %glyphs = ();         # To ignore duplicates
@@ -189,32 +244,69 @@ for my $charFld ("Contains", "NContains") {
   }
 }
 
-my $cmd = "fc-list";
-if (defined($langs[0])) {
-  $cmd .= " :lang=" . join(',', @langs);
+for my $fn ("FontName", "NFontName") {
+  if (defined($options{$fn})) {
+    # split each entry and make a compiled regex
+    # Allow space between all characters
+    for my $e (@{$options{$fn}}) {
+      if ($e =~ /(\^|\\|\||\[|\]|\(|\)|\*|\+|\?)/) {
+        # already regex, don't manipulate
+        $e = qr/$e/i;
+      }
+      else {
+        my $u = decode('utf-8', $e);
+        my $fill = decode('utf-8', "\\s?");
+        my @u = split(//, $u);
+        my $ud = join($fill, @u);
+        my $e1 = encode('utf-8', $ud);
+        $e = qr/$e1/i;
+      }
+    }
+  }
 }
 
-my $format = "foundry=\"%{foundry}\"" .
-    " postscriptname=\"%{postscriptname}\"" .
-    " fn=\"%{fullname}\" fnl=\"%{fullnamelang}\"" .
-    " family=\"%{family}\" flang=\"%{familylang}\" " .
-    " style=\"%{style}\" stylelang=\"%{stylelang}\"";
+my @cmds = ();
+{
+  my $cmd = "fc-list";
+  my $langs = "";
+  if (defined($langs[0])) {
+    $langs = " :lang=" . join(',', @langs) . " ";
+  }
 
-if (exists($options{PrintScripts}) || defined($options{Scripts}) || defined($options{NScripts}) || exists($options{Math})) {
-  $format .= " script=\"%{capability}\"";
-}
-if (exists($options{PrintLangs}) || defined($langs[0])) {
-  $format .= " lang=\"%{lang}\"";
-}
-if (exists($options{PrintProperties}) || defined($options{Property}) || defined($options{NProperty})) {
-  $format .= " weight=%{weight} slant=%{slant} width=%{width} spacing=%{spacing}";
-}
-if (defined($options{Contains}) || defined($options{NContains}) || exists($options{PrintCharset})) {
-  $format .= " charset=\"%{charset}\"";
+  my $format = "foundry=\"%{foundry}\"" .
+      " postscriptname=\"%{postscriptname}\"" .
+      " fn=\"%{fullname}\" fnl=\"%{fullnamelang}\"" .
+      " family=\"%{family}\" flang=\"%{familylang}\" " .
+      " style=\"%{style}\" stylelang=\"%{stylelang}\"";
+
+  if ($iscript) {
+    $format .= " script=\"%{capability}\"";
+  }
+  if (exists($options{PrintLangs}) || defined($langs[0])) {
+    $format .= " lang=\"%{lang}\"";
+  }
+  if ($iproperty) {
+    $format .= " weight=%{weight} slant=%{slant} width=%{width} spacing=%{spacing}";
+  }
+  if ($icontains) {
+    $format .= " charset=\"%{charset}\"";
+  }
+  $format .= " file=\"%{file}\" abcd\\n";
+  $cmd .= $langs . " -f '$format'";
+  push(@cmds, $cmd);
+
+  # Now Add also lyx fonts to be examinated
+  if (opendir(DI, "$lyxfontsdir")) {
+    while (my $l = readdir(DI)) {
+      chomp($l);
+      if ($l =~ /\.ttf$/) {
+       my $file = "$lyxfontsdir/$l";
+       push(@cmds, "fc-query$langs -f '$format' '$file'");
+      }
+    }
+    closedir(DI);
+  }
 }
-$format .= " file=\"%{file}\" abcd\\n";
-$cmd .= " -f '$format'";
-#print "$cmd\n";
 
 
 my %ftypes = (
@@ -310,9 +402,9 @@ my %serifFonts = (
 # list of regexes for known sans serif fonts
 my %sansFonts = (
   "value" => SANS,          # Sans serif
-  "a" => qr/^a(030|bydos|haroni|e?rial|ndika|ngostura|nonymous|rab|roania|rimo|sap|e almothnna|egean|egyptus|l (arabiya|battar|hor|manzomah|yarmook)|lmonte|natolian|ndale|nglepoise|njali|xaxa)/i,
-  "b" => qr/^b(abel ?stone ?modern|aekmuk|alker|altar|andal|angwool|arbatrick|aveuse|bold|dxsfm|ebas|erenika|eteckna|euron|iometric|iting|lue|m ?hanna)/i,
-  "c" => qr/^c(abin|aliban|antarell|arbon|arlito|handas|harles|hilanka|hinese ?rocks|hivo|mu bright|omfortaa|omi[cx]|oolvetica|ortoba|ousine|uprum|wtex(hei|yen)|yklop|ypro)/i,
+  "a" => qr/^a(030|bydos|haroni|e?rial|ndika|ngostura|nonymous|rab|roania|rimo|rundina|sap|e almothnna|egean|egyptus|l (arabiya|battar|hor|manzomah|yarmook)|lmonte|natolian|ndale|nglepoise|njali|xaxa)/i,
+  "b" => qr/^b(abel ?stone ?modern|aekmuk|alker|altar|andal|angwool|arbatrick|aveuse|old|dxsfm|ebas|erenika|eteckna|euron|iometric|iting|lue|m ?hanna)/i,
+  "c" => qr/^c(abin|aliban|antarell|arbon|arlito|handas|harles|hilanka|hinese ?rocks|hivo|mu bright|omfortaa|omi[cx]|omputer ?(bold|(modern ?(bright ?((semi)?bold|math|oblique|roman|italic))))|oolvetica|ortoba|ountries|ousine|uprum|wtex(hei|yen)|yklop|ypro)/i,
   "d" => qr/^(d2coding|dimnah|dosis|dyuthi)/i,
   "e" => qr/^(electron|engebrechtre)/i,
   "f" => qr/^(fandolhei|fetamont|fira|font awesome 5|forgotten)/i,
@@ -320,17 +412,17 @@ my %sansFonts = (
   "h" => qr/^(hack|hani|haramain|harano|harmattan|hor\b)/i,
   "i" => qr/^(ibm ?(plex ?mono|3270)|ikarius|inconsolata|induni.?h|iwona)/i,
   "j" => qr/^j(ara|ura|s ?math.?bbold)/i,
-  "k" => qr/^(kalimati|kanji|karla|karma|kayrawan|kenyan|keraleeyam|khalid|khmer [or]|kiloji|klaudia|ko[mn]atu|kurier|kustom)/i,
-  "l" => qr/^l(aksaman|arabie|ato|eague|exend|exigulim|ibel|iberation|ibre franklin|ibris|inux biolinum|obster|ogix|ohit|oma)/i,
-  "m" => qr/^m(\+ |anchu|anjari|arcellus|ashq|eera|etal|igmix|igu|ikachan|intspirit|iriam ?clm|isaki|ona|onlam|ono(fonto|id|isome|noki)|ontserrat|otoyal|ukti|usica)/i,
-  "n" => qr/^(nachlieli|nada|nafees|nagham|nanum(barunpen|square)|nice)/i,
-  "o" => qr/^(ocr|okolaks|opendyslexic|ostorah|ouhud|over|oxygen)/i,
+  "k" => qr/^(kalimati|kanji|karla|karma|kayrawan|kenyan|keraleeyam|khalid|khmer [or]|kiloji|klaudia|ko[mn]atu|kp ?mono|kurier|kustom)/i,
+  "l" => qr/^l(aksaman|arabie|ato|eague|exend|exigulim|ibel|iberation ?mono|ibre franklin|ibris|inux biolinum|obster|ogix|ohit ?(devana|telugu)|oma)/i,
+  "m" => qr/^m(\+ |anchu|anjari|arcellus|ashq|eera|etal|igmix|igu|ikachan|intspirit|iriam ?clm|isaki|itra ?mono|ona|onlam|ono(fonto|id|isome|noki)|ontserrat|otoyal|ukti|usica)/i,
+  "n" => qr/^(nachlieli|nada|nafees|nagham|nanum(barunpen|square)|nice|noto ?mono)/i,
+  "o" => qr/^(ocr|okolaks|open ?dyslexic|ostorah|ouhud|over|oxygen)/i,
   "p" => qr/^(padauk|pagul|paktype|pakenham|palladio|petra|phetsarath|play\b|poiret|port\b|primer\b|prociono|pt\b|purisa)/i,
   "q" => qr/^(qt(ancient|helvet|avanti|doghaus|eratype|eurotype|floraline|frank|fritz|future|greece|howard|letter|optimum)|quercus)/i,
   "r" => qr/^(rachana|radio\b|raleway|ricty|roboto|rosario)/i,
   "s" => qr/^(salem|samanata|sawasdee|shado|sharja|simple|sophia|soul|source|switzera)/i,
-  "t" => qr/^(tarablus|teen|texgyre(adventor|heros)|tiresias|trebuchet|tscu|tuffy)/i,
-  "u" => qr/^u(buntu|kij (bom|chechek|cjk|diwani|ekran|elipbe|inchike|jelliy|kufi|mejnuntal|qara|qolyazma|teng|title|tor|tuz ?(neqish|tom))|mpush|n ?(dinaru|jamo|graphic|taza|vada|yetgul)|uni(kurd|space|versalis)|roob|rw ?classico)/i,
+  "t" => qr/^(tarablus|teen|tex ?gyre ?(adventor|heros)|tiresias|trebuchet|tscu|tuffy)/i,
+  "u" => qr/^u(buntu|kij (bom|chechek|cjk|diwani|ekran|elipbe|inchike|jelliy|kufi|mejnuntal|qara|qolyazma|teng|title|tor|tuz ?(neqish|tom))|mpush|n ?(dinaru|jamo|graphic|taza|vada|yetgul)|ni(kurd|space|versalis)|roob|rw ?classico)/i,
   "v" => qr/^(veranda|vn ?urwclassico)/i,
   "w" => qr/^(waree)/i,
   "y" => qr/^(yanone)/i,
@@ -368,7 +460,7 @@ my %fraktFonts = (
 
 my %fancyFonts = (
   "value" => FANCY,          # Fancy
-  "a" => qr/^a(bandoned|bberancy|driator|irmole|lmonte (snow|woodgrain)|nalecta|ni|nklepants|nn ?stone|oyagi|rt ?nouveau ?caps|stron|xaxa)/i,
+  "a" => qr/^a(bandoned|bberancy|driator|irmole|lmendra ?display|lmonte (snow|woodgrain)|nalecta|ni|nklepants|nn ?stone|oyagi|rt ?nouveau ?caps|stron|xaxa)/i,
   "b" => qr/^b(aileys|alcony|altar|andal|arbatrick|aveuse|eat ?my|etsy|iometric|iting|lankenburg|oondox ?callig|org|oron|raeside|ramalea|udmo|urnstown|utterbelly)/i,
   "c" => qr/^c(retino|msy|abin ?sketch|arbon|arolingan|harles|hicken|hilanka|hr\d)/i,
   "d" => qr/^dseg/i,
@@ -395,28 +487,28 @@ my %symbolFonts = (
   "value" => SYMBOL,          # Symbol
   "a" => qr/^a(cademicons|lblant|lianna|mar|nka|rb?\d|rchaic|rrow|rs|rt[mt]|ssy(rb\d+)?\b|miri ?quran|mit\b)/i,
   "b" => qr/^b(aby ?jeepers|bding|euron|guq|lex|lsy|oondox ?upr|ullets|urma)/i,
-  "c" => qr/^c(aladings|cicons|hess|msy|mex|apacitor)/i,
+  "c" => qr/^c(aladings|cicons|hess|msy|mex|apacitor|ounterscraps)/i,
   "d" => qr/^(dingbats|drmsym|d05)/i,
   "e" => qr/^e(lusiveicons|mmentaler|moji|sint|uterpe)/i,
   "f" => qr/^(fandol.?brail|fdsymbol|fourierorns|font(awesome|ello|.?mfizz))/i,
   "g" => qr/^(gan.?clm|gfs.?(baskerville|gazis|olga|porson|solomos|(bodoni|didot).?classic|complutum))/i,
   "h" => qr/^h(ots|ershey)/i,
   "j" => qr/^jsmath.?(msam|cmsy|masm|msbm|wasy|cmex|stmary)/i,
-  "l" => qr/^l(cmsy|msam)/i,
+  "l" => qr/^l(cmsy|msam|ohit ?(Assamese|Bengali|Gujarati|Gurmukhi|Kannada|Malayalam|Marathi|Nepali|Odia|Tamil))/i,
   "m" => qr/^(marvosym|material|msam|msbm)/i,
   "n" => qr/^(noto.*(emoji|brahmi))/i,
   "o" => qr/^(octicons)/i,
   "p" => qr/^patch/i,
   "q" => qr/^(qtding ?bits)/i,
-  "s" => qr/^s(kak|tmary|s?msam|tix ?math)/i,
-  "t" => qr/^(typicons|twemoji)/i,
+  "s" => qr/^s(emafor|kak|tmary|s?msam|tix ?math)/i,
+  "t" => qr/^(te ?xxslh?[du]|typicons|twemoji)/i,
   "u" => qr/^ukij ?(imaret|orxun|tughra)/i,
   "w" => qr/^w(ebdings|asy|elfare ?brat)/i,
 );
 
 my %smallcapFonts = (
   "value" => SMALLCAP | SERIF,
-  "c" => qr/^cs[ct]sc\d/i,
+  "c" => qr/^c(s[ct]sc\d|inzel|omputer ?modern ?sans ?italic ?regular ?\d)/i,
   "d" => qr/^drm(it)?sc\d/i,
   "f" => qr/^fetamont.?script/i,
   "n" => qr/^newtxb?ttsc/i,
@@ -425,177 +517,183 @@ my %smallcapFonts = (
   "v" => qr/^vn ?cccsc\d/i,
 );
 
-if (open(FI,  "$cmd |")) {
- NXTLINE: while (my $l = <FI>) {
-    chomp($l);
-    while ($l !~ /abcd$/) {
-      $l .= <FI>;
+for my $cmd (@cmds) {
+  if (open(FI,  "$cmd |")) {
+   NXTLINE: while (my $l = <FI>) {
       chomp($l);
-    }
-    my $file = "";
-    my $fonttype;
-    if ($l =~ /file=\"([^\"]+)\"/) {
-      $file = $1;
-      #next if ($file !~ /\.(otf|ttf|pfa|pfb|pcf|ttc)$/i);
-      if ($file !~ /\.([a-z0-9]{2,5})$/i) {
-        print "Unhandled extension for file $file\n";
-        next;
+      while ($l !~ /abcd$/) {
+       $l .= <FI>;
+       chomp($l);
       }
-      $fonttype = lc($1);
-      if (! defined($fontpriority{$fonttype})) {
-        print "Added extension $fonttype for file $file\n";
-        $fontpriority{$fonttype} = $nexttype;
-        $nexttype++;
+      my $file = "";
+      my $fonttype;
+      if ($l =~ /file=\"([^\"]+)\"/) {
+       $file = $1;
+       #next if ($file !~ /\.(otf|ttf|pfa|pfb|pcf|ttc)$/i);
+       if ($file !~ /\.([a-z0-9]{2,5})$/i) {
+         print "Unhandled extension for file $file\n";
+         next;
+       }
+       $fonttype = lc($1);
+       if (! defined($fontpriority{$fonttype})) {
+         print "Added extension $fonttype for file $file\n";
+         $fontpriority{$fonttype} = $nexttype;
+         $nexttype++;
+       }
       }
-    }
-    my %usedlangs = ();
-    if ($l =~ / lang=\"([^\"]+)\"/) {
-      my @ll = split(/\|/, $1);
-      for my $lx (@ll) {
-       $usedlangs{&convertlang($lx)} = 1;
+      my %usedlangs = ();
+      if ($l =~ / lang=\"([^\"]+)\"/) {
+       my @ll = split(/\|/, $1);
+       for my $lx (@ll) {
+         $usedlangs{&convertlang($lx)} = 1;
+       }
       }
-    }
 
-    for my $lang (@langs) {
-      next NXTLINE if (! defined($usedlangs{$lang}));
-    }
-    my ($fullname, $fuidx) = &getVal($l, "fn", "fnl", -1);
-    my ($style, $fsidx) = &getVal($l, "style", "stylelang", $fuidx);
-    $style =~ s/^\\040//;
-    my ($family, $faidx)  = &getVal($l, "family", "flang", $fsidx);
-
-    my $postscriptname = "";
-    if ($l =~ /postscriptname=\"([^\"]+)\"/) {
-      $postscriptname = $1;
-    }
-    my $fontname;
-    ($fontname, $style) = &buildFontName($family, $style);
-    if (defined($options{NFontName})) {
-      for my $fn (@{$options{NFontName}}) {
-        next NXTLINE if ($fontname =~ /$fn/i);
-      }
-    }
-    if (defined($options{FontName})) {
-      for my $fn (@{$options{FontName}}) {
-        next NXTLINE if ($fontname !~ /$fn/i);
+      for my $lang (@langs) {
+       next NXTLINE if (! defined($usedlangs{$lang}));
       }
-    }
-    my @charlist = ();
-    if (defined($options{Contains}) || defined($options{NContains}) || 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));
-        }
-      }
-      if (defined($options{NContains})) {
-        for my $g (@{$options{NContains}}) {
-          # Ignore if ANY char exist in @charlist
-          for (my $i = $g->[0]; $i <= $g->[1]; $i++) {
-            next NXTLINE if (contains([$i,$i], \@charlist));
-          }
-        }
-      }
-    }
-    my $props = "";
-    my @errors = ();
-    if (exists($options{PrintProperties}) || defined($options{Property}) || defined($options{NProperty})) {
-      my $properties = getproperties($l, $fontname, $style, \@errors);
-      if (defined($options{Property})) {
-        for my $pn (@{$options{Property}}) {
-          next NXTLINE if ($properties !~ /$pn/i);
-        }
+      my ($fullname, $fuidx) = &getVal($l, "fn", "fnl", -1);
+      my ($style, $fsidx) = &getVal($l, "style", "stylelang", $fuidx);
+      $style =~ s/^\\040//;
+      my ($family, $faidx)  = &getVal($l, "family", "flang", $fsidx);
+
+      my $postscriptname = "";
+      if ($l =~ /postscriptname=\"([^\"]+)\"/) {
+       $postscriptname = $1;
       }
-      if (defined($options{NProperty})) {
-        for my $pn (@{$options{NProperty}}) {
-          next NXTLINE if ($properties =~ /$pn/i);
-        }
+      my $fontname;
+      ($fontname, $style) = &buildFontName($family, $style);
+      if (defined($options{NFontName})) {
+       for my $fn (@{$options{NFontName}}) {
+         next NXTLINE if ($fontname =~ $fn);
+       }
       }
-      if (exists($options{PrintProperties})) {
-        $props .= " ($properties)";
+      if (defined($options{FontName})) {
+       for my $fn (@{$options{FontName}}) {
+         next NXTLINE if ($fontname !~ $fn);
+       }
       }
-    }
-
-    if (exists($options{PrintLangs})) {
-      $props .= '(' . join(',', sort keys %usedlangs) . ')';
-    }
-    if (exists($options{PrintCharset})) {
-      $props .= '(' . &sprintIntervalls(\@charlist) . ')';
-    }
-    if (exists($options{PrintScripts}) || defined($options{Scripts}) || defined($options{NScripts}) || exists($options{Math})) {
-      my @scripts = ();
-      my $scripts = "";
-      if ($l =~ / script=\"([^\"]+)\"/) {
-       @scripts = split(/\s+/, $1);
-       for my $ent (@scripts) {
-         $ent =~ s/^\s*otlayout://;
-         $ent = lc($ent);
+      my @charlist = ();
+      if ($icontains) {
+       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 ($icontains & UCCONTAINS) {
+         for my $g (@{$options{Contains}}) {
+           next NXTLINE if (! contains($g, \@charlist));
+         }
+       }
+       if ($icontains & UCNCONTAINS) {
+         for my $g (@{$options{NContains}}) {
+           # Ignore if ANY char exist in @charlist
+           for (my $i = $g->[0]; $i <= $g->[1]; $i++) {
+             next NXTLINE if (contains([$i,$i], \@charlist));
+           }
+         }
        }
-        $scripts = join(',', @scripts);
       }
-      if (exists($options{Math})) {
-        next NXTLINE if (! &ismathfont($fontname,\@scripts));
+      my $props = "";
+      my $wprops = "";
+      my @errors = ();
+      if ($iproperty) {
+       my $properties = getproperties($l, $fontname, $style, \@errors);
+       if ($iproperty & UPPROPERTY) {
+         for my $pn (@{$options{Property}}) {
+           next NXTLINE if ($properties !~ /$pn/i);
+         }
+       }
+       if ($iproperty & UPNPROPERTY) {
+         for my $pn (@{$options{NProperty}}) {
+           next NXTLINE if ($properties =~ /$pn/i);
+         }
+       }
+       if ($iproperty & UPPPROPERTIES) {
+         $props .= " ($properties)";
+       }
+       if ($iproperty & UPWPROPERTIES) {
+         $wprops .= " ($properties)";
+       }
       }
-      if (exists($options{PrintScripts})) {
-        $props .= "($scripts)";
+      if (exists($options{PrintLangs})) {
+       $props .= '(' . join(',', sort keys %usedlangs) . ')';
       }
-      if (!defined($scripts[0])) {
-        # No script defined in font, so check only $options{Scripts}
-        next NXTLINE if (defined($options{Scripts}));
+      if (exists($options{PrintCharset})) {
+       $props .= '(' . &sprintIntervalls(\@charlist) . ')';
       }
-      else {
-        if (defined($options{Scripts})) {
-          for my $s (@{$options{Scripts}}) {
-            next NXTLINE if ($scripts !~ /$s/i);
-          }
-        }
-        if (defined($options{NScripts})) {
-          for my $s (@{$options{NScripts}}) {
-            next NXTLINE if ($scripts =~ /$s/i);
-          }
-        }
+      if ($iscript) {
+       my @scripts = ();
+       my $scripts = "";
+       if ($l =~ / script=\"([^\"]+)\"/) {
+         @scripts = split(/\s+/, $1);
+         for my $ent (@scripts) {
+           $ent =~ s/^\s*otlayout://;
+           $ent = lc($ent);
+         }
+         $scripts = join(',', @scripts);
+       }
+       if ($iscript & USMSCRIPT) {
+         next NXTLINE if (! &ismathfont($fontname,\@scripts));
+       }
+       if ($iscript & USPSCRIPT) {
+         $props .= "($scripts)";
+       }
+       if (!defined($scripts[0])) {
+         # No script defined in font, so check only $options{Scripts}
+         next NXTLINE if ($iscript & USSCRIPT);
+       }
+       else {
+         if ($iscript & USSCRIPT) {
+           for my $s (@{$options{Scripts}}) {
+             next NXTLINE if ($scripts !~ /$s/i);
+           }
+         }
+         if ($iscript & USNSCRIPT) {
+           for my $s (@{$options{NScripts}}) {
+             next NXTLINE if ($scripts =~ /$s/i);
+           }
+         }
+       }
       }
-    }
-    my $foundry = "";
-    if ($l =~ /foundry=\"([^\"]+)\"/) {
-      $foundry = $1;
-      $foundry =~ s/^\s+//;
-      $foundry =~ s/\s+$//;
-    }
-    if (defined($collectedfonts{$fontname}->{$foundry}->{errors})) {
-      # Apparently not the first one, so add some info
-      my $oldfonttype = $collectedfonts{$fontname}->{$foundry}->{fonttype};
-      if (defined($errors[0])) {
-        push(@{$collectedfonts{$fontname}->{$foundry}->{errors}}, @errors);
+      my $foundry = "";
+      if ($l =~ /foundry=\"([^\"]+)\"/) {
+       $foundry = $1;
+       $foundry =~ s/^\s+//;
+       $foundry =~ s/\s+$//;
       }
-      if ($fontpriority{$oldfonttype} > $fontpriority{$fonttype}) {
-        push(@{$collectedfonts{$fontname}->{$foundry}->{errors}}, "Warning: overwriting old info of file: " . $collectedfonts{$fontname}->{$foundry}->{file});
+      if (defined($collectedfonts{$fontname}->{$foundry}->{errors})) {
+       # Apparently not the first one, so add some info
+       my $oldfonttype = $collectedfonts{$fontname}->{$foundry}->{fonttype};
+       if (defined($errors[0])) {
+         push(@{$collectedfonts{$fontname}->{$foundry}->{errors}}, @errors);
+       }
+       if ($fontpriority{$oldfonttype} > $fontpriority{$fonttype}) {
+         push(@{$collectedfonts{$fontname}->{$foundry}->{errors}}, "Warning: overwriting old info of file: " . $collectedfonts{$fontname}->{$foundry}->{file});
+       }
+       else {
+         push(@{$collectedfonts{$fontname}->{$foundry}->{errors}}, "Warning: discarding new info from file: $file");
+         next;
+       }
       }
       else {
-        push(@{$collectedfonts{$fontname}->{$foundry}->{errors}}, "Warning: discarding new info from file: $file");
-        next;
+       $collectedfonts{$fontname}->{$foundry}->{errors} = \@errors;
       }
+      $collectedfonts{$fontname}->{$foundry}->{props} = $props;
+      $collectedfonts{$fontname}->{$foundry}->{wprops} = $wprops;
+      $collectedfonts{$fontname}->{$foundry}->{file} = $file;
+      $collectedfonts{$fontname}->{$foundry}->{fonttype} = $fonttype;
     }
-    else {
-      $collectedfonts{$fontname}->{$foundry}->{errors} = \@errors;
-    }
-    $collectedfonts{$fontname}->{$foundry}->{props} = $props;
-    $collectedfonts{$fontname}->{$foundry}->{file} = $file;
-    $collectedfonts{$fontname}->{$foundry}->{fonttype} = $fonttype;
+    close(FI);
   }
-  close(FI);
 }
 
 for my $fontname (sort keys %collectedfonts) {
   my @foundries = sort keys %{$collectedfonts{$fontname}};
-  my $printfoundries = 0;
+  my $printfoundries = 1;
   if (defined($foundries[1])) {
     $printfoundries = 1;
   }
@@ -610,7 +708,10 @@ for my $fontname (sort keys %collectedfonts) {
       $fn .= " \[$foundry\]";
     }
     print $fn;
+    print INFOS $fn if (defined($options{Write}));
     print $collectedfonts{$fontname}->{$foundry}->{props};
+    print INFOS $collectedfonts{$fontname}->{$foundry}->{wprops} if (defined($options{Write}));
+    print INFOS ": " . $collectedfonts{$fontname}->{$foundry}->{file} . "\n" if (defined($options{Write}));
     if (exists($options{PrintFiles})) {
       print ": " . $collectedfonts{$fontname}->{$foundry}->{file} . "\n";
     }
@@ -619,6 +720,7 @@ for my $fontname (sort keys %collectedfonts) {
     }
   }
 }
+close(INFOS) if (defined($options{Write}));
 
 exit(0);
 #################################################################################
@@ -1007,12 +1109,12 @@ sub correctstyle($)
   $style =~ s/\bmedita(lic)?\b/Medium Italic/i;
   $style =~ s/\bmedobl(ique)?\b/Medium Oblique/i;
   $style =~ s/\bmed\b/Medium /i;
-  $style =~ s/\bdemi\b/SemiBold/i;
   $style =~ s/\bex(pd|t)\b/Expanded/i;
   $style =~ s/semi ?cond(ensed)?/SemiCondensed/i;
   $style =~ s/[sd]emi ?(bold|bd|bol)/SemiBold/i;
   $style =~ s/semi ?(expanded|extended|expd)/SemiExpanded/i;
   $style =~ s/[sd]emi ?light/SemiLight/i;
+  $style =~ s/\b[sd]emi\b/SemiBold/i;
   $style =~ s/ultra ?(expanded|extended|expd)/UltraExpanded/i;
   $style =~ s/light/Light /i;
   $style =~ s/\blt\b/Light /i;
@@ -1129,12 +1231,28 @@ sub buildFontName($$)
   $family =~ s/\bextbd\b/ExtraBold/i;
   $family =~ s/\bextlt\b/ExtraLight/i;
   $family =~ s/\bmed\b/Medium/i;
+  my $prefix = "";
+  # Split the family name at the border lowercase <-> uppercase characters
+  # except if family starts with "TeX" or "DejaVu", etc
+  if ($family =~ s/^((La|cw|PL)?TeX|LyX|DejaVu|MarVoSym|PL)//) {
+    $prefix = $1;
+    if ($family =~ /^[A-Z]/) {
+      $prefix .= " ";
+    }
+  }
+
   if ($family =~ /^([A-Z]*[a-z]+)([A-Z]\w+)\b(.*)$/) {
     $family = $1 . splitatlU($2) . $3;
   }
   $family =~ s/^Ant Polt\b/Antykwa Poltawskiego/;
   $family =~ s/\b(Semi|Extra) (Bold|Condensed|Expanded|Light)\b/$1$2/;
-  my @style = &splitStyle($style);
+  $family = $prefix . $family;
+  my @style = ();
+  if ($style =~ s/^((La|cw|PL)?TeX|LyX|DejaVu|MarVoSym|PL)//) {
+    push(@style, $1);
+  }
+
+  push(@style, &splitStyle($style));
   for my $st (@style) {
     $st = ucfirst($st);
     if ($family !~ s/$st/$st/i) {