pkfix-helper 1.4 (13jun11)

git-svn-id: svn://tug.org/texlive/trunk@22981 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 170 insertions, 51 deletions

diff --git a/Master/texmf-dist/scripts/pkfix-helper/pkfix-helper b/Master/texmf-dist/scripts/pkfix-helper/pkfix-helper
index 26d56ede05a..35782931203 100755
--- a/Master/texmf-dist/scripts/pkfix-helper/pkfix-helper
+++ b/Master/texmf-dist/scripts/pkfix-helper/pkfix-helper
@@ -17,7 +17,7 @@ use strict;
 
 # Define some global variables.
 my $progname = basename $0;        # Name of this program
-our $VERSION = "1.3";              # Version number of this program
+our $VERSION = "1.4";              # Version number of this program
 my %name2chars;                    # Map from a font name to a character list
 my $GS = $ENV{"GS"} || "gs";       # Name of the Ghostscript interpreter
 my $TFTOPL = $ENV{"TFTOPL"} || "tftopl";    # Name of the TFM to PL converter
@@ -46,6 +46,7 @@ my $sample_file_tex;               # Name of a TeX file of font samples to write
 my $single_font_use = 0;           # 1=one use per font; 0=allow repetitions
 my $samples_per_page = 25;         # Number of font samples to print per page
 my $tfm_cache_file;                # Name of a file in which to cache font metrics
+my $any_scale = 0;                 # 0=1X, 1.1X, 1.2X, ...; 1=any scale is allowed
 
 ###########################################################################
 
@@ -85,17 +86,20 @@ sub read_tfm_cache_file
 # $tfm_cache_file.
 sub write_tfm_cache_file
 {
+    my $numlines = 0;
     print STDERR "Writing TFM data to $tfm_cache_file ... " if $verbose;
     open(CACHEFILE, ">", $tfm_cache_file) || die "${progname}: Failed to create $tfm_cache_file ($!)\n";
     while (my ($tfm, $size) = each %tfm2size) {
         my @widths = %{$tfmfontwidth{$tfm}};
         print CACHEFILE "$tfm $size @widths\n";
+        $numlines++;
     }
     foreach my $tfm (keys %tfmmissing) {
         print CACHEFILE "$tfm\n";
+        $numlines++;
     }
     close CACHEFILE;
-    print STDERR "done.\n" if $verbose;
+    print STDERR "done ($numlines entries).\n" if $verbose;
 }
 
 
@@ -183,8 +187,14 @@ sub optimal_scale ($$)
         $doc_dot_tfm += $docwidth * $tfmwidth;
         $tfm_dot_tfm += $tfmwidth**2;
     }
-    return 1.0 if $tfm_dot_tfm == 0.0;   # TFM characters all have zero width.
-    return $doc_dot_tfm / $tfm_dot_tfm;
+    return 1.0 if $tfm_dot_tfm == 0.0;   # Handle TFM characters that all have zero width.
+    my $optscale = $doc_dot_tfm / $tfm_dot_tfm;
+    unless ($any_scale) {
+        # Allow only values >= 1.0 and only multiples of 0.1.
+        return 1.0 if $optscale < 1.0;
+        $optscale = int($optscale*10 + 0.5) / 10;
+    }
+    return $optscale;
 }
 
 
@@ -258,18 +268,19 @@ sub texify (@)
 }
 
 
