]> git.lyx.org Git - lyx.git/blobdiff - development/autotests/useSystemFonts.pl
Adding binary path for Homebrew on MacOS-arm64 (bug 12619).
[lyx.git] / development / autotests / useSystemFonts.pl
index 0c48880746354fa404a674e66667f88fa28689b4..1265d2003a7f0e8f4f4e9256b456d9c8359e1934 100644 (file)
@@ -6,8 +6,7 @@
 # 2.) While copying,
 #   2a.) searches for relative references to files and
 #        replaces them with absolute ones
-#   2b.) In order to be able to compile with luatex or xetex
-#        changes default fonts to use non-tex-fonts instead
+#   2b.) Changes default fonts to use non-tex-fonts
 #
 # Syntax: perl useSystemFonts.pl sourceFile destFile format
 # Each param represents a path to a file
@@ -54,90 +53,90 @@ sub copyFoundSubdocuments($);
 sub copyJob($$);
 sub isrelativeFix($$$);
 sub isrelative($$$);
-sub createTemporaryFileName($$);
+sub createTemporaryFileName($$$);
 sub copyJobPending($$);
 sub addNewJob($$$$$);
-sub addFileCopyJob($$$$);
+sub addFileCopyJob($$$$$);
 sub getNewNameOf($$);
+sub getlangs($$);
+sub simplifylangs($);
+sub getLangEntry();
 
 # convert lyx file to be compilable with xetex
 
-my ($source, $dest, $format, $fontT, $rest) = @ARGV;
+my ($source, $dest, $format, $fontT, $encodingT, $languageFile, $rest) = @ARGV;
+my %encodings = ();      # Encoding with TeX fonts, depending on language tag
 
 diestack("Too many arguments") if (defined($rest));
 diestack("Sourcefilename not defined") if (! defined($source));
 diestack("Destfilename not defined") if (! defined($dest));
 diestack("Format (e.g. pdf4) not defined") if (! defined($format));
 diestack("Font type (e.g. texF) not defined") if (! defined($fontT));
+diestack("Encoding (e.g. ascii) not defined") if (! defined($encodingT));
 
 $source = File::Spec->rel2abs($source);
 $dest = File::Spec->rel2abs($dest);
 
 my %font = ();
 my $lang = "main";
