diff options
Diffstat (limited to 'Master/bin/sparc-solaris/pkfix')
| -rwxr-xr-x | Master/bin/sparc-solaris/pkfix | 860 |
1 files changed, 860 insertions, 0 deletions
diff --git a/Master/bin/sparc-solaris/pkfix b/Master/bin/sparc-solaris/pkfix new file mode 100755 index 00000000000..1429889b9ec --- /dev/null +++ b/Master/bin/sparc-solaris/pkfix @@ -0,0 +1,860 @@ +eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q' + if 0; +use strict; +$^W=1; # turn warning on +# +# pkfix.pl +# +# Copyright (C) 2001, 2005 Heiko Oberdiek. +# +# This work may be distributed and/or modified under the +# conditions of the LaTeX Project Public License, either version 1.3 +# of this license or (at your option) any later version. +# The latest version of this license is in +# http://www.latex-project.org/lppl.txt +# and version 1.3 or later is part of all distributions of LaTeX +# version 2003/12/01 or later. +# This work has the LPPL maintenance status "maintained". +# This Current Maintainer of this work is Heiko Oberdiek. +# +# See file "README" for a list of files that belongs to this project. +# +# This file "pkfix.pl" may be renamed to "pkfix" +# for installation purposes. +# +my $file = "pkfix.pl"; +my $program = uc($&) if $file =~ /^\w+/; +my $project = lc($program); +my $version = "1.3"; +my $date = "2005/02/25"; +my $author = "Heiko Oberdiek"; +my $copyright = "Copyright (c) 2001, 2005 by $author."; +# +# Reqirements: Perl5, dvips +# History: +# 2001/04/12 v0.1: +# * First try. +# 2001/04/13 v0.2: +# * TeX/dvips is called for each font for the case of errors. +# * First release. +# 2001/04/15 v0.3: +# * Call of kpsewhich with option --progname. +# * Extracting of texps.pro from temporary PostScript file, +# if kpsewhich failed. +# * Option -G0 for dvips run added. +# 2001/04/16 v0.4: +# * Support for merging PostScript fonts added. +# * \special{!...}/@fedspecial detection added. +# * Bug fix: I detection. +# 2001/04/17 v0.5: +# * Redirection of stderr (dvips run) if possible. +# 2001/04/20 v0.6: +# * Bug fix: dvips font names can contain numbers. +# 2001/04/21 v0.7: +# * Bug fix: long dvi file name in ps file. +# 2001/04/23 v0.8: +# * Bug fix: post string parsing. +# 2001/04/26 v0.9: +# * Check of version number of dvips in PostScript file. +# 2001/06/30 v1.0: +# * Problem with DOS line endings fixed. +# 2005/01/28 v1.1: +# * Bug fix: encoding files are now included also. +# * The intermediate DVI files are written directly. +# * LPPL 1.3 +# 2005/01/29 v1.2: +# * Merging is now based on type 1 names. This solves +# the problem, if different bitmap fonts maps to the +# same type 1 font, eg. (ecrm1000, larm1000) -> SFRM1000. +# * Suppression of PK generation, if environment variable +# MKTEXPK is supported. +# * If output file is "-" (standard output) then messages of +# pkfix are written to standard error output. +# 2005/02/25 v1.3: +# * Bug fix: Detection of "@fedspecial end" improved. +# * Bug fix: Typo corrected (PRT -> $PRT). +# + +### program identification +my $title = "$program $version, $date - $copyright\n"; + +### error strings +my $Error = "!!! Error:"; # error prefix +my $Warning = "!!! Warning:"; # warning prefix + +### variables +my $envvar = uc($project); +my $infile = ""; +my $outfile = ""; +my $texpsfile = "texps.pro"; +my $prefix = "_${project}_$$"; +# my $prefix = "_${project}_"; +my $tempfile = "$prefix"; +my $texfile = "$tempfile.tex"; +my $dvifile = "$tempfile.dvi"; +my $logfile = "$tempfile.log"; +my $psfile = "$tempfile.ps"; +my $missfile = "missfont.log"; +my @cleanlist = ($dvifile, $psfile); +push(@cleanlist, $missfile) unless -f $missfile; + +my $err_redirect = " 2>&1"; +$err_redirect = "" if $^O =~ /dos/i || + $^O =~ /os2/i || + $^O =~ /mswin32/i || + $^O =~ /cygwin/i; + +my $x_resolution = 0; +my $y_resolution = 0; +my $blocks_found = 0; +my $fonts_converted = 0; +my $fonts_merged = 0; +my $fonts_misses = 0; +my $PRT = \*STDOUT; + +### option variables +my @bool = ("false", "true"); +$::opt_tex = "tex"; +$::opt_dvips = "dvips"; +$::opt_kpsewhich = "kpsewhich --progname $project"; +$::opt_options = "-Ppdf -G0"; +$::opt_usetex = 0; +$::opt_help = 0; +$::opt_quiet = 0; +$::opt_debug = 0; +$::opt_verbose = 0; +$::opt_clean = 1; + +my $usage = <<"END_OF_USAGE"; +${title}Syntax: \L$program\E [options] <inputfile.ps> <outputfile.ps> +Function: This program tries to replace pk fonts in <inputfile.ps> + by the type 1 versions. The result is written in <outputfile.ps>. +Options: (defaults:) + --help print usage + --(no)quiet suppress messages ($bool[$::opt_quiet]) + --(no)verbose verbose printing ($bool[$::opt_verbose]) + --(no)debug debug informations ($bool[$::opt_debug]) + --(no)clean clear temp files ($bool[$::opt_clean]) + --(no)usetex use TeX for generating the DVI file ($bool[$::opt_usetex]) + --tex texcmd tex command name (plain format) ($::opt_tex) + --dvips dvipscmd dvips command name ($::opt_dvips) + --options opt dvips options ($::opt_options) +END_OF_USAGE + +### environment variable PKFIX +if ($ENV{$envvar}) { + unshift(@ARGV, split(/\s+/, $ENV{$envvar})); +} + +### process options +my @OrgArgv = @ARGV; +use Getopt::Long; +GetOptions( + "help!", + "quiet!", + "debug!", + "verbose!", + "clean!", + "usetex!", + "tex=s", + "dvips=s", + "options=s" +) or die $usage; +!$::opt_help or die $usage; +@ARGV < 3 or die "$usage$Error Too many files!\n"; +@ARGV == 2 or die "$usage$Error Missing file names!\n"; + +$::opt_quiet = 0 if $::opt_verbose; +$::opt_clean = 0 if $::opt_debug; + +push(@cleanlist, $texfile, $logfile) if $::opt_usetex; + +### get file names +$infile = $ARGV[0]; +$outfile = $ARGV[1]; + +### suppress PK generation +$ENV{'MKTEXPK'} = "0"; + +$PRT = \*STDERR if $outfile eq "-"; + +print $PRT $title unless $::opt_quiet; + +print $PRT "*** input file: `$infile'\n" if $::opt_verbose; +print $PRT "*** output file: `$outfile'\n" if $::opt_verbose; + +if ($::opt_debug) { + print $PRT <<"END_DEB"; +*** OSNAME: $^O +*** PERL_VERSION: $] +*** ARGV: @OrgArgv +END_DEB +} + +### get texps.pro +my $texps_data = 0; +my $texps_string = get_texps_pro(); + +### Encoding definitions +my %encoding_files = (); +my $encoding_string = ""; + +### open input and output files +open(IN, $infile) or die "$Error Cannot open `$infile'!\n"; +open(OUT, ">$outfile") or die "$Error Cannot write `$outfile'!\n"; + +################################## +# expected format: +# ... +# %%DVIPSParameters:... dpi=([\dx]+)... +# ... +# TeXDict begin \d+ \d+ \d+ \d+ \d+ \(\S+\) +# @start ... +# ... +# %DVIPSBitmapFont: (\S+) (\S+) ([\d\.]+) (\d+) +# /(\S+) ... +# ... +# %EndDVIPSBitmapFont +# ... +# ... end +# %%EndProlog +# +# or if \special{!...} was used, the lines with TeXDict: +# TeXdict begin @defspecial +# +# ... +# +# @fedspecial end TeXDict begin +# \d+ \d+ \d+ \d+ \d+ \(\S+\) @start +# +# or +# @fedspecial end +# ... +# +# bitmap font: +# start: +# %%DVIPSBitmapFont: {dvips font} {font name} {at x pt} {chars} +# /{dvips font} {chars} {max. char number + 1} df +# character, variant a: +# <{hex code}>{char number} D +# character, variant b:\ +# [<{hex code}>{num1} {num2} {num3} {num4} {num5} {char number} D +# end: +# E +# %%EndDVIPSBitmapFont +# +# type 1 font: +# before TeXDict line: +# %%BeginFont: CMR10 +# ... +# %%EndFont +# after @start: +# /Fa ... /CMR10 rf +# +# Font names: /[F-Z][a-zA-Z0-9] +# +# Encoding files before texps.pro: +# %%BeginProcSet: {file name}.enc 0 0 +# ... +# %%EndProcSet +################################### + +my $x_comment_resolution = 0; +my $y_comment_resolution = 0; +my $start_string = ""; +my $post_string = ""; +my $dvips_resolution = ""; +my $texps_found = 0; +my @font_list = (); +my %font_txt = (); +my %font_count = (); +my %font_entry = (); + +sub init { + $x_comment_resolution = 0; + $y_comment_resolution = 0; + $x_resolution = 0; + $y_resolution = 0; + $start_string = ""; + $texps_found = 0; + @font_list = (); + %font_txt = (); + %font_count = (); + %font_entry = (); +} + +init(); + +while (<IN>) { + + if (/^%%Creator: (dvips\S*) (\S+)\s/) { + print $PRT "*** %%Creator: $1 $2\n" if $::opt_debug; + my $foundversion = $2; + if ($foundversion =~ /(\d+\.\d+)/) { + $foundversion = $1; + # 5.62 is ok, 5.58 does not produce font comments + if ($foundversion <= 5.58) { + print $PRT "$Warning dvips version $1 does not generate " . + "the required font comments!\n"; + } + } + } + + if (/^%%BeginProcSet:\s*(.+)\.enc/) { + $encoding_files{$1} = ""; + } + + if (/^%DVIPSParameters:.*dpi=([\dx]+)/) { + print OUT; + my $str = $1; + $x_comment_resolution = 0; + $y_comment_resolution = 0; + if ($str =~ /^(\d+)x(\d+)$/) { + $x_comment_resolution = $1; + $y_comment_resolution = $2; + } + if ($str =~ /^(\d+)$/) { + $x_comment_resolution = $1; + $y_comment_resolution = $1; + } + print $PRT "*** %DVIPSParameters: dpi=$str " . + "(x=$x_comment_resolution, y=$y_comment_resolution)\n" + if $::opt_debug; + $x_comment_resolution > 0 && $y_comment_resolution > 0 or + die "$Error Wrong resolution value " . + "($x_comment_resolution x $y_comment_resolution)!\n"; + next; + } + + if (/^%%BeginProcSet: texps.pro/) { + $texps_found = 1; + print $PRT "*** texps.pro found\n" if $::opt_debug; + } + + if (/^TeXDict begin \@defspecial/) { + my $saved = $_; + print $PRT "*** \@defspecial found.\n" if $::opt_debug; + $start_string = $_; + while (<IN>) { + $start_string .= $_; + if (/^\@fedspecial end/) { + s/^\@fedspecial end\s*(\S)/$1/; + last; + } + } + } + elsif (/^TeXDict begin \d+ \d+ \d+ \d+ \d+/) { + print $PRT "*** TeXDict begin <5 nums> found.\n" if $::opt_debug; + $start_string = $_; + } + if ($start_string ne "") { + # look for @start + unless (/\@start/) { + while (<IN>) { + $start_string .= $_; + last if /\@start/; + } + } + + # divide post part + $start_string =~ /^([\s\S]*\@start)\s*([\s\S]*)$/ or + die "$Error Parse error (\@start)!\n"; + $start_string = "$1\n"; + $post_string = $2; + $post_string =~ s/\s*$//; + $post_string .= "\n" unless $post_string eq ""; + + $start_string =~ + /\d+\s+\d+\s+\d+\s+(\d+)\s+(\d+)\s+\((.*)\)\s+\@start/ or + die "$Error Parse error (\@start parameters)!\n"; + + $blocks_found++; + print $PRT "*** dvi file: $3\n" if $::opt_debug; + + # get and check resolution values + $x_resolution = $1; + $y_resolution = $2; + print $PRT "*** resolution: $x_resolution x $y_resolution\n" + if $::opt_debug; + $x_comment_resolution > 0 or + die "$Error Missing comment `%DVIPSParameters'!\n"; + $x_resolution == $x_comment_resolution && + $y_resolution == $y_comment_resolution or + die "$Error Resolution values in comment and PostScript " . + "does not match!\n"; + # setting dvips resolution option(s) + if ($x_resolution == $y_resolution) { + $dvips_resolution = "-D $x_resolution"; + } + else { + $dvips_resolution = "-X $x_resolution -Y $y_resolution"; + } + + while (<IN>) { + if (/^%%EndProlog/) { + print OUT $encoding_string; + $texps_data > 0 or die "$Error File `texps.pro' not found!\n"; + print OUT $texps_string unless $texps_found; + foreach (@font_list) { + my $fontname = $_; + print $PRT "*** Adding font `$fontname'\n" + if $::opt_debug; + my ($dummy1, $dummy2, $err); + if ($font_count{$fontname} > 1) { + $fonts_merged++; + print $PRT "*** Merging font `$fontname' ($font_count{$fontname}).\n" + unless $::opt_quiet; + ($dummy1, $font_txt{$fontname}, $dummy2, $err) = + get_font($font_entry{$fontname}); + $err == 0 or die "$Error Cannot merge font `$fontname'!\n"; + } + print OUT $font_txt{$fontname}; + } + print OUT $start_string, + $post_string, + $_; + print $PRT "*** %%EndProlog\n" if $::opt_debug; + init(); + last; + } + + if (/^%DVIPSBitmapFont: (\S+) (\S+) ([\d.]+) (\d+)/) { + my $bitmap_string = $_; + my $dvips_fontname = $1; + my $fontname = $2; + my $entry = "\\Font\{$1\}\{$2\}\{$3\}\{"; + print $PRT "*** Font $1: $2 at $3pt, $4 chars\n" if $::opt_verbose; + my $line = ""; + my $num = -1; + my $chars = $4; + my $count = 0; + while (<IN>) { + $bitmap_string .= $_; + last if /^%EndDVIPSBitmapFont/; + s/\r$//; # remove \r of possible DOS line ending + chomp; + $line .= " " . $_; + } + $line =~ s/<[0-9A-F ]*>/ /g; + + print $PRT "*** <Font> $line\n" if $::opt_debug; + + while ($line =~ /\s(\d+)\s+D(.*)/) { + $num = $1; + $count++; + $entry .= "$num,"; + $line = $2; + while ($line =~ /^[\s\d\[]*I(.*)/) { + $num++; + $count++; + $entry .= "$num,"; + $line = $1; + } + } + $chars == $count or + die "$Error Parse error, $count chars of $chars found " . + "($fontname)!\n"; + + $entry =~ s/,$//; + $entry .= "\}"; + + print $PRT "*** Font conversion of `$fontname' started.\n" + if $::opt_verbose; + my ($newfontname, $font_part, $start_part, $err) = get_font($entry); + if ($err == 0) { + print $PRT "*** Font conversion: `$fontname' -> `$newfontname'.\n" + unless $::opt_quiet; + if (defined($font_count{$newfontname})) { + $font_count{$newfontname}++; + $font_entry{$newfontname} .= "\n$entry"; + } + else { + push @font_list, $newfontname; + $font_txt{$newfontname} = $font_part; + $font_count{$newfontname} = 1; + $font_entry{$newfontname} = $entry; + } + $start_part =~ s/\/Fa/\/$dvips_fontname/; + $start_string .= $start_part; + $fonts_converted++; + } + else { + print $PRT "!!! Failed font conversion of `$fontname'!\n"; + $start_string .= $bitmap_string; + $fonts_misses++; + } + + next; + } + + $post_string .= $_; + } + next; + } + + print OUT; +} + +close(IN); +close(OUT); + +if ($::opt_clean) { + print $PRT "*** clear temp files\n" if $::opt_verbose; + foreach (@cleanlist) { + unlink; + } +} + +if (!$::opt_quiet) { + if ($blocks_found > 1) { + print $PRT "==> $blocks_found blocks.\n"; + } + if ($fonts_misses) { + print $PRT "==> $fonts_misses font conversion", + (($fonts_misses > 1) ? "s" : ""), + " failed.\n"; + } + if ($fonts_converted) { + print $PRT "==> ", + (($fonts_converted > 0) ? $fonts_converted : "No"), + " converted font", + (($fonts_converted > 1) ? "s" : ""), + ".\n"; + if ($fonts_merged) { + print $PRT "==> $fonts_merged merged font", + (($fonts_merged > 1) ? "s" : ""), + ".\n"; + } + } + else { + print $PRT "==> no fonts converted\n"; + } +} + + +# get type 1 font +# param: $entry: font entry as TeX string +# return: $name: type 1 font name +# $font: font file as string +# $start: font definition after @start +# $err: error indication +sub get_font { + my $entry = shift; + my $name = ""; + my $font = ""; + my $start = ""; + my $err = 0; + my @err = ("", "", "", 1); + local *OUT; + local *IN; + + if ($::opt_usetex) { + ### write temp tex file + open(OUT, ">$texfile") or die "$Error Cannot write `$texfile'!\n"; + print OUT <<'TEX_HEADER'; +\nonstopmode +\nopagenumbers +\def\Font#1#2#3#4{% + \expandafter\font\csname font@#1\endcsname=#2 at #3pt\relax + \csname font@#1\endcsname + \hbox to 0pt{% + \ScanChar#4,\NIL + \hss + }% +} +\def\ScanChar#1,#2\NIL{% + \char#1\relax + \ifx\\#2\\% + \else + \ReturnAfterFi{% + \ScanChar#2\NIL + }% + \fi +} +\long\def\ReturnAfterFi#1\fi{\fi#1} +\noindent +TEX_HEADER + + print OUT "$entry\n\\bye\n"; + close(OUT); + + ### run tex + { + print $PRT "*** run TeX\n" if $::opt_verbose; + + my $cmd = "$::opt_tex $tempfile"; + print $PRT ">>> $cmd\n" if $::opt_verbose; + my @capture = `$cmd`; + if (!defined(@capture)) { + print $PRT "$Warning Cannot execute TeX!\n"; + return @err; + } + if ($::opt_verbose) { + print $PRT @capture; + } + else { + foreach (@capture) { + print $PRT if /^!\s/; + } + } + if ($?) { + my $exitvalue = $?; + if ($exitvalue > 255) { + $exitvalue >>= 8; + print $PRT "$Warning Closing TeX (exit status: $exitvalue)!\n"; + return @err; + } + print $PRT "$Warning Closing TeX ($exitvalue)!\n"; + return @err; + } + } + } + else { + # write dvi directly + + # DVI format description: dvitype.web + my $DVI_pre = 247; + my $DVI_id_byte = 2; + my $DVI_num = 25400000; + my $DVI_den = 473628672; # 7227 * 2^16 + my $DVI_mag = 1000; + my @t = localtime(time); + my $DVI_comment = "$program $version output " + . sprintf("%04d/%02d/%02d %02d:%02d:%02d", + ($t[5] + 1900), ($t[4] + 1), $t[3], $t[2], $t[1], $t[0]); + my $DVI_comment_len = length($DVI_comment); + my $DVI_bop = 139; + my $DVI_eop = 140; + my $DVI_fontdef1 = 243; + my $DVI_fontdef2 = 244; + my $DVI_fontdef4 = 246; + my $DVI_design_size = 10; # an arbitrary value + # A wrong value will trigger a dvips warning + # (it can be seen in verbose mode): + # dvips: Design size mismatch in [...].tfm + # But other consequences could not be noticed. + # Thus a TFM lookup will be saved. + my $DVI_checksum = 0; # because of unknown checksum + my $DVI_fnt_num_0 = 171; + my $DVI_fnt1 = 235; + my $DVI_fnt2 = 236; + my $DVI_fnt4 = 238; + my $DVI_set1 = 128; + my $DVI_push = 141; + my $DVI_pop = 142; + my $DVI_post = 248; + my $DVI_u = 67108864; # 1024 pt, an arbitrary value + my $DVI_l = 67108864; # 1024 pt, an arbitrary value + my $DVI_post_post = 249; + my $DVI_trailing = 223; + + open(OUT, ">$dvifile") or die "$Error Cannot write `$dvifile'!\n"; + binmode(OUT); + + # Preamble (pre) + print OUT pack("C2N3Ca$DVI_comment_len", + $DVI_pre, $DVI_id_byte, $DVI_num, $DVI_den, $DVI_mag, + $DVI_comment_len, $DVI_comment); + # Begin of page (bop) + my $pos_bop = tell(OUT); + print OUT pack("CN1x[N9]l", $DVI_bop, 1, -1); + + my $font_defs = ""; + my $font_num = 0; + foreach(split("\n", $entry)) { + my $font_def = ""; + /\\Font\{[^}]*\}\{([^}]*)\}\{([^}]*)\}\{([^}]*)\}/ or + die "!!! Error: Internal parsing error!\n"; + my $font_name = $1; + my $font_name_len = length($font_name); + my $font_size = $2; + my $font_chars = $3; + + # define font + if ($font_num < 256) { + $font_def = pack("CC", $DVI_fontdef1, $font_num); + } + # The other cases are very unlikely, especially there are + # more than one font in the merging case only. + elsif ($font_num < 65536) { + $font_def = pack("Cn", $DVI_fontdef2, $font_num); + } + else { + $font_def = pack("CN", $DVI_fontdef4, $font_num); + } + $font_def .= pack("x[N]N2xCa$font_name_len", + ($font_size * 65536), $DVI_design_size, + $font_name_len, $font_name); + print OUT $font_def; + $font_defs .= $font_def; + + # use font + my $fnt_num; + if ($font_num < 64) { + $fnt_num = pack("C", $DVI_fnt_num_0 + $font_num); + } + # Other cases are unlikely, see above. + elsif ($font_num < 256) { + $fnt_num = pack("CC", $DVI_fnt1, $font_num); + } + elsif ($font_num < 65536) { + $fnt_num = pack("Cn", $DVI_fnt2, $font_num); + } + else { + $fnt_num = pack("CN", $DVI_fnt4, $font_num); + } + print OUT $fnt_num; + + # print characters + print OUT pack("C", $DVI_push); + foreach (split(",", $font_chars)) { + if ($_ < 128) { + print OUT pack("C", $_); + } + else { + print OUT pack("CC", $DVI_set1, $_); + } + } + print OUT pack("C", $DVI_pop); + + $font_num++; + } + + print OUT pack("C", $DVI_eop); + + # Begin of postamble (post) + my $pos_post = tell(OUT); + print OUT pack("CN6n2", + $DVI_post, $pos_bop, $DVI_num, $DVI_den, $DVI_mag, + $DVI_l, $DVI_u, 1, 1); + print OUT $font_defs; + # End of postamble (post_post) + print OUT pack("CNC5", + $DVI_post_post, $pos_post, $DVI_id_byte, + $DVI_trailing, $DVI_trailing, $DVI_trailing, $DVI_trailing); + my $t_num = (4 - (tell(OUT) % 4)) % 4; + print OUT pack("C", $DVI_trailing) x $t_num; + close(OUT); + } + + ### run dvips + { + print $PRT "*** run dvips\n" if $::opt_verbose; + + my $cmd = "$::opt_dvips $::opt_options $dvips_resolution $tempfile"; + print $PRT ">>> $cmd\n" if $::opt_verbose; + # dvips writes on stderr :-( + my @capture = `$cmd$err_redirect`; + if ($::opt_verbose) { + print $PRT @capture; + } + if ($?) { + my $exitvalue = $?; + if ($exitvalue > 255) { + $exitvalue >>= 8; + print $PRT "$Warning Closing dvips (exit status: $exitvalue)!\n"; + return @err; + } + print $PRT "$Warning Closing dvips ($exitvalue)!\n"; + return @err; + } + } + + ### get font and start part + open(IN, $psfile) or die "$Error Cannot open `$psfile'!\n"; + + while (<IN>) { + ### get possible encoding files + if (/^%%BeginProcSet:\s*(.+)\.enc/) { + my $encoding_file = $1; + print $PRT "*** encoding file `$encoding_file.enc' found.\n" + if $::opt_debug; + next if defined($encoding_files{$encoding_file}); + $encoding_files{$encoding_file} = ""; + $encoding_string .= $_; + while (<IN>) { + $encoding_string .= $_; + last if /^%%EndProcSet/; + } + next; + } + + ### get texps.pro if get_texps_pro() has failed + if ($texps_data == 0 && /^%%BeginProcSet: texps.pro/) { + $texps_string = $_; + while (<IN>) { + $texps_string .= $_; + last if /^%%EndProcSet/; + } + $texps_data = 1; + print $PRT "*** texps.pro extracted.\n" if $::opt_debug; + next; + } + + if (/^%%BeginFont:\s*(\S+)/) { + $name = $1; + $font .= $_; + while (<IN>) { + $font .= $_; + last if /^%%EndFont/; + } + next; + } + if (/^\@start/) { + s/^\@start\s*//; + $start .= $_; + while (<IN>) { + last if /^%%EndProlog/; + $start .= $_; + } + if (($start =~ s/\s*end\s*$/\n/) != 1) { + $err = 1; + print $PRT "$Warning Parse error, `end' not found!\n"; + } + print $PRT "*** start: $start" if $::opt_debug; + last; + } + } + close(IN); + + if ($font eq "") { + print $PRT "$Warning `%%BeginFont' not found!\n"; + return @err; + } + return ($name, $font, $start, $err); +} + + +# get_texps_pro +# return: string with content of texps.pro +sub get_texps_pro { + $texps_data = 0; + # get file name + my $backupWarn = $^W; + $^W = 0; + my $file = `$::opt_kpsewhich $texpsfile`; + $^W = $backupWarn; + if (!defined($file) or $file eq "") { + print $PRT "$Warning: Cannot find `$texpsfile' with kpsewhich!\n" + if $::opt_debug; + return ""; + } + chomp $file; + print $PRT "*** texps.pro: $file\n" if $::opt_debug; + + # read file + local *IN; + open(IN, $file) or die "$Error: Cannot open `$file'!\n"; + my @lines = <IN>; + @lines > 0 or die "$Error: Empty file `$file'!\n"; + chomp $lines[@lines-1]; + my $str = "%%BeginProcSet: texps.pro\n"; + $"=""; + $str .= "@lines\n"; + $"=" "; + $str .= "%%EndProcSet\n"; + $texps_data = 1; + return $str; +} + +__END__ |