-# Parse a font specification into a hash of information.
+# Parse a font specification into a list of hashes of information.
 sub parse_font_spec ($)
 {
     my $spec = $_[0];
     my $parse_error = "${progname}: Unable to parse font specification \"$spec\"\n";
 
-    if ($spec =~ /^\s*([-\w]+)(.*)$/o) {
+    if ($spec =~ /^\s*([-\w\*]+)(.*)$/o) {
         my $tfm = $1;           # Name of tfm file (e.g., "cmr10")
         my $scale_info = $2;    # Concatenation of scale type and scale factor
         my $scale_type;         # "X"=multiply, "@"=assign
         my $scale_amount;       # How much to scale the TFM file, "*"=automatic
 
+        # Parse the different scale types.
         if ($scale_info =~ /^\s*$/o) {
             # Empty
             $scale_type = 'X';
@@ -294,9 +305,25 @@ sub parse_font_spec ($)
         else {
             die $parse_error;
         }
-        return {"tfm"        => $tfm,
-                "scale_type" => $scale_type,
-                "scale"      => $scale_amount};
+
+        # If the tfm file contains a "*", replace the "*" with a
+        # variety of font sizes.
+        my @fontlist;
+        if ($tfm =~ /\*/) {
+            foreach my $fsize (5..17) {
+                my $full_tfm = $tfm;
+                $full_tfm =~ s/\*/$fsize/g;
+                push @fontlist, {"tfm"        => $full_tfm,
+                                 "scale_type" => $scale_type,
+                                 "scale"      => $scale_amount};
+            }
+        }
+        else {
+            push @fontlist, {"tfm"        => $tfm,
+                             "scale_type" => $scale_type,
+                             "scale"      => $scale_amount};
+        }
+        return \@fontlist;
     }
     die $parse_error;
 }
@@ -328,6 +355,7 @@ GetOptions ("h|help"       => \$wanthelp,
             "p|ps=s"       => \$sample_file_ps,
             "s|spp=i"      => \$samples_per_page,
             "C|cache=s"    => \$tfm_cache_file,
+            "a|any-scale!" => \$any_scale,
             "1|no-repeats" => \$single_font_use) || pod2usage(2);
 if ($wantversion) {
     print "pkfix-helper $VERSION\n";
@@ -346,13 +374,21 @@ die "${progname}: Samples per page must be at least 1 ($samples_per_page was spe
 # Convert any user-specified TFMs to the appropriate internal format.
 foreach my $tfm (@extra_tfms) {
     my $font_spec = parse_font_spec $tfm;
-    push @tfmlist, $font_spec;
+    push @tfmlist, @$font_spec;
 }
 
 # Parse the list of forced font mappings.
 foreach my $mapstr (@forced_fonts) {
     $mapstr =~ /^(\w+)\s*=\s*(.*)$/ || die "${progname}: Unable to parse font specification \"$mapstr\"\n";
-    $fontmatch{$1} = parse_font_spec $2;
+    my $parsed_font_spec = parse_font_spec $2;
+    if (defined $fontmatch{$1}) {
+        # Append to an existing font match.
+        $fontmatch{$1} = [@{$fontmatch{$1}}, @$parsed_font_spec];
+    }
+    else {
+        # Define a new font match,
+        $fontmatch{$1} = $parsed_font_spec;
+    }
 }
 
 # Construct a list of (possibly nonexistent) TFM files to try.  These
@@ -405,6 +441,69 @@ my $entirefile;
 }
 print STDERR "done.\n" if $verbose;
 
+# Rename the fonts in each subdocument (figure).
+my @fontrenames;
+my $fignum = 1;
+my $numrenamed = 0;
+while ($entirefile =~ /(\%\%BeginDocument: (.*?)\n.*?\%\%EndDocument)/gs) {
+    my $figure = $1;
+    my $newfigure = $1;
+    my $figname = $2;
+    if ($verbose >= 2) {
+        if ($fignum == 1) {
+            print STDERR "Renaming all fonts encountered in included documents:\n";
+        }
+        print STDERR "    $figname\n";
+    }
+    while ($figure =~ m|/(\S+)\s+\d+\s+\d+\s+df(.*?>[^<>]*?[DI])\s+E|gs) {
+        my $fontname = $1;   # Name of current font (e.g., "Fa")
+        $newfigure =~ s,(?<=/)$fontname\b,${fontname}_$fignum,gs;
+        $newfigure =~ s,\b$fontname(?=\(),${fontname}_$fignum,gs;
+        $numrenamed++;
+        if ($verbose >= 2) {
+            printf STDERR "        %s --> %s_%d\n", $fontname, $fontname, $fignum;
+        }
+    }
+    if ($figure ne $newfigure) {
+        # Remove the font-defining dictionary from the the subdocument
+        # as it may confuse pkfix.  Store it so we can later reinsert
+        # it into the main document's font-defining dictionary.
+        my $texdict = "";
+        if ($newfigure =~ s/TeXDict begin \d+ \d+ \d+ \d+ \d+ \(.*?\)\s+\@start(.*?)end//gs) {
+            $texdict = $1;
+        }
+        else {
+            warn "${progname}: Failed to extract a font-defining TeXDict from $figname\n";
+        }
+        push @fontrenames, [$figure, $newfigure, $texdict];
+    }
+    $fignum++;
+}
+if ($verbose && $entirefile =~ /\%\%BeginDocument:/s) {
+    print STDERR "Number of Type 3 fonts encountered in included documents: $numrenamed\n";
+}
+foreach my $ren (@fontrenames) {
+    my ($before, $after, $notused) = @$ren;
+    $entirefile =~ s/\Q$before\E/$after/gs;
+}
+
+# If the document contains a subdocument with (now renamed) font
+# definitions, hoist those definitions adjacent to the main document's
+# font definitions so pkfix can find them.
+if (@fontrenames) {
+    if ($entirefile =~ /(TeXDict begin (\d+) (\d+) (\d+) (\d+) (\d+) \(.*?\)\s+\@start.*?)(?=end)/s) {
+        my $fontdict = $1;
+        my $morefonts = "";
+        foreach my $ren (@fontrenames) {
+            $morefonts .= $ren->[2];
+        }
+        $entirefile =~ s/(\Q$fontdict\E)/$1$morefonts/s;
+    }
+    else {
+        warn "${progname}: Failed to find a font-defining TeXDict\n";
+    }
+}
+
 # Construct a mapping from each document font name to a list of valid
 # characters in that font.
 while ($entirefile =~ m|/(\S+)\s+\d+\s+\d+\s+df(.*?>[^<>]*?[DI])\s+E|gs) {
@@ -430,10 +529,10 @@ while ($entirefile =~ m|/(\S+)\s+\d+\s+\d+\s+df(.*?>[^<>]*?[DI])\s+E|gs) {
 my @sortedfontnames = sort {$#{$name2chars{$b}} <=> $#{$name2chars{$a}}
                             || $a cmp $b} keys %name2chars;
 if ($verbose) {
-    printf STDERR "Number of Type 3 fonts encountered: %d\n", 1+$#sortedfontnames;
+    printf STDERR "Total number of Type 3 fonts encountered: %d\n", 1+$#sortedfontnames;
     if ($verbose >= 2) {
         foreach my $fontname (@sortedfontnames) {
-            printf STDERR "    %s -- %3d character(s)\n", $fontname, 1+$#{$name2chars{$fontname}};
+            printf STDERR "    %-5.5s -- %3d character(s)\n", $fontname, 1+$#{$name2chars{$fontname}};
         }
     }
 }
@@ -449,7 +548,7 @@ else {
     warn "${progname}: Could not determine the target printer resolution; assuming $dpi DPI\n";
 }
 
-# Insert some helper code after the first ProcSet.
+# Insert some helper code after the tex.pro ProcSet.
 my $output_width_ps = $entirefile;    # PostScript code to output character widths
 my $showfontnamecode = <<"SHOWFONTNAME";
 \%\%BeginProcSet: $progname.pro
@@ -485,8 +584,8 @@ end
 \%\%EndProcSet
 SHOWFONTNAME
     ;#'
-if ($output_width_ps !~ s/\%\%EndProcSet/$&\n$showfontnamecode/s) {
-    print STDERR 'No %%EndProcSet comment was found.  We have to guess where to inject PostScript code.', "\n" if $verbose >= 3;
+if ($output_width_ps !~ s/\%\%BeginProcSet: tex\w*\.pro.*?\%\%EndProcSet/$&\n$showfontnamecode/s) {
+    print STDERR "No tex.pro ProcSet was found.  We have to guess where to inject PostScript code.\n" if $verbose >= 3;
     die "${progname}: Unable to inject prologue code\n" if $output_width_ps !~ s/TeXDict begin\s+\d+\s+\d+\s+bop/\n$showfontnamecode\n$&/s;
 }
 
@@ -562,7 +661,7 @@ read_tfm_cache_file() if defined $tfm_cache_file;
 print STDERR "Reading TFM files ... " if $verbose;
 print STDERR "\n" if $verbose >= 2;
 foreach my $tfm (sort {$a cmp $b}
-                 unique_items map {$_->{"tfm"}} (@tfmlist, values %fontmatch)) {
+                 unique_items map {$_->{"tfm"}} (@tfmlist, map {@$_} values %fontmatch)) {
     my ($designsize, %num2widths) = @{tfm2widths $tfm};
     if (%num2widths) {
         $tfmfontwidth{$tfm} = \%num2widths;
@@ -590,18 +689,24 @@ foreach my $tfminfo (@tfmlist) {
 @tfmlist = @goodtfmlist;
 undef @goodtfmlist;
 
-# Do the same for all user-specified font mappings.
-while (my ($fontname, $tfminfo) = each %fontmatch) {
-    my $tfm = $tfminfo->{"tfm"};
-    if (!defined ($tfmfontwidth{$tfm})) {
-        print STDERR "failed.\n" if $verbose;
-        die "${progname}: Unable to process user-specified TFM file \"$tfm\"\n";
+# Do the same for all user-specified font mappings but abort if none
+# of the specified possibilities represent a valid TFM file.
+while (my ($fontname, $tfmlist) = each %fontmatch) {
+    my $anyvalid = 0;
+    foreach my $tfminfo (@$tfmlist) {
+        my $tfm = $tfminfo->{"tfm"};
+        next if !defined ($tfmfontwidth{$tfm});
+        $tfminfo->{"designsize"} = $tfm2size{$tfm};
+        if ($tfminfo->{"scale_type"} eq "@") {
+            # Convert absolute to relative sizes.
+            $tfminfo->{"scale_type"} = "X";
+            $tfminfo->{"scale"} /= $tfminfo->{"designsize"};
+        }
+        $anyvalid = 1;
     }
-    $tfminfo->{"designsize"} = $tfm2size{$tfm};
-    if ($tfminfo->{"scale_type"} eq "@") {
-        # Convert absolute to relative sizes.
-        $tfminfo->{"scale_type"} = "X";
-        $tfminfo->{"scale"} /= $tfminfo->{"designsize"};
+    if (!$anyvalid) {
+        print STDERR "failed.\n" if $verbose;
+        die "${progname}: Unable to utilize any of the TFM files specified for font $fontname\n";
     }
 }
 
@@ -630,9 +735,10 @@ foreach my $fontname (@sortedfontnames) {
 
     # Determine the list of eligible fonts to compare against.
     my @eligible_tfms;
-    foreach my $tfminfo ($fontmatch{$fontname} || @tfmlist) {
+    foreach my $tfminfo ($fontmatch{$fontname} ? @{$fontmatch{$fontname}} : @tfmlist) {
         if ($tfminfo->{"scale"} eq "*") {
             # Replace "*" with the best scaling factor we can find.
+            next if !defined $tfmfontwidth{$tfminfo->{"tfm"}};
             my $newscale = optimal_scale $fontwidth{$fontname}, $tfmfontwidth{$tfminfo->{"tfm"}};
             if (defined $newscale) {
                 # Replace the "*" with the optimal multiplier.
@@ -657,6 +763,7 @@ foreach my $fontname (@sortedfontnames) {
     print STDERR "    Processing $fontname ... " if $verbose == 1;
     foreach my $tfminfo (@eligible_tfms) {
         my $tfm = $tfminfo->{"tfm"};
+        next if !defined $tfmfontwidth{$tfm};
         my $scale = $tfminfo->{"scale"};
         printf STDERR "    Comparing %s and %s \@ %.5gX ... ", $fontname, $tfm, $scale if $verbose >= 2;
         my $match = compare_maps $fontwidth{$fontname}, $tfmfontwidth{$tfm}, $scale;
@@ -706,7 +813,7 @@ foreach my $fontname (@sortedfontnames) {
 # Insert %DVIPSBitmapFont comments around every Type 3 font definition.
 my $commented_ps = $entirefile;
 my $infilename_ps = $infilename;   # PostScript version of $infilename
-$infilename_ps =~ s/[()\\]/\\$1/g;
+$infilename_ps =~ s/([\(\)\\])/\\$1/g;
 $commented_ps =~ s|^\%(End)?DVIPSBitmapFont.*$||gm;    # Remove existing comments (if any)
 $commented_ps =~ s|/(\S+)\s+\d+\s+\d+\s+df.*?>[^<]*?[DI]\s+E|write_comments($1, $&)|gse;
 if ($commented_ps !~ /\%\%EndProlog/) {
@@ -762,7 +869,7 @@ TeXDict begin
       font-name-string show (:) show
     grestore
     gsave
-      36 0 rmoveto
+      42 0 rmoveto
       font-name cvx exec
       currentfont bitmap-font-transform makefont setfont
       sample-string show
@@ -781,8 +888,8 @@ end
 \%\%EndProcSet
 SHOWFONTNAME
     ;
-    if ($sample_ps !~ s/\%\%EndProcSet/$&\n$showfontnamecode/) {
-        print STDERR 'No %%EndProcSet comment was found.  We have to guess where to inject PostScript code.', "\n" if $verbose >= 3;
+    if ($sample_ps !~ s/\%\%BeginProcSet: tex\w*\.pro.*\%\%EndProcSet/$&\n$showfontnamecode/s) {
+        print STDERR "No tex.pro ProcSet was found.  We have to guess where to inject PostScript code.\n" if $verbose >= 3;
         die "${progname}: Unable to inject prologue code\n" if $sample_ps !~ s/TeXDict begin\s+\d+\s+\d+\s+bop/\n$showfontnamecode\n$&/s;
     }
 
@@ -1063,7 +1170,12 @@ program's internal operations.
 Force B<pkfix-helper> to associate a specific font with a given font
 name appearing the document.  I<name> is a two-character B<dvips> font
 name such as C<Fa>.  I<fontspec> is a font specification such as
-S<C<cmsy10 @ 1.1X>>.  The B<--force> option can be specified
+C<cmmi8> or S<C<cmsy10 @ 1.1X>>.  An asterisk used in the name of the
+base font S<(e.g., C<cmti*>)> will automatically try all integral test
+font sizes from 5 to 17 points (C<cmti5>, S<C<cmti6>, ...,>
+C<cmti17>).  An asterisk used as a scale value S<(e.g., C<cmsy10 @
+*>)> will be replaced by the scale value that gives the best match to
+the original font's metrics.  The B<--force> option can be specified
 repeatedly on the command line.
 
 =item B<-p> I<filename.ps>, B<--ps>=I<filename.ps>
@@ -1096,6 +1208,16 @@ previously extracted metrics from I<filename>, going through the
 F<tftopl>-based process only for TFM files that were not previously
 encountered.
 
+=item B<-q>, B<--quiet>
+
+Instruct B<pkfix-helper> to produce no output during its run except
+for fatal error messages.
+
+=item B<-1>, B<--no-repeats>
+
+Prevent B<pkfix-helper> from associating the same I<fontspec> with
+more than one B<dvips> font name.
+
 =item B<-i> I<fontspec>, B<--include>=I<fontspec>
 
 Add I<fontspec> to the list of font specifications against which
@@ -1121,15 +1243,12 @@ bitmapped image into a single-character font and using that font in
 LaTeX.  B<--keep> prevents such fonts from being replaced.  The
 B<--keep> option can be specified repeatedly on the command line.
 
-=item B<-q>, B<--quiet>
+=item B<-a>, B<--any-scale>
 
-Instruct B<pkfix-helper> to produce no output during its run except
-for fatal error messages.
-
-=item B<-1>, B<--no-repeats>
-
-Prevent B<pkfix-helper> from associating the same I<fontspec> with
-more than one B<dvips> font name.
+Allow any value to be used to scale a font when "C<*>" is specified as
+the scale factor.  Normally, B<pkfix-helper> considers only integer
+multiples of 0.1 that are greater than or equal to 1.0 (i.e.,
+I<fontname>C<@1X>, C<@1.1X>, C<@1.2X>, C<@1.3X>, etc.).
 
 =item B<-s>, B<--spp>
 
@@ -1245,7 +1364,7 @@ Let's hypothesize that C<cmb12> is a better match than C<cmbx12> but
 we don't know how much to scale the font.  Fortunately,
 B<pkfix-helper> allows C<*> to be used as a scaling factor to tell the
 program to automatically detect an optimal scaling factor, even if
-doing so means choosing a highly nonstandard font size:
+doing so means choosing a nonstandard font size:
 
     $ pkfix-helper oldfile.ps pkfix-oldfile.ps --force="Ff=cmb12 @ *"
     Reading oldfile.ps ... done.
@@ -1268,7 +1387,7 @@ Let's try scaling up F<cmb10.tfm> instead:
         Processing Fi ... done (cmr10 @ 1X, mismatch=0.11683).
         Processing Fa ... done (cmti10 @ 1X, mismatch=0.08892).
         Processing Fb ... done (cmr8 @ 1X, mismatch=0.07133).
-        Processing Ff ... done (cmb10 @ 1.5708X, mismatch=0.00035).
+        Processing Ff ... done (cmb10 @ 1.5X, mismatch=0.00035).
         Processing Fh ... done (cmtt10 @ 1X, mismatch=0.06895).
         Processing Fd ... done (cmmi10 @ 1X, mismatch=0.03966).
         Processing Fj ... done (cmbx12 @ 1X, mismatch=0.03972).
@@ -1276,12 +1395,12 @@ Let's try scaling up F<cmb10.tfm> instead:
         Processing Fg ... done (cmsy10 @ 1X, mismatch=0.00875).
         Processing Fc ... done (cmr6 @ 1X, mismatch=0.00284).
 
-The match has definitely improved, although S<15.708 pt.> is certainly
-an odd size for a font.  Then again, many documents I<do> use
-nonstandard sizes so this may in fact be correct.  The best way to
-verify is once again to produce, print, and compare a pair of font
-samples and iterate until all of the fonts look correct.  Use one
-instance of B<--force> for each font you want to alter.
+The match has definitely improved, although S<15 pt.> is certainly an
+odd size for a font.  Then again, many documents I<do> use nonstandard
+sizes so this may in fact be correct.  The best way to verify is once
+again to produce, print, and compare a pair of font samples and
+iterate until all of the fonts look correct.  Use one instance of
+B<--force> for each font you want to alter.
 
 
 =head1 ENVIRONMENT
@@ -1352,7 +1471,7 @@ Scott Pakin, I<scott+pkfh@pakin.org>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright (C) 2010, Scott Pakin
+Copyright (C) 2011, Scott Pakin
 
 This file may be distributed and/or modified under the conditions of
 the LaTeX Project Public License, either version 1.3c of this license