-if ($source =~ /\/([a-z][a-z](_[A-Z][A-Z])?)\//) {
+if ($source =~ /\/([a-z][a-z](_[A-Z][A-Z])?)[\/_]/) {
   $lang = $1;
 }
+
+my $inputEncoding = undef;
 if ($fontT eq "systemF") {
-  if ($lang =~ /^(ru|uk)$/) {
-    $font{roman} = "DejaVu Serif";
-    $font{sans} = "DejaVu Sans";
-    $font{typewriter} = "DejaVu Sans Mono";
-  }
-  elsif ($lang =~ /^(he|el|main)$/) {
-    $font{roman} = "FreeSans";
-    $font{sans} = "FreeSans";
-    $font{typewriter} = "FreeSans";
-  }
-  elsif ($lang eq "fa") {
-    $font{roman} = "FreeFarsi";
-    $font{sans} = "FreeFarsi";
-    $font{typewriter} = "FreeFarsi Monospace";
-  }
-  elsif ($lang eq "zh_CN") {
-    $font{roman} = "WenQuanYi Micro Hei";
-    $font{sans} = "WenQuanYi Micro Hei";
-    $font{typewriter} = "WenQuanYi Micro Hei";
-  }
-  elsif ($lang eq "ko" ) {
-    $font{roman} = "NanumGothic"; # NanumMyeongjo, NanumGothic Eco, NanumGothicCoding
-    $font{sans} = "NanumGothic";
-    $font{typewriter} = "NanumGothic";
+}
+elsif ($encodingT ne "default") {
+  # set input encoding to the requested value
+  $inputEncoding = {
+        "search" => '.*', # this will be substituted from '\inputencoding'-line
+       "out" => $encodingT,
+    };
+}
+elsif (0) { # set to '1' to enable setting of inputencoding
+  # use tex font here
+  my %encoding = ();
+  if (defined($languageFile)) {
+    # The 2 lines below does not seem to have any effect
+    #&getlangs($languageFile, \%encoding);
+    #&simplifylangs(\%encoding);
   }
-  elsif ($lang eq "ar" ) {
-    # available in 'fonts-sil-scheherazade' package
-    $font{roman} = "Scheherazade";
-    $font{sans} = "Scheherazade";
-    $font{typewriter} = "Scheherazade";
+  if ($format =~ /^(pdf4)$/) { # xelatex
+    # set input encoding to 'ascii' always
+    $inputEncoding = {
+      "search" => '.*', # this will be substituted from '\inputencoding'-line
+      "out" => "ascii",
+    };
   }
-  else {
-    # default system fonts
-    $font{roman} = "FreeSans";
-    $font{sans} = "FreeSans";
-    $font{typewriter} = "FreeSans";
+  elsif ($format =~ /^(dvi3|pdf5)$/) { # (dvi)?lualatex
+    # when to set input encoding to 'ascii'?
+    if (defined($encoding{$lang})) {
+      $inputEncoding = {
+       "search" => '.*', # this will be substituted from '\inputencoding'-line
+       "out" => $encoding{$lang},
+      };
+    }
   }
 }
-else {
-  # use tex font here
-}
 
 my $sourcedir = dirname($source);
 my $destdir = dirname($dest);
 if (! -d $destdir) {
-  diestack("could not make dir \"$destdir\"") if (! mkdir $destdir);
+  diestack("could not make dir \"$destdir\"") if (! mkpath $destdir);
 }
 
 my $destdirOfSubdocuments;
 {
   my ($name, $pat, $suffix) = fileparse($source, qr/\.[^.]*/);
-  my $ext = $format . "_$lang";
-  $destdirOfSubdocuments = "$destdir/tmp_$ext" . "_$name"; # Global var, something TODO here
+  my $ext = $format . "-$lang";
+  $name =~ s/[%_]/-/g;
+  $destdirOfSubdocuments = "$destdir/tmp-$ext" . "-$name"; # Global var, something TODO here
 }
 
 if(-d $destdirOfSubdocuments) {
   rmtree($destdirOfSubdocuments);
 }
-mkdir($destdirOfSubdocuments); #  for possibly included files
+mkpath($destdirOfSubdocuments);        #  for possibly included files
 
 my %IncludedFiles = ();
 my %type2hash = (
@@ -175,11 +174,15 @@ sub interpretedCopy($$$$)
   diestack("could not read \"$source\"") if (!open(FI, $source));
   diestack("could not write \"$dest\"") if (! open(FO, '>', $dest));
 
-  initLyxStack(\%font, $fontT);
+  initLyxStack(\%font, $fontT, $inputEncoding);
 
+  my $fi_line_no = 0;
+  my @path_errors = ();
   while (my $l = <FI>) {
-    chomp($l);
-    my $rStatus = checkLyxLine($l);
+    $fi_line_no += 1;
+    $l =~ s/[\n\r]+$//;
+    #chomp($l);
+    my $rStatus = checkLyxLine($l, $sourcedir);
     if ($rStatus->{found}) {
       my $rF = $rStatus->{result};
       if ($rStatus->{"filetype"} eq "replace_only") {
@@ -200,24 +203,74 @@ sub interpretedCopy($$$$)
            my $ext = $isrel[1];
            if ($rStatus->{"filetype"} eq "prefix_only") {
              $f = getNewNameOf("$sourcedir/$f", $rFiles);
+             if ($format =~ /^(docbook5|epub)$/) {
+               $rF->[1] = join(',', @{$filelist});
+               $l =  join('', @$rF);
+             }
            }
            else {
              my ($newname, $res1);
+              my @extlist = ();
+              if (ref($rStatus->{ext}) eq "ARRAY") {
+                my @extlist = @{$rStatus->{ext}};
+                my $created = 0;
+                for my $extx (@extlist) {
+                  if (-e "$sourcedir/$f$extx") {
+                    ($newname, $res1) = addFileCopyJob("$sourcedir/$f$extx",
+                                                       "$destdirOfSubdocuments",
+                                                       $rStatus->{"filetype"},
+                                                       $rFiles, $created);
+                    print "Added ($res1) file \"$sourcedir/$f$extx\" to be copied to \"$newname\"\n";
+                    if (!$created && $extx ne "") {
+                      $newname =~ s/$extx$//;
+                    }
+                    $created = 1;
+                  }
+                }
+                print "WARNING: No prefixed file.(" . join('|', @extlist) . ") seens to exist, at \"$source:$fi_line_no\"\n" if (!$created);
+              }
+              else {
              ($newname, $res1) = addFileCopyJob("$sourcedir/$f$ext",
                                                  "$destdirOfSubdocuments",
                                                  $rStatus->{"filetype"},
-                                                 $rFiles);
+                                                   $rFiles, 0);
              print "Added ($res1) file \"$sourcedir/$f$ext\" to be copied to \"$newname\"\n";
              if ($ext ne "") {
                $newname =~ s/$ext$//;
              }
+              }
              $f = $newname;
              $res += $res1;
            }
          }
+         else {
+           if (! -e "$f") {
+             # Non relative (e.g. with absolute path) file should exist
+             if ($rStatus->{"filetype"} eq "interpret") {
+               # filetype::interpret should be interpreted by lyx or latex and therefore emit error
+               # We prinnt a warning instead
+               print "WARNING: Interpreted file \"$f\" not found, at \"$source:$fi_line_no\"\n";
+             }
+             elsif ($rStatus->{"filetype"} eq "prefix_only") {
+               # filetype::prefix_only should be interpreted by latex
+               print "WARNING: Prefixed file \"$f\" not found, at \"$source:$fi_line_no\"\n";
+             }
+             else {
+               # Collect the path-error-messages
+               push(@path_errors, "File \"$f(" . $rStatus->{"filetype"} . ")\" not found, at \"$source:$fi_line_no\"");
+             }
+           }
+         }
        }
-       if ($foundrelative) {
-         $rF->[$fidx] = join($separator, @{$filelist});
+       if ($foundrelative && $rStatus->{"filetype"} !~ /^(prefix_for_list|prefix_only)$/) {
+          # The result can be relative too
+          # but, since prefix_for_list does no copy, we have to use absolute paths
+          # to address files inside the source dir
+          my @rel_list = ();
+          for my $fr (@{$filelist}) {
+            push(@rel_list, File::Spec->abs2rel($fr, $destdir));
+          }
+          $rF->[$fidx] = join($separator, @rel_list);
          $l = join('', @{$rF});
        }
       }
@@ -226,6 +279,12 @@ sub interpretedCopy($$$$)
   }
   close(FI);
   close(FO);
+  if (@path_errors > 0) {
+    for my $entry (@path_errors) {
+      print "ERROR: $entry\n";
+    }
+    diestack("Aborted because of path errors in \"$source\"");
+  }
 
   closeLyxStack();
   return($res);
@@ -264,16 +323,16 @@ sub copyJob($$)
   for my $k (values %type2hash) {
     if ($rFiles->{$source}->{$k}) {
       if (! $rFiles->{$source}->{$k . "copied"}) {
-       $rFiles->{$source}->{$k . "copied"} = 1;
-       my $dest = $rFiles->{$source}->{$k};
-       push(@dest, $dest);
-       if ($k eq "copyonly") {
-         diestack("Could not copy \"$source\" to \"$dest\"") if (! cp($source, $dest));
-       }
-       else {
-         interpretedCopy($source, $dest, $destdirOfSubdocuments, $rFiles);
-       }
-       $res += 1;
+        $rFiles->{$source}->{$k . "copied"} = 1;
+        my $dest = $rFiles->{$source}->{$k};
+        push(@dest, $dest);
+        if ($k eq "copyonly") {
+          diestack("Could not copy \"$source\" to \"$dest\"") if (! cp($source, $dest));
+        }
+        else {
+          interpretedCopy($source, $dest, $destdirOfSubdocuments, $rFiles);
+        }
+        $res += 1;
       }
     }
   }
@@ -307,15 +366,24 @@ sub isrelative($$$)
   }
 }
 
-sub createTemporaryFileName($$)
+my $oldfname = "";
+
+sub createTemporaryFileName($$$)
 {
-  my ($source, $destdir) = @_;
+  my ($source, $destdir, $created) = @_;
 
   # get the basename to be used for the template
   my ($name, $path, $suffix) = fileparse($source, qr/\.[^.]*/);
   #print "source = $source, name = $name, path = $path, suffix = $suffix\n";
-  my $template = "xx_$name" . "_";
-  my $fname = File::Temp::tempnam($destdir, $template);
+  my $template = "xx-$name" . "-";
+  my $fname;
+  if (! $created) {
+    $fname = File::Temp::tempnam($destdir, $template);
+    $oldfname = $fname;
+  }
+  else {
+    $fname = $oldfname;
+  }
 
   # Append extension from source
   if ($suffix ne "") {
@@ -345,9 +413,9 @@ sub addNewJob($$$$$)
   $rFiles->{$source} = $rJob;
 }
 
-sub addFileCopyJob($$$$)
+sub addFileCopyJob($$$$$)
 {
-  my ($source, $destdirOfSubdocuments, $filetype, $rFiles) = @_;
+  my ($source, $destdirOfSubdocuments, $filetype, $rFiles, $created) = @_;
   my ($res, $newname) = (0, undef);
   my $rJob = $rFiles->{$source};
 
@@ -357,7 +425,7 @@ sub addFileCopyJob($$$$)
   }
   if (!defined($rJob->{$hashname})) {
     addNewJob($source,
-              createTemporaryFileName($source, $destdirOfSubdocuments),
+               createTemporaryFileName($source, $destdirOfSubdocuments, $created),
               "$hashname", $rJob, $rFiles);
     $res = 1;
   }
@@ -380,3 +448,85 @@ sub getNewNameOf($$)
   }
   return($resultf);
 }
+
+sub getlangs($$)
+{
+  my ($languagefile, $rencoding) = @_;
+
+  if (open(FI, $languagefile)) {
+    while (my $l = <FI>) {
+      if ($l =~ /^Language/) {
+        my ($lng, $enc) = &getLangEntry();
+        if (defined($lng)) {
+          $rencoding->{$lng} = $enc;
+        }
+      }
+    }
+    close(FI);
+  }
+}
+
+sub simplifylangs($)
+{
+  my ($rencoding) = @_;
+  my $base = "";
+  my $enc = "";
+  my $differ = 0;
+  my @klist = ();
+  my @klist2 = ();
+  for my $k (reverse sort keys %{$rencoding}) {
+    my @tag = split('_', $k);
+    if ($tag[0] eq $base) {
+      push(@klist, $k);
+      if ($rencoding->{$k} ne $enc) {
+       $differ = 1;
+      }
+    }
+    else {
+      # new base, check that old base was OK
+      if ($base ne "") {
+       if ($differ == 0) {
+         $rencoding->{$base} = $enc;
+         push(@klist2, @klist);
+       }
+      }
+      @klist = ($k);
+      $base = $tag[0];
+      $enc = $rencoding->{$k};
+      $differ = 0;
+    }
+  }
+  if ($base ne "") {
+    # close handling for last entry too
+    if ($differ == 0) {
+      $rencoding->{$base} = $enc;
+      push(@klist2, @klist);
+    }
+  }
+  for my $k (@klist2) {
+    delete($rencoding->{$k});
+  }
+}
+
+sub getLangEntry()
+{
+  my ($lng, $enc) = (undef, undef);
+  while (my $l = <FI>) {
+    chomp($l);
+    if ($l =~ /^\s*Encoding\s+([^ ]+)\s*$/) {
+      $enc = $1;
+    }
+    elsif ($l =~ /^\s*LangCode\s+([^ ]+)\s*$/) {
+      $lng = $1;
+    }
+    elsif ($l =~ /^\s*End\s*$/) {
+      last;
+    }
+  }
+  if (defined($lng) && defined($enc)) {
+    return($lng, $enc);
+  }
+  else {
+    return(undef, undef);
+  }
+}