summaryrefslogtreecommitdiff
path: root/Master/texmf
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2006-01-02 23:53:39 +0000
committerKarl Berry <karl@freefriends.org>2006-01-02 23:53:39 +0000
commit582c6b537a86231f69a815b07d1471f5d54f8e23 (patch)
treef24ee06e06979fe5c828d6f93ce0f98de835e823 /Master/texmf
parent676af4363c3a6cb4c3b1012f295507574b277187 (diff)
trunk/Master/texmf/scripts
git-svn-id: svn://tug.org/texlive/trunk@33 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf')
-rw-r--r--Master/texmf/scripts/pdfcrop/pdfcrop.pl308
-rw-r--r--Master/texmf/scripts/pkfix/pkfix.pl860
-rw-r--r--Master/texmf/scripts/ps2eps/ps2eps.pl914
-rw-r--r--Master/texmf/scripts/tetex/e2pall.pl87
-rw-r--r--Master/texmf/scripts/tetex/epstopdf.pl309
-rw-r--r--Master/texmf/scripts/tetex/texdoctk.pl1790
-rw-r--r--Master/texmf/scripts/tetex/texi2html.pl2125
-rw-r--r--Master/texmf/scripts/tetex/updmap.pl1101
-rw-r--r--Master/texmf/scripts/tex4ht/htcopy.pl45
-rw-r--r--Master/texmf/scripts/tex4ht/htmove.pl45
-rw-r--r--Master/texmf/scripts/thumbpdf/thumbpdf.pl1562
11 files changed, 9146 insertions, 0 deletions
diff --git a/Master/texmf/scripts/pdfcrop/pdfcrop.pl b/Master/texmf/scripts/pdfcrop/pdfcrop.pl
new file mode 100644
index 00000000000..c7d2319af7a
--- /dev/null
+++ b/Master/texmf/scripts/pdfcrop/pdfcrop.pl
@@ -0,0 +1,308 @@
+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
+#
+# pdfcrop.pl
+#
+# Copyright (C) 2002, 2004 Heiko Oberdiek.
+#
+# This program may be distributed and/or modified under the
+# conditions of the LaTeX Project Public License, either version 1.2
+# 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.2 or later is part of all distributions of LaTeX
+# version 1999/12/01 or later.
+#
+# See file "readme.txt" for a list of files that belong to this project.
+#
+# This file "pdfcrop.pl" may be renamed to "pdfcrop"
+# for installation purposes.
+#
+my $file = "pdfcrop.pl";
+my $program = uc($&) if $file =~ /^\w+/;
+my $version = "1.5";
+my $date = "2004/06/24";
+my $author = "Heiko Oberdiek";
+my $copyright = "Copyright (c) 2002, 2004 by $author.";
+#
+# Reqirements: Perl5, Ghostscript
+# History:
+# 2002/10/30 v1.0: First release.
+# 2002/10/30 v1.1: Option --hires added.
+# 2002/11/04 v1.2: "nul" instead of "/dev/null" for windows.
+# 2002/11/23 v1.3: Use of File::Spec module's "devnull" call.
+# 2002/11/29 v1.4: Option --papersize added.
+# 2004/06/24 v1.5: Clear map file entries so that pdfTeX
+# does not touch the fonts.
+#
+
+### program identification
+my $title = "$program $version, $date - $copyright\n";
+
+### error strings
+my $Error = "!!! Error:"; # error prefix
+
+### string constants for Ghostscript run
+# get Ghostscript command name
+my $GS = "gs";
+$GS = "gs386" if $^O =~ /dos/i;
+$GS = "gsos2" if $^O =~ /os2/i;
+$GS = "gswin32c" if $^O =~ /mswin32/i;
+$GS = "gswin32c" if $^O =~ /cygwin/i;
+
+# Windows detection (no SIGHUP)
+my $Win = 0;
+$Win = 1 if $^O =~ /mswin32/i;
+$Win = 1 if $^O =~ /cygwin/i;
+
+# "null" device
+use File::Spec::Functions qw(devnull);
+my $null = devnull();
+
+### variables
+my $inputfile = "";
+my $outputfile = "";
+my $tmp = "tmp-\L$program\E-$$";
+
+### option variables
+my @bool = ("false", "true");
+$::opt_help = 0;
+$::opt_debug = 0;
+$::opt_verbose = 0;
+$::opt_gscmd = $GS;
+$::opt_pdftexcmd = "pdftex";
+$::opt_margins = "0 0 0 0";
+$::opt_clip = 0;
+$::opt_hires = 0;
+$::opt_papersize = "";
+
+my $usage = <<"END_OF_USAGE";
+${title}Syntax: \L$program\E [options] <input[.pdf]> [output file]
+Function: Margins are calculated and removed for each page in the file.
+Options: (defaults:)
+ --help print usage
+ --(no)verbose verbose printing ($bool[$::opt_verbose])
+ --(no)debug debug informations ($bool[$::opt_debug])
+ --gscmd <name> call of ghostscript ($::opt_gscmd)
+ --pdftexcmd <name> call of pdfTeX ($::opt_pdftexcmd)
+ --margins "<left> <top> <right> <bottom>" ($::opt_margins)
+ add extra margins, unit is bp. If only one number is
+ given, then it is used for all margins, in the case
+ of two numbers they are also used for right and bottom.
+ --(no)clip clipping support, if margins are set ($bool[$::opt_clip])
+ --(no)hires using `%%HiResBoundingBox' ($bool[$::opt_hires])
+ instead of `%%BoundingBox'
+ --papersize <foo> parameter for gs's -sPAPERSIZE=<foo>,
+ use only with older gs versions <7.32 ($::opt_papersize)
+Examples:
+ \L$program\E --margins 10 input.pdf output.pdf
+ \L$program\E --margins '5 10 5 20' --clip input.pdf output.pdf
+END_OF_USAGE
+
+### process options
+my @OrgArgv = @ARGV;
+use Getopt::Long;
+GetOptions(
+ "help!",
+ "debug!",
+ "verbose!",
+ "gscmd=s",
+ "pdftexcmd=s",
+ "margins=s",
+ "clip!",
+ "hires!",
+ "papersize=s",
+) or die $usage;
+!$::opt_help or die $usage;
+
+$::opt_verbose = 1 if $::opt_debug;
+
+@ARGV >= 1 or die $usage;
+
+print $title;
+
+@ARGV <= 2 or die "$Error Too many files!\n";
+
+### input file
+$inputfile = shift @ARGV;
+
+if (! -f $inputfile) {
+ if (-f "$inputfile.pdf") {
+ $inputfile .= ".pdf";
+ }
+ else {
+ die "$Error Input file `$inputfile' not found!\n";
+ }
+}
+
+print "* Input file: $inputfile\n" if $::opt_debug;
+
+### output file
+if (@ARGV) {
+ $outputfile = shift @ARGV;
+}
+else {
+ $outputfile = $inputfile;
+ $outputfile =~ s/\.pdf$//i;
+ $outputfile .= "-crop.pdf";
+}
+
+print "* Output file: $outputfile\n" if $::opt_debug;
+
+### margins
+my ($llx, $lly, $urx, $ury) = (0, 0, 0, 0);
+if ($::opt_margins =~
+ /^\s*([\-\.\d]+)\s+([\-\.\d]+)\s+([\-\.\d]+)\s+([\-\.\d]+)\s*$/) {
+ ($llx, $lly, $urx, $ury) = ($1, $2, $3, $4);
+}
+else {
+ if ($::opt_margins =~ /^\s*([\-\.\d]+)\s+([\-\.\d]+)\s*$/) {
+ ($llx, $lly, $urx, $ury) = ($1, $2, $1, $2);
+ }
+ else {
+ if ($::opt_margins =~ /^\s*([\-\.\d]+)\s*$/) {
+ ($llx, $lly, $urx, $ury) = ($1, $1, $1, $1);
+ }
+ else {
+ die "$Error Parse error (option --margins)!\n";
+ }
+ }
+}
+print "* Margins: $llx $lly $urx $ury\n" if $::opt_debug;
+
+### cleanup system
+my @unlink_files = ();
+my $exit_code = 1;
+sub clean {
+ print "* Cleanup\n" if $::opt_debug;
+ if ($::opt_debug) {
+ print "* Temporary files: @unlink_files\n";
+ }
+ else {
+ for (; @unlink_files>0; ) {
+ unlink shift @unlink_files;
+ }
+ }
+}
+sub cleanup {
+ clean();
+ exit($exit_code);
+}
+$SIG{'INT'} = \&cleanup;
+$SIG{'__DIE__'} = \&clean;
+
+### Calculation of BoundingBoxes
+
+my $cmd = "$::opt_gscmd -sDEVICE=bbox -dBATCH -dNOPAUSE ";
+$cmd .= "-sPAPERSIZE=$::opt_papersize " if $::opt_papersize;
+$cmd .= "-c save pop -f " . $inputfile;
+my $cmdpipe = $cmd . " 2>&1 1>$null |";
+
+my $tmpfile = "$tmp.tex";
+push @unlink_files, $tmpfile;
+open(TMP, ">$tmpfile") or
+ die "$Error Cannot write tmp file `$tmpfile'!\n";
+print TMP "\\def\\pdffile{$inputfile}\n";
+print TMP <<'END_TMP_HEAD';
+\csname pdfmapfile\endcsname{}
+\def\page #1 [#2 #3 #4 #5]{%
+ \count0=#1\relax
+ \setbox0=\hbox{%
+ \pdfximage page #1{\pdffile}%
+ \pdfrefximage\pdflastximage
+ }%
+ \pdfhorigin=-#2bp\relax
+ \pdfvorigin=#3bp\relax
+ \pdfpagewidth=#4bp\relax
+ \advance\pdfpagewidth by -#2bp\relax
+ \pdfpageheight=#5bp\relax
+ \advance\pdfpageheight by -#3bp\relax
+ \ht0=\pdfpageheight
+ \shipout\box0\relax
+}
+\def\pageclip #1 [#2 #3 #4 #5][#6 #7 #8 #9]{%
+ \count0=#1\relax
+ \dimen0=#4bp\relax \advance\dimen0 by -#2bp\relax
+ \edef\imagewidth{\the\dimen0}%
+ \dimen0=#5bp\relax \advance\dimen0 by -#3bp\relax
+ \edef\imageheight{\the\dimen0}%
+ \pdfximage page #1{\pdffile}%
+ \setbox0=\hbox{%
+ \kern -#2bp\relax
+ \lower #3bp\hbox{\pdfrefximage\pdflastximage}%
+ }%
+ \wd0=\imagewidth\relax
+ \ht0=\imageheight\relax
+ \dp0=0pt\relax
+ \pdfhorigin=#6pt\relax
+ \pdfvorigin=#7bp\relax
+ \pdfpagewidth=\imagewidth
+ \advance\pdfpagewidth by #6bp\relax
+ \advance\pdfpagewidth by #8bp\relax
+ \pdfpageheight=\imageheight\relax
+ \advance\pdfpageheight by #7bp\relax
+ \advance\pdfpageheight by #9bp\relax
+ \pdfxform0\relax
+ \shipout\hbox{\pdfrefxform\pdflastxform}%
+}%
+END_TMP_HEAD
+
+print "* Running ghostscript for BoundingBox calculation ...\n"
+ if $::opt_verbose;
+print "* Ghostscript pipe: $cmdpipe\n" if $::opt_debug;
+
+my $page = 0;
+open(CMD, $cmdpipe) or
+ die "$Error Cannot call ghostscript!\n";
+while (<CMD>) {
+ my $bb = ($::opt_hires) ? "%%HiResBoundingBox" : "%%BoundingBox";
+ next unless
+ /^$bb:\s*([\.\d]+) ([\.\d]+) ([\.\d]+) ([\.\d]+)/o;
+ $page++;
+ print "* Page $page: $1 $2 $3 $4\n" if $::opt_verbose;
+ if ($::opt_clip) {
+ print TMP "\\pageclip $page [$1 $2 $3 $4][$llx $lly $urx $ury]\n";
+ }
+ else {
+ my ($a, $b, $c, $d) = ($1 - $llx, $2 - $ury, $3 + $urx, $4 + $lly);
+ print TMP "\\page $page [$a $b $c $d]\n";
+ }
+}
+close(CMD);
+
+print TMP "\\csname \@\@end\\endcsname\n\\end\n";
+close(TMP);
+
+### Run pdfTeX
+
+push @unlink_files, "$tmp.log";
+if ($::opt_verbose) {
+ $cmd = "$::opt_pdftexcmd -interaction=nonstopmode $tmp";
+}
+else {
+ $cmd = "$::opt_pdftexcmd -interaction=batchmode $tmp";
+}
+print "* Running pdfTeX ...\n" if $::opt_verbose;
+print "* pdfTeX call: $cmd\n" if $::opt_debug;
+if ($::opt_verbose) {
+ system($cmd);
+}
+else {
+ `$cmd`;
+}
+if ($?) {
+ die "$Error pdfTeX run failed!\n";
+}
+
+### Move temp file to output
+rename "$tmp.pdf", $outputfile or
+ die "$Error Cannot move `$tmp.pdf' to `$outputfile'!\n";
+
+print "==> $page pages written on `$outputfile'.\n";
+
+$exit_code = 0;
+cleanup();
+
+__END__
diff --git a/Master/texmf/scripts/pkfix/pkfix.pl b/Master/texmf/scripts/pkfix/pkfix.pl
new file mode 100644
index 00000000000..1429889b9ec
--- /dev/null
+++ b/Master/texmf/scripts/pkfix/pkfix.pl
@@ -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__
diff --git a/Master/texmf/scripts/ps2eps/ps2eps.pl b/Master/texmf/scripts/ps2eps/ps2eps.pl
new file mode 100644
index 00000000000..041bfdbc75f
--- /dev/null
+++ b/Master/texmf/scripts/ps2eps/ps2eps.pl
@@ -0,0 +1,914 @@
+# eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q' # -*-perl-*-
+# if 0;
+# The expression in the previous line replaces the unix specific line
+# {#!/usr/bin/perl}.
+# ps2eps - convert PostScript to EPS (Encapsulated PostScript) files
+# -------------------------------------------------------------------
+# $Id: ps2eps,v 1.54 2004/04/23 07:56:54 bless Exp $
+# -------------------------------------------------------
+# (C)opyright 1999-2004 Roland Bless
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# Author: Roland Bless
+# Send bug reports to roland@bless.de
+# -------------------------------------------------------------------
+# Additional filtering is performed when Windows generated PostScript files
+# are processed. Some instructions will otherwise lead to bad output
+# if EPS-file gets embedded into other PostScript files.
+#
+# Requirements:
+# + perl
+# + gs (ghostscript supporting pbm output)
+# + bbox (a little C program [ANSI-C - should work on every platform]
+# for calculation of the actual BoundingBox)
+
+use POSIX;
+
+#use warnings;
+
+#use Getopt package
+use Getopt::Long;
+Getopt::Long::Configure("no_ignore_case");
+
+$prgname= "ps2eps";
+if ($^O =~ /MSWin32/i or $^O =~ /cygwin/i)
+{
+ $ghostscriptname = "gswin32c";
+}
+else
+{
+ $ghostscriptname = "gs";
+}
+
+$bboxver=`bbox >/dev/null 2>&1 -V`;
+$bboxname= ($?== -1) ? "" : "bbox";
+$version= '$Id: ps2eps,v 1.54 2004/04/23 07:56:54 bless Exp $'; #'
+$insertPScode= 1; # Insert surrounding Postscript code
+$infhandle = STDIN; # Standard input is the default input file
+$outfhandle = STDOUT; # Standard output is default output if STDIN is input
+$infname= '-';
+$outfname= '-';
+$forceoverwrite=0; # do not overwrite existing files
+$ignoreBB= 0; # ignore existing Bounding Box comment
+$removeDSC= 1; # remove Adobe document structure comments
+$removeADO= 1; # remove Adobe printer Driver console Output [Page: ...]
+$ignoreEOFDSC= 0; # ignore %%EOF DSC hint
+$removePreview= 0; # remove preview
+$quiet= 0; # write progress to stdout
+$resolution= 144; # resolution for bounding box calculation is 2x72 dpi
+$trytofixps= 1; # try to fix postscript code
+$forcefixps= 0; # fix postscript code unconditionally if eq 1
+$filterorientation= 1;# filter Orientation line
+$looseBB=''; # default: tight bounding box
+$clip=0; # do not clip
+$warnings=0; # do not print warnings concerning postscript sanity
+$debuggs=0; # no debugging of ghostscript call, turn this on if you want to see the gs call
+$inch=2.54; # one inch is 2.54cm
+$fullcolors= 1; # use ppm format (24-bit full color)
+$trailerseen= 0; # Trailer comment seen?
+$PSversion="2.0"; # default Postscript Version
+$PSDSCversion="2.0"; # default Postscript DSC Version
+$translate_x= 0; # translate by x postscript points
+$translate_y= 0; # translate by y postscript points
+
+$defaultext = '(ps|prn)'; # default extension
+$defaultoutext = '.eps'; # default output extension
+$envname_size = 'PS2EPS_SIZE';
+$envname_gsbbox = 'PS2EPS_GSBBOX';
+
+$gpar="";
+$known_papersizes="11x17|ledger|legal|letter(small)?|arch[A-E]|a([0-9]|10)|isob[0-6]|b[0-5]|c[0-6]|jisb[0-6]|fls(a|e)|halfletter";
+$papersize_help="11x17,ledger,legal,letter,lettersmall,archA,archB,archC,archD,archE\
+a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,isob0,isob1,isob2,isob3,isob4,isob5,isob6,\
+b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5,c6,\
+jisb0,jisb1,jisb2,jisb3,jisb4,jisb5,jisb6,flsa,flse,halfletter\n";
+$trigger= 0;
+$notsane= 0;
+$dummy="";
+
+@ver= split(/ /,$version);
+
+# filename for temporary files
+if ($^O =~ /MSWin32/i or $^O =~ /cygwin/i)
+{
+ # it is less trouble to use the current directory if working on
+ # cygwin and nevertheless using gswin32c.
+ $tmpfname= "$prgname.$$";
+ $win=1;
+}
+elsif (defined($ENV{'TMP'}))
+{
+ $tmpdir= $ENV{'TMP'};
+ $filesep= ($tmpdir =~ /^?\:\\/) ? '\\' : '/';
+ if ($tmpdir =~ /$filesep$/)
+ { $tmpfname= $tmpdir . "$prgname.$$"; }
+ else
+ { $tmpfname= $tmpdir . "$filesep$prgname.$$"; }
+ $win=1;
+}
+else #assume we're on a UNIXBOX
+{
+ $tmpfname= "/tmp/" . "$prgname.$$";
+ $win=0;
+}
+
+
+$licensetxt= "\
+ This program is free software; you can redistribute it and/or modify\
+ it under the terms of the GNU General Public License as published by\
+ the Free Software Foundation; either version 2 of the License, or\
+ (at your option) any later version.\
+\
+ This program is distributed in the hope that it will be useful,\
+ but WITHOUT ANY WARRANTY; without even the implied warranty of\
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\
+ GNU General Public License for more details.\
+\
+ You should have received a copy of the GNU General Public License\
+ along with this program; if not, write to the Free Software\
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA\n";
+
+@prgidtxt= ( "$prgname - convert PostScript to EPS (Encapsulated PostScript) files\n",
+ "(C)opyright 1998-2004 Roland Bless\n\n" );
+
+@helptxt= ("Version: $ver[2]\n",
+ "Operation:\n",
+ " Without any argument, $prgname reads from standard input\n",
+ " and writes to standard output.\n",
+ " If filenames are given as arguments they are processed\n",
+ " one by one and output files are written to filenames\n",
+ " with extension '$defaultoutext'. If input filenames have the extension\n",
+ " '.ps' or '.prn', this extension is replaced with '$defaultoutext'.\n",
+ " In all other cases '$defaultoutext' is appended to the input filename.\n",
+ " Please note that PostScript files for input should contain\n",
+ " only one single page.\n\n",
+ " If BoundingBox in output seems to be wrong, please try options --size or --ignoreBB.\n\n" );
+
+@usagetxt= ("Syntax:\n",
+ " $prgname [-f] [-q] [-N] [-O] [-n] [-P] [-c] [-C] [-m] [-B] [-E] [-s <pagedim>] [-R +|-|^] [-t <x,y>] [-l] [-g] [-d] [-H] [-h|--help] [-g] [-W] [-L] [-V|--version] [--] [psfile1] [psfile2] [...]\n",
+ "Options:\n",
+ " -f, --force force overwriting existing files\n",
+ " -q, --quiet quiet operation (no output while processing files)\n",
+ " -N, --noinsert do not insert any postscript code\n",
+ " -O, --preserveorientation do not filter Orientation: header comment\n",
+ " -n, --nofix do not try to fix postscript code\n",
+ " -P, --removepreview remove preview image (smaller file, but no preview)\n",
+ " -F, --fixps fix postscript code unconditionally\n",
+ " -c, --comments preserve document structure comments\n",
+ " -C, --clip insert postscript code for clipping\n",
+ " -m, --mono use black/white bitmap as base for calculation\n",
+ " -s, --size=<pagedim> page size (a0-a10,letter,...) or in format XxY[cm|in] (default:cm), where X and Y are numbers\n",
+ " use --size=list to list pre-defined page sizes\n",
+ " -R, --rotate=<direction> rotate resulting EPS. <direction>: +=+90 (clockw.),-=-90 (counter-clockw.) ^=180 degrees\n",
+ " -t, --translate specify x,y offset (may be negative) in postscript points (1/72 dpi)\n",
+ " -l, --loose expand the original bounding box by one point in each direction\n",
+ " -B, --ignoreBB do not use existing bounding box as page size for rendering\n",
+ " -E, --ignoreEOF do not use %%EOF as hint for end of file\n",
+ " -g, --gsbbox use internal bbox device of ghostscript\n",
+ " -H, --no-hires do not use a HiResBoundingBox\n",
+ " -h, --help help information\n",
+ " -L, --license show licensing information\n",
+ " -V, --version show version information\n",
+ " -d, --debuggs show ghostscript call\n",
+ " -W, --warnings show warnings about sanity of generated eps file\n",
+ " -- all following arguments are treated as files\n",
+ " (allows filenames starting with -)\n",
+ "\n",
+ "Arguments:\n",
+ " One or more names of PostScript files for input\n");
+
+## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+## -- argument checking --
+## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#environment variable for papersize
+if (defined($ENV{"$envname_size"}))
+{
+ $opt_s= $ENV{"$envname_size"};
+}
+else
+{
+ $opt_s = ''; # for s-option
+}
+
+if (defined($ENV{"$envname_gsbbox"}))
+{
+ $bboxname="";
+}
+
+$opt_t = ''; # for t-option
+$opt_R = ''; # for R-option
+$stopnow = 0;
+die "Wrong option(s), please check usage with $prgname --help\n" unless
+GetOptions('f|force' => \$forceoverwrite,
+ 'q|quiet' => \$quiet,
+ 'm|mono' => sub { $fullcolors = 0 },
+ 'n|nofix' => sub { $trytofixps = 0 },
+ 'F|fixps' => \$forcefixps,
+ 'N|noinsert' => sub { $insertPScode = 0 },
+ 'O|preserveorientation' => sub { $filterorientation= 0 },
+ 'P|removepreview' => \$removePreview,
+ 'c|comments' => sub { $removeDSC = 0 },
+ 'C|clip' => \$clip,
+ 'l|loose' => sub { $looseBB = '-l' },
+ 'B|ignoreBB' => \$ignoreBB,
+ 'E|ignoreEOF'=> \$ignoreEOFDSC,
+ 's|size=s' => \$opt_s,
+ 't|translate=s' => \$opt_t,
+ 'R|rotate=s' => \$opt_R,
+ 'g|gsbbox' => sub { $bboxname=""; },
+ 'H|nohires' => \$nohires,
+ 'h|help' => sub { $stopnow = 1; print @prgidtxt,@helptxt,@usagetxt,"\nAuthor: Roland Bless (roland\@bless.de)\n\n"; },
+ 'L|license' => sub { $stopnow = 1; print @prgidtxt,$licensetxt,"\nAuthor: Roland Bless (roland\@bless.de)\n\n"; },
+ 'd|debuggs' => \$debuggs,
+ 'W|warnings' => \$warnings,
+ 'V|version' => sub { $stopnow = 1; print @prgidtxt,"Version: $ver[2]\n"; });exit if ($stopnow);
+
+## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+## -- wildcard processing --
+## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+## internal wildcard processing for current directory,
+## only used for non UNIX-based OSs (which may lack shell wildcard expansion)
+@filenames = ();
+foreach $object (@ARGV) {
+ if ($win && $object =~ m/\*/o) # asterisk is present in filename
+ {
+ $wildcard = $object;
+ $wildcard =~ s/\./\\\./g; # replace . in pattern with \.
+ $wildcard =~ s/\*/\(\.\*\)/g; # replace * in pattern with (.*)
+ opendir(DIR,'.') || die 'Unable to open current directory, stopped'; # open current directory
+ print STDERR $wildcard;
+ @fid = grep { /$wildcard(\.$defaultext)?/i } readdir(DIR);
+ foreach (@fid) { push @filenames, $_; }
+ closedir DIR;
+ }
+ else { push @filenames, $object; }
+} # end foreach
+$filenames[0]= '-' if (scalar(@filenames) == 0); # no file arguments, use STDIN as input
+
+print STDERR "Input files: @filenames\n" if (!$quiet);
+
+# papersize stuff
+if ($opt_s ne '')
+{
+ # if explicit size is given, ignore existing BoundingBox always
+ $ignoreBB = 1;
+ $pagedimension = $opt_s;
+ if ($opt_s eq "list")
+ {
+ print STDERR "Available paper sizes: $papersize_help";
+ exit 0;
+ }
+
+ #explicit format XxY[cm|in]
+ if ($pagedimension =~ /(\d*\.?\d+)x(\d*\.?\d+)/)
+ {
+ ($x_dim, $dummy, $y_dim, $unit)= split(/(x|cm|in)/,$pagedimension);
+ if ( $x_dim !~ /^\d*\.?\d+$/ )
+ { die "$x_dim in $arg is not a valid number, stopped"; }
+ if ( $y_dim !~ /^\d*\.?\d+$/ )
+ { die "$y_dim in $arg is not a valid number, stopped"; }
+
+ #print STDERR "xdim: $x_dim ydim: $y_dim unit:$unit\n" ;
+ if (!defined($unit) )
+ {
+ $unit='cm';
+ $opt_s=$opt_s . $unit;
+ }
+ if ( $unit ne 'in' ) # assume centimeters
+ { # calculate dimension in pixels (remember: resolution is in dpi)
+ $xpixels= int(($x_dim * $resolution) / $inch)+1;
+ $ypixels= int(($y_dim * $resolution) / $inch)+1;
+ $gpar= "-g${xpixels}x${ypixels}";
+ }
+ else
+ {
+ $xpixels= int($x_dim * $resolution)+1;
+ $ypixels= int($y_dim * $resolution)+1;
+ $gpar= "-g${xpixels}x${ypixels}";
+ }
+ } #endif XxY in opt_s
+ else
+ {
+ if ($opt_s =~ /$known_papersizes/)
+ {
+ $gpar="-sPAPERSIZE=$opt_s";
+ }
+ else
+ {
+ print STDERR "Error: Unknown paper size: $opt_s\n Acceptable papersizes are:$papersize_help\n";
+ exit 1;
+ }
+ }
+}
+
+#translate option
+if ($opt_t ne '')
+{
+ ($translate_x,$translate_y)= split(/\,/,$opt_t);
+}
+
+#rotate
+$rotright='-90 rotate';
+$rotleft='90 rotate';
+$rotupsidedown='180 rotate';
+$rotate='';
+if ($opt_R ne '')
+{
+ if ($opt_R eq '+') { $rotate=$rotright; }
+ elsif ($opt_R eq '-') { $rotate=$rotleft; }
+ elsif ($opt_R eq '^') { $rotate=$rotupsidedown; }
+ else { die "Wrong parameter for option -R: Valid are only +,-,^\n"; };
+}
+
+$device= $fullcolors ? "ppmraw" : "pbmraw";
+
+## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+## -- iterate over different input files --
+## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+PROCESSFILE:
+while ($infname= (shift @filenames))
+{
+ # reset filter definitions for each file
+ undef $linefilter;
+ undef $rangefilter_begin;
+ undef $rangefilter_end;
+ $fixthisps= $trytofixps;
+ $fixmsgprinted= 0;
+
+ if (!$quiet) { print STDERR "Processing: $infname\n"; }
+ unless (open($infhandle,"<$infname"))
+ { # skip over this file
+ print STDERR "$prgname: Can't open $infname: $!\n";
+ next PROCESSFILE;
+ }
+
+ # buffer input from stdin into temporary file, because it has to be read twice
+ # one time for ghostscript processing, the second time for generating output
+ if ($infname eq '-') # input is stdin
+ {
+ $tmpfhandle='';
+ open($tmpfhandle,">$tmpfname") or
+ die "Cannot open temporary file $tmpfname for writing: $!\n";
+ }
+ else # input is not stdin
+ {
+ undef $tmpfhandle;
+ #if filename ends with $defaultext usually .ps or .prn, replace the extension with $defaultoutext
+ if ($infname =~ /\.$defaultext$/i)
+ {
+ $outfname= $infname; $outfname =~ s/\.$defaultext$/$defaultoutext/i;
+ }
+ else # otherwise simply append the extension $defaultoutext
+ {
+ $outfname= $infname . "$defaultoutext";
+ }
+ if (!$forceoverwrite and -s "$outfname")
+ {
+ die "$prgname: Sorry, file named $outfname already exists,",
+ " will not overwrite it.\n",
+ " You will have to use the -f option, delete it or rename it",
+ " before running $prgname again.\n";
+ }
+ else
+ {
+ open($outfhandle,">$outfname") or die "Can't open file $outfname for writing: $!\n";
+ }
+ } #end else input is not stdin
+
+ ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ## -- process input file --
+ ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ $linefilter= '^$'; #'# filter empty lines by default
+ while (<$infhandle>)
+ {
+ # get postscript and DSC version
+ if (/%!PS-Adobe-(\S+).*EPSF-(\S+)/)
+ {
+ $PSversion=$1;
+ $PSDSCversion=$2;
+ if (! ($PSversion =~ /\d+\.\d+/))
+ {
+ $PSDSCversion="2.0";
+ }
+ if (! ($PSDSCversion =~ /\d+\.\d+/))
+ {
+ $PSDSCversion="2.0";
+ }
+ }
+
+ # check for existing BoundingBox parameters
+ if ( /^%%\s*BoundingBox:\s*(.*)/ && !defined($eBBllx) )
+ {
+ $BBarg= $1;
+ # accept even negative and fractional BBs
+ if ( $BBarg =~ /(\-?\d+\.?\d*\s+){3,}\d+/ ) # ignore %% BoundingBox: (atend) comments
+ {
+ ($eBBllx,$eBBlly,$eBBurx,$eBBury,$dummy)= split /\s/,$BBarg;
+ #print STDERR "Existing BB: $eBBllx,$eBBlly,$eBBurx,$eBBury\n";
+ if (int($eBBllx) < 0) { $translate_x= - int($eBBllx-0.5); }
+ if (int($eBBlly) < 0) { $translate_y= - int($eBBlly-0.5); }
+
+ $xpixels= int((($eBBurx-$eBBllx) * $resolution)/72)+1;
+ $ypixels= int((($eBBury-$eBBlly) * $resolution)/72)+1;
+ if (!$ignoreBB)
+ {
+ $gpar= "-g${xpixels}x${ypixels}";
+ # check for meaningful values
+ if (($xpixels <= 1) || ($ypixels <= 1))
+ {
+ $gpar=""; undef $eBBllx; undef $eBBlly;
+ }
+ else
+ {
+ if (!$quiet)
+ {
+ print STDERR "Rendering with existing $_";
+ if (int($eBBllx) < 0 || int($eBBlly) < 0)
+ {
+ print STDERR "WARNING: existing Bounding Box shows negative values - shifting\n";
+ }
+ }
+ }
+ } #endif !$ignoreBB
+ } #endif $BBarg =~
+ }
+
+
+ if ($fixthisps) # try to fix bad postscript code
+ {
+ # check for Windows 3.x output
+ if ( /^Win.*Dict/ )
+ {
+ if (!$quiet && !$fixmsgprinted)
+ { print STDERR "Windows 3.5 generated Postscript file detected, fixing\n"; }
+ $linefilter= '^(EJ|RS)';
+ $rangefilter_begin= '^statusdict';
+ $rangefilter_end= 'cvx\ settransfer$'; #'
+ $fixmsgprinted= 1; # stop printing message
+ }
+ else
+ {
+ if ( /^%%Creator:\s*Wind.U\s*Xprinter/ )
+ {
+ if (!$quiet && !$fixmsgprinted)
+ { print STDERR "Star/OpenOffice generated Postscript file detected, fixing\n"; }
+ $linefilter= '^rs';
+ $fixmsgprinted= 1; # stop printing message
+ }
+ else
+ {
+ if ( $forcefixps ||
+ /^\/NTPS/ ||
+ /Creator:\s*(AdobePS|Pscript|.*Windows)/i ) #check for NT generated output
+ {
+ if (!$quiet && !$fixmsgprinted)
+ {
+ if ($forcefixps)
+ {
+ print STDERR "Postscript filtering requested, fixing\n";
+ }
+ else
+ {
+ print STDERR "Windows generated Postscript file detected, fixing\n";
+ }
+ }
+ $rangefilter_begin= '^((\[\{)|(featurebegin\{))$'; #'
+ $rangefilter_end= '^(\} stopped cleartomark|\}featurecleanup)';
+ $exclude_rangefilter_begin= '^(?i)%%BeginNonPPDFeature'; #'
+ $exclude_rangefilter_end= '^(?i)%%EndNonPPDFeature';
+ #$triggered_rangefilter_begin= ''; #'
+ #$triggered_rangefilter_end= ''; #'
+ $fixsearchpat='(^|\s)(initmatrix|initclip|initgraphics)(\s|$)';
+ $fixreplacepat=' ';
+ $fixmsgprinted= 1; # stop printing message
+ } # end if NTPS
+ } #end else
+ }
+ } #end if trytofixps
+
+ if (defined($tmpfhandle))
+ {
+ print $tmpfhandle $_ or die "$prgname: Failure during writing to temporary file $tmpfname";
+ }
+
+ if (/^%%EOF\s*$/)
+ {
+ $totalEOFDSC++
+ }
+ } #end while <$infhandle>
+
+ if (defined($tmpfhandle))
+ {
+ close($tmpfhandle);
+ }
+ else
+ {
+ $tmpfhandle= $infhandle;
+ $tmpfname= $infname;
+ }
+
+ ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ## -- calculate the bounding box --
+ ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ if ($translate_x>0 || $translate_y>0)
+ {
+ $translation="$translate_x $translate_y translate";
+ $translatecmd="-c \'$translation\'";
+ }
+ else
+ {
+ $translation="";
+ $translatecmd="";
+ }
+
+ if (!$quiet)
+ {
+ print STDERR "Calculating Bounding Box...";
+ if ($opt_s)
+ {
+ print STDERR "using page size $opt_s...";
+ }
+ }
+
+ $rotatecmd='';
+ if ($rotate ne '')
+ {
+ $rotatecmd="-c \"$rotate\""
+ }
+ if ($bboxname ne '')
+ {
+ $cmdline="$ghostscriptname -dSAFER -dNOPAUSE -q $gpar -r$resolution -sDEVICE=$device -sOutputFile=- $translatecmd -f $tmpfname -c showpage -c quit | $bboxname -r $resolution";
+ }
+ else
+ {
+ print STDERR "...using bbox device of $ghostscriptname...";
+ $cmdline = "$ghostscriptname -dSAFER -dBATCH -dNOPAUSE -q $gpar -r$resolution -sDEVICE=bbox -sOutputFile=- -c \"/setpagedevice {pop} def\" $translatecmd -f $tmpfname -c quit 2>&1";
+ }
+
+ if ($debuggs) { print STDERR "\nCalling: $cmdline\n"; }
+
+ # actual ghostscript call
+ $boundingbox=`$cmdline`;
+ if ($debuggs) { print STDERR "Call result: $boundingbox"; }
+
+ # check result of gs call
+ if ($boundingbox !~ /^%%BoundingBox/)
+ {
+ print STDERR "Error: Could not determine bounding box!\n",
+ "I suppose $ghostscriptname had some trouble interpreting the postscript-file\n";
+ }
+
+ $boundingbox =~ /^%%HiResBoundingBox:\s*(.*)/m;
+ if (defined($1)) # HiResBoundingBox given
+ {
+ ($hcBBllx,$hcBBlly,$hcBBurx,$hcBBury,$dummy)= split(/\s/,$1);
+ $hiresboundingbox="%%HiResBoundingBox: $hcBBllx $hcBBlly $hcBBurx $hcBBury\n";
+ $cBBllx = floor($hcBBllx);
+ $cBBlly = floor($hcBBlly);
+ $cBBurx = ceil($hcBBurx);
+ $cBBury = ceil($hcBBury);
+ }
+ else
+ { #use normal BoundingBox
+ $boundingbox =~ /^%%.*BoundingBox:\s*(.*)/;
+ ($cBBllx,$cBBlly,$cBBurx,$cBBury,$dummy)= split(/\s/,$1);
+ }
+ # if loose BB should be performed by ps2eps
+ # apply changes to resulting bounding box if needed
+ if ($looseBB ne '')
+ {
+ if ($cBBllx > 0) { $cBBllx--; }
+ if ($cBBlly > 0) { $cBBlly--; }
+ $cBBurx++; $cBBury++;
+ }
+ # extend clipping box by 1 point
+ if ($clip)
+ {
+ if ($cBBllx > 0) { $cBBllx--; }
+ if ($cBBlly > 0) { $cBBlly--; }
+ $cBBurx++; $cBBury++;
+ }
+ if (!$quiet && ($cBBllx < 0 || $cBBlly < 0 ))
+ {
+ print STDERR "WARNING! Your drawing had a negative Bounding Box which is deprecated and may cause problems!. I'll shift it.\n";
+ $translate_x= -int($cBBllx);
+ $translate_y= -int($cBBlly);
+ $cBBllx=0;
+ $cBBurx= $cBBurx + $translate_x;
+ $cBBlly=0;
+ $cBBury= $cBBury + $translate_y;
+
+ $hcBBurx= $hcBBurx + $hcBBllx;
+ $hcBBury= $hcBBury + $hcBBlly;
+ $hcBBllx= 0;
+ $hcBBlly= 0;
+
+ $hiresboundingbox="%%HiResBoundingBox: $hcBBllx $hcBBlly $hcBBurx $hcBBury\n";
+
+ $translation="$translate_x $translate_y translate";
+ $translatecmd="-c \'$translation\'";
+ }
+ $boundingbox = "%%BoundingBox: $cBBllx $cBBlly $cBBurx $cBBury\n";
+
+ if (!$quiet) { print STDERR "ready. $boundingbox" };
+
+ $before_startps= 1;
+ $inserted_prolog= 0;
+ $prolog_passed= 0;
+
+ ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ## -- Create output file --
+ ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ if (!$quiet) { print STDERR "Creating output file $outfname..."; }
+
+ open($tmpfhandle,"<$tmpfname") or die "Cannot open file $tmpfname for reading";
+ CREATEOUTPUT:
+ while (<$tmpfhandle>)
+ {
+ # check whether we are in a binary section
+
+ $binarysection=(/^(%%BeginBinary)|(beginimage)\r?\n?$/ ... /^(%%EndBinary)|^(endimage)/) ||
+ (/^(doNimage)|(doclutimage)\r?\n?$/ ... /(^|~> )Z\r?\n?$/) || # Pscript_Win_Dib_L2 5.0 0
+ (/^beginjpeg / ... /~> endjpeg\r?\n?$/) || # Pscript_Win_Dib_L2 5.0 0
+ (/^pdfIm/ ... /^%-EOD-/);
+
+ if ( !$binarysection )
+ {
+ s/\r?\n?$//; # remove CR and/or LF at end of line if not in binary section
+ }
+
+ # check where magic Postscript header starts - skip leading binary stuff, e.g., HP PCL/PJL code
+ if ($before_startps)
+ {
+ if ( /%!/ ) # This is usually the smallest magic sequence
+ { # Note: Adobe Photoshop generated a binary heading, so ^ is not applicable
+ if (! /%!PS-Adobe.*/i) # some strange programs use other magics
+ {
+ print STDERR "** Warning **: Weird heading line -- ",$_," -- ";
+ }
+ $before_startps= 0;
+ }
+ next CREATEOUTPUT;
+ }
+ else # we are hopefully in regular postscript code now
+ {
+ # count %%EOFs as we want to know when we got the last EOF
+ if ( /^%%EOF\s*$/ )
+ {
+ $seenEOF++;
+ }
+
+ # We should insert our own prologue including the newly calculated BoundingBox
+ if (! $inserted_prolog)
+ {
+ print $outfhandle "%!PS-Adobe-$PSversion EPSF-$PSDSCversion\n";
+ # check if we need to rotate
+ $transrotcmd='';
+ if ($rotatecmd)
+ {
+ if ($rotate eq $rotright)
+ {
+ $transrotcmd="-$cBBlly $cBBurx translate";
+ $boundingbox='%%BoundingBox: 0 0 ' . ($cBBury-$cBBlly) . ' ' . ($cBBurx-$cBBllx) . "\n";
+ if ($hiresboundingbox ne "")
+ {
+ $hiresboundingbox='%%HiResBoundingBox: 0 0 ' . ($hcBBury-$hcBBlly) . ' ' . ($hcBBurx-$hcBBllx) . "\n";
+ }
+
+ }
+ elsif ($rotate eq $rotleft)
+ {
+ $transrotcmd="$cBBury -$cBBllx translate";
+ $boundingbox='%%BoundingBox: 0 0 ' . ($cBBury-$cBBlly) . ' ' . ($cBBurx-$cBBllx) . "\n";
+ if ($hiresboundingbox ne "")
+ {
+ $hiresboundingbox= '%%HiResBoundingBox: 0 0 ' . ($hcBBury-$hcBBlly) . ' ' . ($hcBBurx-$hcBBllx) . "\n";
+ }
+ }
+ elsif ($rotate eq $rotupsidedown)
+ {
+ $transrotcmd="$cBBurx $cBBury translate";
+ $boundingbox='%%BoundingBox: 0 0 ' . ($cBBurx-$cBBllx) . ' ' . ($cBBury-$cBBlly) . "\n";
+ if ($hiresboundingbox ne "")
+ {
+ $hiresboundingbox='%%HiResBoundingBox: 0 0 ' . ($hcBBurx-$hcBBllx) . ' ' . ($hcBBury-$hcBBlly) . "\n";
+ }
+ }
+ }
+ print $outfhandle $boundingbox;
+ if (!defined($hiresboundingbox))
+ {
+ $nohires=1;
+ }
+ if (defined($hiresboundingbox) && !defined($nohires)) { print $outfhandle $hiresboundingbox; }
+ $inserted_prolog= 1;
+ redo CREATEOUTPUT;
+ }
+ else # already inserted_prolog
+ {
+ if (! $prolog_passed)
+ {
+ #ignore the following lines in the prologue
+ if ( /^%%(HiRes)?BoundingBox/ ||
+ /^%%Pages/ ||
+ /^%%BeginProlog/ ||
+ /^%%EndProlog/ ||
+ ($filterorientation && /^%%Orientation/) ||
+ ($removeDSC && /^%%.*: \(atend\)/) ||
+ ($removePreview && (/^%%BeginPreview/ ... /^%%EndPreview/)) )
+ {
+ next CREATEOUTPUT;
+ }
+ else
+ {
+ if ( /^[^%].*/ ||
+ /^%%EndComments/ ) # line is not a comment
+ {
+ #output postscript code for proper EPS file
+ if ($insertPScode)
+ {
+ print $outfhandle "%%EndComments\n",
+ "% EPSF created by ps2eps $ver[2]\n",
+ "%%BeginProlog\n";
+ }
+ # Insert own postscript code for clipping
+ if ($clip)
+ {
+ if (!defined($nohires))
+ {
+ printf $outfhandle "newpath %f %f moveto %f %f lineto %f %f lineto %f %f lineto closepath clip\n",$hcBBllx-0.1,$hcBBlly-0.1,$hcBBurx+0.1,$hcBBlly-0.1,$hcBBurx+0.1,$hcBBury+0.1,$hcBBllx-0.1,$hcBBury+0.1;
+ }
+ else
+ {
+ printf $outfhandle "newpath %d %d moveto %d %d lineto %d %d lineto %d %d lineto closepath clip\n",$cBBllx,$cBBlly,$cBBurx,$cBBlly,$cBBurx,$cBBury,$cBBllx,$cBBury;
+ }
+ } #endif clip
+
+ if ($rotate ne '')
+ {
+ print $outfhandle "$transrotcmd\n";
+ print $outfhandle "$rotate\n";
+ }
+ if ($translation ne '')
+ {
+ print $outfhandle "$translation\n";
+ }
+
+ #insert surrounding postscript code
+ if ($insertPScode)
+ {
+ print $outfhandle "save\n",
+ "countdictstack\n",
+ "mark\n",
+ "newpath\n",
+ "/showpage {} def\n",
+ "/setpagedevice {pop} def\n",
+ "%%EndProlog\n",
+ "%%Page 1 1\n";
+ }
+ $prolog_passed= 1;
+ if (/^%%EndComments/) { next CREATEOUTPUT; }
+ } #endif line is not a comment
+ } #end else
+ } #endif (we are in the prologue section)
+ else #we are in the main part of postscript file
+ {
+ #end of postscript file reached?
+ #Usually the DSC %%EOF signifies the end
+ if ( eof($tmpfhandle) ||
+ ($ignoreEOFDSC == 0 && /^%%EOF\s*$/ && $seenEOF == $totalEOFDSC)
+ || ( $trailerseen && /^II\*\000.*/ )
+ )
+ {
+ #do not forget to print last line if not terminated by LF
+ if ( eof($tmpfhandle) && !/^$/ && !/^%%EOF\s*$/ ) # do not insert %%EOF twice
+ {
+ print $outfhandle $_,"\n";
+ }
+ #add appropriate trailer
+ if ($insertPScode)
+ {
+ print $outfhandle "%%Trailer\n",
+ "cleartomark\n",
+ "countdictstack\n",
+ "exch sub { end } repeat\n",
+ "restore\n",
+ "%%EOF\n";
+ }
+ last CREATEOUTPUT;
+ } # stop output
+
+ # Trailer comment seen?
+ if ( /^%%Trailer\s*$/ )
+ {
+ $trailerseen=1;
+ }
+ else
+ {
+ if (!/^\s*$/) #non empty lines follow
+ {
+ $trailerseen=0;
+ }
+ }
+
+ # check for trigger
+ if (defined($triggerstring) && /^$triggerstring$/)
+ {
+ $trigger= 1;
+ };
+
+ # remove complete lines if one of the expression matches
+ if ( !$binarysection # only when not in binary section
+ &&
+ (
+ ($removePreview && (/^%%BeginPreview/ ... /^%%EndPreview/))
+ || # no preview
+ (defined($rangefilter_begin) &&
+ (/$rangefilter_begin/ ... /$rangefilter_end/) &&
+ (!(/$exclude_rangefilter_begin/ ... /$exclude_rangefilter_end/))
+ )
+ ||
+ (defined($triggered_rangefilter_begin) && defined($triggered_rangefilter_end) &&
+ $trigger &&
+ (/$triggered_rangefilter_begin/ ... /$triggered_rangefilter_end/)
+ )
+ ||
+ /$linefilter/ # lines by linefilter
+ ||
+ ($removeDSC && (/^%( |!)(\w )+/ || /^%%/)) # any type of structured comment
+ ||
+ ($removeADO &&
+ (/^statusdict begin.*ProductName.*print product print.*flush end\r?\n?$/ ||
+ /^\(%%\[\s*(Page:.*|LastPage)\s*\]%%\)\s*=\s*\w*\s*\r?\n?/ ))
+ ||
+ /^$/ # empty lines
+ )
+ )
+ {
+ next CREATEOUTPUT;
+ }
+
+ # replacement
+ if ( defined($fixsearchpat) )
+ {
+ #if (/$fixsearchpat/) { print STDERR "**filter** before:",$_,"\n"; }
+ #if (s/$fixsearchpat/$fixreplacepat/) { print STDERR "**filter** after:",$_,"\n";}
+ s/$fixsearchpat/$fixreplacepat/;
+ }
+
+ # sanity check for potential dangerous commands
+ if ( /(^|\s)(clear|erasepage|initmatrix|initclip|initgraphics|startjob|cleardictstack|setmatrix|setpagedevice|copypage|grestoreall|exitserver|quit)(\s|$)/ )
+ {
+ $notsane= 1;
+ #print STDERR "Warning: dangerous command in line: ",$_,"\n";
+ }
+ } # end else (this is main part)
+
+ # Output the postscript line to result file
+ print $outfhandle $_;
+
+ if (!$binarysection)
+ {
+ print $outfhandle "\n"; # terminate line with LF
+ }
+ } # end else prolog_passed
+ } # end else inserted_prolog
+ } # end while CREATEOUTPUT
+
+ close($tmpfhandle);
+
+ if ($tmpfname ne $infname) { unlink "$tmpfname"; } #remove temporary file
+
+ close ($outfhandle);
+
+ # print warning if magic sequence not found
+ if ( $before_startps )
+ {
+ print STDERR "\n ** Error!! **: could not identify begin of postscript code in file $infname, please check header line!\n First line should start with %!. No output generated.\n";
+ }
+
+ if (!$quiet) { print STDERR "ready.\n"; }
+ if ($warnings and $notsane and !$quiet)
+ {
+ print STDERR "** Warning **: EPS-output for $infname is not sane, at least one\n",
+ "of the following commands was still present:\n",
+ "clear erasepage initmatrix initclip initgraphics startjob\n",
+ "cleardictstack setmatrix setpagedevice copypage grestoreall\n",
+ "exitserver quit\n";
+ }
+} #end while PROCESSFILE
+
+# ---- end of perl-script -------
diff --git a/Master/texmf/scripts/tetex/e2pall.pl b/Master/texmf/scripts/tetex/e2pall.pl
new file mode 100644
index 00000000000..160f37c1853
--- /dev/null
+++ b/Master/texmf/scripts/tetex/e2pall.pl
@@ -0,0 +1,87 @@
+# Author: Jody Klymak <jklymak@apl.washington.edu>, publisted by a posting
+# to the pdftex mailinglist.
+
+# recursively finds all your eps files. Looks down \input{fname}.
+# CAVEATS:
+# 1) cannot handle \input{fname} split over more than one line.
+# 1.5) cannot handle multiple \input{} or \includegraphics{} on one line.
+# 2) Must be run from same directory as the Latex file.
+# 3) Does not look down $TEXINPUTS or anything fancy like that...
+# 4) Handling of \include is untested (though I guess its trivial)
+# 5) Assumes *all* your graphics inclusions are [e]ps. But don't
+# fret, because if they are not epstopdf dies anyhow....
+# 6) Does not distinguish between percent (\%) and comment (%).
+
+# Changelog:
+# 20030103 -- Lachlan Andrew <lha@users.sourceforge.net>
+# * Only append '.tex' if $fname doesn't exist.
+# * Correctly handle lines with '}' after the \includegraphics{}
+# * Allow multiple extensions for graphics files. .eps -> .ps -> none
+# (Should try them in the same order as \includegraphics does
+# -- given by \DeclareGraphicsExtensions{}?)
+# * Allow \include the same way as \input
+# * Allow \includegraphics{} to be split over multiple lines
+# * Check that commands begin with '\', and allow spaces before arguments
+
+# EDIT these two lines for your system....
+
+$Eps2PdfCom = "epstopdf";
+$ThisFunCom = "e2pall";
+
+$fname=$ARGV[0];
+
+# check for a *.tex at the end...
+if ((-f "$fname")=="" && $fname !~ /.tex$/){
+ $fname = "$fname.tex";
+}
+
+open(TEXFILE,$fname) or die "Cannot open file $fname";
+# print "Finding *.eps files in $fname\n";
+
+$seekingArg = 0;
+while($line=<TEXFILE>){
+ # truncate $line after % sign....
+ $line=~s/%.*//;
+ # check for /input....
+ if ($line=~/\\input *{([^}]*)}/){
+ print `$ThisFunCom $1`;
+ }
+ # check for /include....
+ if ($line=~/\\include *{([^}]*)}/){
+ print `$ThisFunCom $1`;
+ }
+
+ $base = "";
+ if ($line=~/\\includegraphics.*{([^}]*)}/){
+ $base = $1;
+ }
+ elsif ($seekingArg==1 && ($line=~/{([^}]*)}/)){
+ $base = $1;
+ }
+ elsif ($line=~/\\includegraphics/){
+ $seekingArg = 1;
+ }
+
+ if ($base ne "") {
+ $seekingArg = 0;
+ if ((-f "$base.eps")!="") {
+ $srcfile = "$base.eps";
+ }
+ elsif ((-f "$base.ps")!=""){
+ $srcfile = "$base.ps";
+ }
+ else {
+ $srcfile = $base;
+ }
+ # check that the [e]ps version is newer than the pdf version....
+ if ((-M "$base.pdf")=="" || (-M "$base.pdf") >= (-M "$srcfile")){
+ print "Constructing \t $base.pdf from $srcfile\n";
+ print `$Eps2PdfCom $srcfile`;
+ }
+ else{
+ print "$base.pdf \t is up to date with $srcfile\n";
+ }
+
+ };
+}
+close(TEXFILE);
diff --git a/Master/texmf/scripts/tetex/epstopdf.pl b/Master/texmf/scripts/tetex/epstopdf.pl
new file mode 100644
index 00000000000..879c483b093
--- /dev/null
+++ b/Master/texmf/scripts/tetex/epstopdf.pl
@@ -0,0 +1,309 @@
+# Copyright 1998-2001 by Sebastian Rahtz et al.
+# epstopdf is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# epstopdf is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with epstopdf; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+use Strict;
+
+# A script to transform an EPS file so that:
+# a) it is guarenteed to start at the 0,0 coordinate
+# b) it sets a page size exactly corresponding to the BoundingBox
+# This means that when Ghostscript renders it, the result needs no
+# cropping, and the PDF MediaBox is correct.
+# c) the result is piped to Ghostscript and a PDF version written
+#
+# It needs a Level 2 PS interpreter.
+# If the bounding box is not right, of course, you have problems...
+#
+# The only thing I have not allowed for is the case of
+# "%%BoundingBox: (atend)", which is more complicated.
+#
+# Sebastian Rahtz, for Elsevier Science
+#
+# now with extra tricks from Hans Hagen's texutil.
+#
+# History
+# 1999/05/06 v2.5 (Heiko Oberdiek)
+# * New options: --hires, --exact, --filter, --help.
+# * Many cosmetics: title, usage, ...
+# * New code for debug, warning, error
+# * Detecting of cygwin perl
+# * Scanning for %%{Hires,Exact,}BoundingBox.
+# * Scanning only the header in order not to get a wrong
+# BoundingBox of an included file.
+# * (atend) supported.
+# * uses strict; (earlier error detecting).
+# * changed first comment from '%!PS' to '%!';
+# * corrected (atend) pattern: '\s*\(atend\)'
+# * using of $bbxpat in all BoundingBox cases,
+# correct the first white space to '...Box:\s*$bb...'
+# * corrected first line (one line instead of two before 'if 0;';
+# 2000/11/05 v2.6 (Heiko Oberdiek)
+# * %%HiresBoundingBox corrected to %%HiResBoundingBox
+# 2001/03/05 v2.7 (Heiko Oberdiek)
+# * Newline before grestore for the case that there is no
+# whitespace at the end of the eps file.
+#
+
+my $IsWin32 = ($^O =~ /MSWin32/i);
+
+### program identification
+my $program = "epstopdf";
+my $filedate="2001/03/05";
+my $fileversion="2.7";
+my $copyright = "Copyright 1998-2001 by Sebastian Rahtz et al.";
+my $title = "\U$program\E $fileversion, $filedate - $copyright\n";
+
+### ghostscript command name
+my $GS = "gs";
+$GS = "gswin32c" if $^O eq 'MSWin32';
+$GS = "gswin32c" if $^O =~ /cygwin/;
+
+if ($IsWin32) {
+ $GS = `kpsecheck --ghostscript`;
+ $GS =~ m/^dll\s*:\s*(.+)/mio;
+ $GS = $1;
+ $GS =~ s/gsdll32.dll/gswin32c.exe/io;
+ if ($GS eq "") {
+ $GS = "gswin32c.exe";
+ }
+ $GS = "\"$GS\"" if ($GS =~ m/\s/);
+}
+
+### options
+$::opt_help=0;
+$::opt_debug=0;
+$::opt_compress=1;
+$::opt_gs=1;
+$::opt_hires=0;
+$::opt_exact=0;
+$::opt_filter=0;
+$::opt_outfile="";
+
+### usage
+my @bool = ("false", "true");
+my $usage = <<"END_OF_USAGE";
+${title}Syntax: $program [options] <eps file>
+Options:
+ --help: print usage
+ --outfile=<file>: write result to <file>
+ --(no)filter: read standard input (default: $bool[$::opt_filter])
+ --(no)gs: run ghostscript (default: $bool[$::opt_gs])
+ --(no)compress: use compression (default: $bool[$::opt_compress])
+ --(no)hires: scan HiResBoundingBox (default: $bool[$::opt_hires])
+ --(no)exact: scan ExactBoundingBox (default: $bool[$::opt_exact])
+ --(no)debug: debug informations (default: $bool[$::opt_debug])
+Examples for producing 'test.pdf':
+ * $program test.eps
+ * produce postscript | $program --filter >test.pdf
+ * produce postscript | $program -f -d -o=test.pdf
+Example: look for HiResBoundingBox and produce corrected PostScript:
+ * $program -d --nogs -hires test.ps>testcorr.ps
+END_OF_USAGE
+
+### process options
+use Getopt::Long;
+GetOptions (
+ "help!",
+ "debug!",
+ "filter!",
+ "compress!",
+ "gs!",
+ "hires!",
+ "exact!",
+ "outfile=s",
+) or die $usage;
+
+### help functions
+sub debug {
+ print STDERR "* @_\n" if $::opt_debug;
+}
+sub warning {
+ print STDERR "==> Warning: @_!\n";
+}
+sub error {
+ die "$title!!! Error: @_!\n";
+}
+sub errorUsage {
+ die "$usage\n!!! Error: @_!\n";
+}
+
+### option help
+die $usage if $::opt_help;
+
+### get input filename
+my $InputFilename = "";
+if ($::opt_filter) {
+ @ARGV == 0 or
+ die errorUsage "Input file cannot be used with filter option";
+ $InputFilename = "-";
+ debug "Input file: standard input";
+}
+else {
+ @ARGV > 0 or die errorUsage "Input filename missing";
+ @ARGV < 2 or die errorUsage "Unknown option or too many input files";
+ $InputFilename = $ARGV[0];
+ -f $InputFilename or error "'$InputFilename' does not exist";
+ debug "Input filename:", $InputFilename;
+}
+
+### option compress
+my $GSOPTS = "";
+$GSOPTS = "-dUseFlateCompression=false " unless $::opt_compress;
+
+### option BoundingBox types
+my $BBName = "%%BoundingBox:";
+!($::opt_hires and $::opt_exact) or
+ error "Options --hires and --exact cannot be used together";
+$BBName = "%%HiResBoundingBox:" if $::opt_hires;
+$BBName = "%%ExactBoundingBox:" if $::opt_exact;
+debug "BoundingBox comment:", $BBName;
+
+### option outfile
+my $OutputFilename = $::opt_outfile;
+if ($OutputFilename eq "") {
+ if ($::opt_gs) {
+ $OutputFilename = $InputFilename;
+ if (!$::opt_filter) {
+ $OutputFilename =~ s/\.[^\.]*$//;
+ $OutputFilename .= ".pdf";
+ }
+ }
+ else {
+ $OutputFilename = "-"; # standard output
+ }
+}
+if ($::opt_filter) {
+ debug "Output file: standard output";
+}
+else {
+ debug "Output filename:", $OutputFilename;
+}
+
+### option gs
+if ($::opt_gs) {
+ debug "Ghostscript command:", $GS;
+ debug "Compression:", ($::opt_compress) ? "on" : "off";
+}
+
+### open input file
+open(IN,"<$InputFilename") or error "Cannot open",
+ ($::opt_filter) ? "standard input" : "'$InputFilename'";
+binmode IN;
+
+### open output file
+if ($::opt_gs) {
+ my $pipe = "$GS -q -sDEVICE=pdfwrite $GSOPTS " .
+ "-sOutputFile=$OutputFilename - -c quit";
+ debug "Ghostscript pipe:", $pipe;
+ open(OUT,"|$pipe") or error "Cannot open Ghostscript for piped input";
+}
+else {
+ open(OUT,">$OutputFilename") or error "Cannot write '$OutputFilename";
+}
+
+### scan first line
+my $header = 0;
+$_ = <IN>;
+if (/%!/) {
+ # throw away binary junk before %!
+ s/(.*)%!/%!/o;
+}
+$header = 1 if /^%/;
+debug "Scanning header for BoundingBox";
+print OUT;
+
+### variables and pattern for BoundingBox search
+my $bbxpatt = '[0-9eE\.\-]';
+ # protect backslashes: "\\" gets '\'
+my $BBValues = "\\s*($bbxpatt+)\\s+($bbxpatt+)\\s+($bbxpatt+)\\s+($bbxpatt+)";
+my $BBCorrected = 0;
+
+sub CorrectBoundingBox {
+ my ($llx, $lly, $urx, $ury) = @_;
+ debug "Old BoundingBox:", $llx, $lly, $urx, $ury;
+ my ($width, $height) = ($urx - $llx, $ury - $lly);
+ my ($xoffset, $yoffset) = (-$llx, -$lly);
+ debug "New BoundingBox: 0 0", $width, $height;
+ debug "Offset:", $xoffset, $yoffset;
+
+ print OUT "%%BoundingBox: 0 0 $width $height\n";
+ print OUT "<< /PageSize [$width $height] >> setpagedevice\n";
+ print OUT "gsave $xoffset $yoffset translate\n";
+}
+
+### scan header
+if ($header) {
+ while (<IN>) {
+
+ ### end of header
+ if (!/^%/ or /^%%EndComments/) {
+ print OUT;
+ last;
+ }
+
+ ### BoundingBox with values
+ if (/^$BBName$BBValues/) {
+ CorrectBoundingBox $1, $2, $3, $4;
+ $BBCorrected = 1;
+ last;
+ }
+
+ ### BoundingBox with (atend)
+ if (/^$BBName\s*\(atend\)/) {
+ debug $BBName, "(atend)";
+ if ($::opt_filter) {
+ warning "Cannot look for BoundingBox in the trailer",
+ "with option --filter";
+ last;
+ }
+ my $pos = tell(IN);
+ debug "Current file position:", $pos;
+
+ # looking for %%BoundingBox
+ while (<IN>) {
+ # skip over included documents
+ if (/^%%BeginDocument/) {
+ while (<IN>) {
+ last if /^%%EndDocument/;
+ }
+ }
+ if (/^$BBName$BBValues/) {
+ CorrectBoundingBox $1, $2, $3, $4;
+ $BBCorrected = 1;
+ last;
+ }
+ }
+
+ # go back
+ seek(IN, $pos, 0) or error "Cannot go back to line '$BBName (atend)'";
+ last;
+ }
+
+ # print header line
+ print OUT;
+ }
+}
+
+### print rest of file
+while (<IN>) {
+ print OUT;
+}
+
+### close files
+close(IN);
+print OUT "\ngrestore\n" if $BBCorrected;
+close(OUT);
+warning "BoundingBox not found" unless $BBCorrected;
+debug "Ready.";
+;
diff --git a/Master/texmf/scripts/tetex/texdoctk.pl b/Master/texmf/scripts/tetex/texdoctk.pl
new file mode 100644
index 00000000000..a76ef70371e
--- /dev/null
+++ b/Master/texmf/scripts/tetex/texdoctk.pl
@@ -0,0 +1,1790 @@
+###############################################################################
+# texdoctk v.0.6.0 (Nov 5, 2004) - GUI for TeX documentation access
+# Copyright (C) 2000-2004 Thomas Ruedas
+# This program is provided under the GNU Public License; see the file
+# README.texdoctk for details about requirements, installation, configuration,
+# and the full disclaimer.
+###############################################################################
+use strict;
+use Tk;
+use Getopt::Long;
+Getopt::Long::config('bundling');
+use File::Basename;
+
+my $IsWin32 = ($^O =~ /MSWin32/i);
+
+if ($IsWin32) {
+# use Win32::Registry;
+ use Win32::API;
+}
+
+# initialization of some internal variables
+$|=1;
+my $quiet=1;
+my $autoview;
+my $xfmt_viewer=1,
+my @tdcolors;
+my %butcol;
+my $srchentry;
+my $srchflag=0;
+my $tmpfno;
+# system variables
+my ($texmfmain,$texmfdist,$texmfdoc,$texmflocal,$texmfhome,
+ $texdocpath,$distdocpath,$docdocpath,$localdocpath,$homedocpath,
+ $datadir,
+ $dvi_viewer,$dvips_conv,$ps_viewer,$pdf_viewer,
+ $pdfps_conv,$html_viewer,$htmlps_conv,$htmlps_redir,
+ $txt_viewer,$txtps_conv,$txtps_redir,$print_cmd);
+
+# defaults: unix values
+my $qq="'";
+my $HomeEnv=$ENV{HOME};
+my $TeXDocRcDefaults="texdocrc.defaults";
+my $TempDir; $TempDir=$ENV{TMPDIR} or $TempDir="/tmp";
+my $CmdConsole="xterm -e ";
+
+if ($IsWin32) {
+ $qq = "\"";
+ $HomeEnv = &GetHomeDir;
+ chomp $HomeEnv;
+ $TeXDocRcDefaults = "texdocrc-win32.defaults";
+ $TempDir = &GetTempPath;
+ $CmdConsole = "command /c ";
+}
+
+my $myrc="${HomeEnv}/.texdocrc"; # optional personal settings file
+
+my ($line,@dummy);
+my @tmpfiles;
+# read system-wide defaults from texdocrc.defaults
+my $sysrc=`kpsewhich --progname=texdoctk --format=${qq}other text files${qq} ${TeXDocRcDefaults}`;
+my $database=`kpsewhich --progname=texdoctk --format=${qq}other text files${qq} texdoctk.dat`;
+my $locdatabase=`kpsewhich --progname=texdoctk --format=${qq}other text files${qq} texdoctk-local.dat`;
+my $homedatabase=`kpsewhich --progname=texdoctk --format=${qq}other text files${qq} texdoctk-pers.dat`;
+chomp $locdatabase;
+chomp $homedatabase;
+chomp $sysrc;
+&readrc($sysrc,1);
+@dummy=split("/",$sysrc);
+pop @dummy;
+$datadir=join('/',@dummy);
+# possibly use personal settings instead of defaults
+if (-e $myrc) { &readrc($myrc,2); }
+# command line options
+GetOptions('v'=>\$quiet,'a'=>\$autoview);
+my $special=0;
+my @button;
+$button[17]="Miscellaneous";
+my (@packname,@topic,@doc,@keywords,@maxind,%stydoc);
+# read database file
+my $i=-1;
+my $j;
+open(DATABASE,"$database") || &fatalmsg("Couldn't open database $database.\n");
+while ($line = <DATABASE>) {
+ LINETYPE: {
+ ($line =~ /^\@/) && do { # category
+ ++$i;
+ if ($i == $#button) {
+ pop @button;
+ push @button,(substr($line,1,-1));
+ $special=1;
+ } else {
+ $button[$i]=substr($line,1,-1);
+ }
+ $j=0;
+ last LINETYPE;
+ };
+ ($line =~ /^(#|$)/) && do { # comment or empty line
+ last LINETYPE;
+ };
+# list item
+ @dummy=split(";",$line);
+ $packname[$i][$j]=$dummy[0];
+ $topic[$i][$j]=$dummy[1];
+ $doc[$i][$j]=$dummy[2];
+ $keywords[$i][$j]=$dummy[3];
+ if ($doc[$i][$j] =~ /sty$/ && $keywords[$i][$j]) {
+ $stydoc{"$doc[$i][$j]"}=substr($keywords[$i][$j],1,1);
+ unless ($stydoc{"$doc[$i][$j]"} =~ /^\d$/) {
+ $stydoc{"$doc[$i][$j]"}=0;
+ }
+ }
+ $maxind[$i]=$j;
+ ++$j;
+ };
+}
+close(DATABASE);
+# Read site-local and user's database(s) if it/they exist(s)
+foreach my $dbfile ($locdatabase,$homedatabase) {
+ if (-e "$dbfile") {
+ open(DATABASE,"$dbfile") ||
+ print "Couldn't open additional database $dbfile.\n";
+ $i=17; # local/user: if no category is specified in database, add to "Misc"
+ while ($line = <DATABASE>) {
+ LINETYPE: {
+ ($line =~ /^\@/) && do { # category
+ $i=&arrindex(@button,substr($line,1,-1));
+ if ($i >= $#button) {
+ $i=$#button;
+ pop @button;
+ push @button,(substr($line,1,-1));
+ $special=1;
+ }
+ last LINETYPE;
+ };
+ ($line =~ /^(#|$)/) && do { # comment or empty line
+ last LINETYPE;
+ };
+# list item
+ @dummy=split(";",$line);
+ $j=&arrindex(@{$packname[$i]},$dummy[0]);
+ if ($j > $#{$packname[$i]}) {
+ $packname[$i][$j]=$dummy[0];
+ $topic[$i][$j]=$dummy[1];
+ $doc[$i][$j]=$dummy[2];
+ $keywords[$i][$j]=$dummy[3];
+ if ($doc[$i][$j] =~ /sty$/ && $keywords[$i][$j]) {
+ $stydoc{"$doc[$i][$j]"}=substr($keywords[$i][$j],1,1);
+ unless ($stydoc{"$doc[$i][$j]"} =~ /^\d$/) {
+ $stydoc{"$doc[$i][$j]"}=0;
+ }
+ }
+ $maxind[$i]=$j;
+ ++$j;
+ }
+ };
+ }
+ close(DATABASE);
+ $special=1 if ($i == 17 && $j > 0);
+ }
+}
+
+# Tk
+# hash table for toplevel windows; used to avoid multiple calls of same window
+my %tlwins;
+my %buttonlist;
+# create frames for main window: commands on top, frame for buttons below
+my $main=new MainWindow;
+$tlwins{'mainwindow'}{'addr'}=$main;
+$main->resizable(0,0);
+$main->title("TeX Documentation Browser");
+$main->bind('all','<Control-q>'=>\&clean_exit);
+$main->bind('all','<Control-m>'=>sub { $main->raise(); });
+$main->bind('all','<Control-h>'=>\&helptext);
+$main->bind('all','<Control-s>'=>sub { $main->raise(); &mksrch; });
+$main->bind('all','<Control-t>'=>\&settings);
+my $cmdframe=$main->Frame(-background=>"#ffcc99");
+my $buttonframe=$main->Frame;
+$cmdframe->pack(-side=>'top',-fill=>'x');
+$buttonframe->pack(-side=>'bottom');
+# normal cursor
+my $defcursor=$main->cget(-cursor);
+# make buttons for command frame
+my $Qbut=$cmdframe->Button(-text=>'Quit',%butcol,
+ -command=>\&clean_exit)->pack(-side=>'left');
+$tlwins{'mainwindow'}{'buttons'}[0]=$Qbut;
+# define common default font for labels and text explicitly
+my $deffont=$Qbut->cget(-font);
+# ensure readability on high-res screens (suggested by R.Kotucha)
+$deffont='Helvetica -16 bold' if &x_resolution > 1200;
+$Qbut->configure(-font=>$deffont);
+$tlwins{'mainwindow'}{'buttons'}[1]=$cmdframe->Button(-text=>'Search',
+ -font=>$deffont,%butcol,
+ -command=>\&mksrch
+ )->pack(-side=>'left');
+$tlwins{'mainwindow'}{'buttons'}[2]=$cmdframe->Button(-text=>'Help/About',
+ -font=>$deffont,%butcol,
+ -command=>\&helptext
+ )->pack(-side=>'right');
+$tlwins{'mainwindow'}{'buttons'}[3]=$cmdframe->Button(-text=>'Settings',
+ -font=>$deffont,%butcol,
+ -command=>\&settings
+ )->pack(-side=>'right');
+# make buttons for category button frame
+my $lbut=0;
+my $l;
+foreach (@button) { $l=length $_; $lbut=$l if ( $l > $lbut) }
+my @catg;
+my ($i2,$i3);
+my $nbutt=scalar @button;
+my $ncols=$nbutt/3-1;
+foreach (0..$ncols) {
+ $i=$_;
+ $i2=$i+$nbutt/3;
+ $i3=$i+2*$nbutt/3;
+ $catg[$i]=$buttonframe->Button(-text=>$button[$i],
+ -font=>$deffont,%butcol,
+ -width=>$lbut,
+ -command=>[\&tpslct,$i,\@dummy])->grid
+ ($catg[$i2]=$buttonframe->Button(-text=>$button[$i2],
+ -font=>$deffont,%butcol,
+ -width=>$lbut,
+ -command=>[\&tpslct,$i2,\@dummy]),
+ $catg[$i3]=$buttonframe->Button(-text=>$button[$i3],
+ -font=>$deffont,%butcol,
+ -width=>$lbut,
+ -command=>[\&tpslct,$i3,\@dummy]));
+}
+# disable last button (lower right) if no local specials are found in list
+my $ncat;
+if ($special == 0) {
+ $catg[$#button]->configure(-state=>'disabled');
+ $ncat=$nbutt-1;
+} else {
+ $ncat=$nbutt;
+}
+for ($i=0,$j=4; $i<@catg; ++$i,++$j) {
+ $tlwins{'mainwindow'}{'buttons'}[$j]=$catg[$i];
+}
+MainLoop;
+
+########## SUBROUTINES ########################################################
+# toplevel for selecting a topic of a category for viewing or printing
+sub tpslct {
+ my($opt,@srchitems)=@_;
+ my (@lbitems,@lbdocs,$dspselect,$docselect,$wtitle);
+ if ($opt >= 0) {
+# main window buttons
+# see if toplevel window is already there
+ if (Exists($tlwins{$opt}{'addr'})) {
+ $tlwins{$opt}{'addr'}->deiconify();
+ $tlwins{$opt}{'addr'}->raise();
+ return;
+ }
+ for ($j=0; $j <= $maxind[$opt]; ++$j) {
+ push @lbitems,$topic[$opt][$j];
+ push @lbdocs,$doc[$opt][$j];
+ }
+ $wtitle=$button[$opt];
+ } else {
+# search results
+ my $spec_wtitle=shift @srchitems;
+ for ($j=0; $j < $#srchitems; $j+=2) {
+ my $k=$j+1;
+ push @lbitems,$topic[$srchitems[$j]][$srchitems[$k]];
+ push @lbdocs,$doc[$srchitems[$j]][$srchitems[$k]];
+ }
+ $wtitle="Search results for $spec_wtitle";
+ }
+# toplevel window of category $opt with two frames
+ my $tpwin=$main->Toplevel(-title=>$wtitle);
+ $tlwins{$opt}{'addr'}=$tpwin;
+ my $tpdsp=$tpwin->Frame(-relief=>'groove')->pack(-side=>'top');
+ my $tpslc=$tpwin->Frame()->pack(-side=>'top');
+# selection frame with listbox and buttons
+# label for listbox
+ my $tplabel=$tpslc->Label(-text=>'Topics',
+ -font=>$deffont)->pack(-anchor=>'w',
+ -side=>'top');
+# listbox with optional scrollbar
+ my $tplist=$tpslc->Scrolled("Listbox",
+ -font=>$deffont,
+ -scrollbars=>'osoe',
+# -height=>0,
+ -width=>0,
+ -selectmode=>'single',
+ -exportselection=>0,
+ -cursor=>'hand2')->pack(-side=>'left',
+ -fill=>'y',
+ -expand=>1);
+ $tplist->insert('end',@lbitems); # fill topics into listbox
+# buttons frame
+ my $tpbframe=$tpslc->Frame(-borderwidth=>8);
+ $tpbframe->pack(-side=>'right');
+# make buttons for command frame
+ my $n_buttons = 0;
+ $tlwins{$opt}{'buttons'}[$n_buttons++]=
+ $tpbframe->Button(-text=>'View',
+ -font=>$deffont,%butcol,
+ -command=>sub{ &viewslc($docselect,$tpbframe);},
+ -width=>6)->pack(-side=>'top');
+ if (! $IsWin32) {
+ $tlwins{$opt}{'buttons'}[$n_buttons++]=
+ $tpbframe->Button(-text=>'Print',
+ -font=>$deffont,%butcol,
+ -command=>sub{ &prtslc($docselect,$tpbframe);},
+ -width=>6)->pack(-side=>'top');
+ }
+ $tlwins{$opt}{'buttons'}[$n_buttons++]=
+ $tpbframe->Button(-text=>'Cancel',
+ -font=>$deffont,%butcol,
+ -command=>sub{ destroy $tpwin; undef $tlwins{$opt};},
+ -width=>6)->pack(-side=>'bottom');
+# if only 1 item is in the list (most likely in search results), select it
+ if (scalar @lbitems == 1) {
+ $tplist->selectionSet(0);
+ $dspselect=$lbitems[0];
+ $docselect=$lbdocs[0];
+ &viewslc($docselect,$tpbframe)
+ if ($autoview && $wtitle =~ /^Search results/);
+ }
+# display frame
+ my $dsplabel=$tpdsp->Label(-text=>'Selection:',
+ -font=>$deffont)->pack(-anchor=>'w',,
+ -fill=>'x',
+ -side=>'left');
+ my $dspslc=$tpdsp->Label(-textvariable=>\$dspselect,
+ -font=>$deffont,
+ -borderwidth=>2)->pack(-anchor=>'w',
+ -fill=>'x',
+ -side=>'right');
+# handle selection; only one selection possible
+ $tplist->bind('<Button-1>'=>sub{my ($slctind)=$tplist->curselection();
+ $dspselect=$lbitems[$slctind];
+ $docselect=$lbdocs[$slctind];});
+# key bindings
+ $tplist->bind('<Double-Button-1>'=>sub{
+ &viewslc($docselect,$tpbframe);});
+ $tpwin->bind('<Control-v>'=>sub{
+ &viewslc($docselect,$tpbframe);});
+ $tpwin->bind('<Control-p>'=>sub{
+ &prtslc($docselect,$tpbframe);});
+ $tpwin->bind('<Control-c>'=>sub{destroy $tpwin; undef $tlwins{$opt};});
+ $tplist->bind('<Button-3>'=>sub{
+ if ($docselect) {
+ &showpath($docselect,$tpbframe);
+ } else {
+ &popmsg(2,"No selection;\nuse left mouse button.",$tpbframe);
+ }});
+}
+
+# view document selected in listbox
+sub viewslc {
+ my($slc,$parframe)=@_;
+ my $viewer;
+ my $itype=-1;
+ my $browser=0;
+ my $styflag=0;
+ unless (defined $slc) {
+ &popmsg(2,"No selection was made.",$parframe);
+ return;
+ }
+ $parframe->configure(-cursor=>'watch');
+ chomp $slc;
+ my @dummy=split('\.',$slc);
+ DOC_FORMAT: { # determine document type
+ ($dummy[-1] =~ /dvi/) && do { $viewer=$dvi_viewer; last DOC_FORMAT; };
+ ($dummy[-1] =~ /ps/) && do { $viewer=$ps_viewer; last DOC_FORMAT; };
+ ($dummy[-1] =~ /pdf/) && do { $viewer=$pdf_viewer; last DOC_FORMAT; };
+ ($dummy[-1] =~ /txt/ || $dummy[-1] =~ /faq$/) && do {
+ $viewer=($txt_viewer eq "TDK_OWN" ||
+ $txt_viewer =~ /xterm/) ?
+ $txt_viewer : "${CmdConsole} $txt_viewer";
+ last DOC_FORMAT;
+ };
+ ($dummy[-1] =~ /README/i || $dummy[-2] =~ /\/README$/i) && do {
+ $viewer=($txt_viewer eq "TDK_OWN" ||
+ $txt_viewer =~ /xterm/) ?
+ $txt_viewer : "${CmdConsole} $txt_viewer";
+ last DOC_FORMAT;
+ };
+ ($dummy[-1] =~ /htm/) && do {
+ $viewer=$html_viewer;
+ if ($html_viewer =~ /netscape/i) { # check if Netscape is open
+ my $lockfile="${HomeEnv}/.netscape/lock";
+ $browser=1 if (-e $lockfile || -l $lockfile);
+ } elsif ($html_viewer =~ /mozilla/i) { # check if Mozilla is open
+ my $mozcheck=
+ `mozilla -remote 'openFile($texmfmain/doc/index.html)'`;
+ $browser=1 unless ($?);
+ }
+ last DOC_FORMAT;
+ };
+# some packages have no normal documentation but useful info in the .sty
+ ($dummy[-1] =~ /sty$/) && do {
+ $viewer=($txt_viewer eq "TDK_OWN" ||
+ $txt_viewer =~ /xterm/) ?
+ $txt_viewer : "${CmdConsole} $txt_viewer";
+ $slc="../tex/$slc"; # .sty files are in ${tex,local}docpath/../tex/
+ $styflag=1;
+ last DOC_FORMAT;
+ };
+ $parframe->configure(-cursor=>$defcursor);
+ if ($xfmt_viewer != 1) {
+ &popmsg(2,"$dummy[-1]: not a known document format",$parframe);
+ return;
+ }
+ };
+ if ($viewer eq "") {
+ if ($xfmt_viewer == 1) {
+ &popmsg(-1,'Unknown format; assuming plain text.',$parframe);
+ $viewer=($txt_viewer eq "TDK_OWN" ||
+ $txt_viewer =~ /xterm/) ?
+ $txt_viewer : "${CmdConsole} $txt_viewer";
+ } else {
+ &popmsg(2,"$dummy[-1]: no viewer available/specified for this format",
+ $parframe);
+ $parframe->configure(-cursor=>$defcursor);
+ return;
+ }
+ }
+# build complete path and start viewer if file exists
+ my $slcdoc;
+ $slcdoc=&finddoc($slcdoc,$slc,$parframe);
+ if ($slcdoc ne "") {
+# change to doc directory in case there are pictures
+ my $docpath=substr($slcdoc,0,(rindex($slcdoc,'/',(length $slcdoc))));
+ chomp $slcdoc;
+ chdir ($docpath);
+# try to get doc out of .sty file
+ if ($styflag) {
+ &popmsg(-1,'Trying to extract documentation out of .sty file;
+might be cluttered with program comments.',
+ $parframe);
+ $slcdoc=&stripsty($slcdoc,substr($slc,7));
+ }
+# for text files use built-in text viewer if set
+ if ($IsWin32) {
+ if ($viewer eq "TDK_OWN") {
+ &ShellExecute('open', $slcdoc);
+ $parframe->configure(-cursor=>$defcursor);
+ return;
+ }
+ else {
+ system("$viewer $slcdoc");
+ }
+ }
+ else {
+ if ($viewer eq "TDK_OWN") {
+ &textview($slcdoc);
+ $parframe->configure(-cursor=>$defcursor);
+ return;
+ }
+ if ($quiet == 0) { # show messages
+ if ($browser == 0) { # normal viewers or new Netscape/Mozilla
+ system("$viewer $slcdoc &");
+ } else { # open doc in existing Netscape/Mozilla window
+ system("$viewer -remote 'openFile($slcdoc)' &");
+ &popmsg(-1,"Opening document in existing $viewer window.",
+ $parframe);
+ }
+ } else { # viewer messages written to /dev/null instead of terminal
+ if ($browser == 0) { # normal viewers or new Netscape/Mozilla
+ system("perl -we 'use strict; \
+my \$dump=\"\"; \
+open(NULL,\">/dev/null\"); \
+open (VIEWQ,\"$viewer $slcdoc |\"); \
+while (\$dump=<VIEWQ>) { print NULL \$dump; } \
+close(VIEWQ); \
+close(NULL);' &");
+ } else { # open doc in existing window (Netscape or Mozilla)
+ # not quiet; I didn't get an inline perl call like in
+ # the other branch working
+ system("$viewer -remote 'openFile($slcdoc)' &");
+ &popmsg(-1,"Opening document in existing $viewer window.",
+ $parframe);
+ }
+ }
+ }
+ }
+ $parframe->configure(-cursor=>$defcursor);
+}
+
+# Tk widget for text document
+sub textview {
+ my($txtfile)=@_;
+# see if toplevel window with this file is already there
+ if (Exists($tlwins{$txtfile}{'addr'})) {
+ $tlwins{$txtfile}{'addr'}->deiconify();
+ $tlwins{$txtfile}{'addr'}->raise();
+ return;
+ }
+ my $tfv_tk=$main->Toplevel(-title=>"Text file viewer");
+ $tfv_tk->resizable(0,1);
+ $tlwins{$txtfile}{'addr'}=$tfv_tk;
+ $tfv_tk->Label(-text=>"File: $txtfile",
+ -font=>$deffont,
+ -relief=>'ridge',
+ -borderwidth=>3)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>10,
+ -anchor=>'s');
+ my $txtbody=$tfv_tk->Scrolled("Text",
+ -relief=>'flat',
+ -font=>$deffont,
+ -height=>20,
+ -width=>80,
+ -scrollbars=>"e")->pack(-side=>'top',
+ -fill=>'y',
+ -expand=>1);
+ open(TXTFILE,"$txtfile");
+ while (<TXTFILE>) { $txtbody->insert('end',$_); }
+ close(TXTFILE);
+ $txtbody->configure(-state=>'disabled');
+ $tlwins{$txtfile}{'buttons'}[0]=
+ $tfv_tk->Button(-text=>'Close',
+ -font=>$deffont,%butcol,
+ -command=>sub{ destroy $tfv_tk;
+ undef $tlwins{$txtfile};
+ })->pack(-side=>'bottom',
+ -fill=>'x');
+ $tfv_tk->bind('<Control-c>'=>sub{destroy $tfv_tk;
+ undef $tlwins{$txtfile};
+ });
+}
+
+# print document selected in listbox
+sub prtslc {
+ my($slc,$parframe)=@_;
+ $tmpfno=&randname;
+ my $pstmpfile="${TempDir}/texdoc_$tmpfno.ps";
+ push @tmpfiles,$pstmpfile;
+ my $status;
+ chomp $slc;
+ unless (defined $slc) {
+ &popmsg(2,"No selection was made.",$parframe);
+ return;
+ }
+ if ($print_cmd eq "") {
+ &popmsg(2,"No printer specified.",$parframe);
+ return;
+ }
+# build complete path and check existence of file
+ my @dummy=split('\.',$slc);
+ if ($dummy[-1] =~ /sty$/) {
+ $slc="../tex/$slc"; # .sty files are in ${tex,local,home}docpath/../tex
+ }
+ my $slcdoc;
+ $slcdoc=&finddoc($slcdoc,$slc,$parframe);
+ return if ($slcdoc eq "");
+# change to doc directory in case there are pictures
+ my $docpath=substr($slcdoc,0,(rindex($slcdoc,'/',(length $slcdoc))));
+ chdir ($docpath);
+ DOC_FORMAT: { # determine document type
+# convert dvi files to ps before printing
+ ($dummy[-1] =~ /dvi/) && do {
+ if ($dvips_conv eq "") {
+ &popmsg(2,"No converter available for dvi->ps conversion.",
+ $parframe);
+ return;
+ }
+ &popmsg(-1,"Converting dvi to ps for printing and sending file to print...",$parframe);
+ $status=system("$dvips_conv $slcdoc -o $pstmpfile");
+ if ($status != 0) {
+ &popmsg(2,"Error: Conversion dvi->ps failed!",$parframe);
+ }
+ last DOC_FORMAT;
+ };
+# PostScript is printed directly
+ ($dummy[-1] =~ /ps/) && do {
+ &popmsg(-1,"Sending file to $print_cmd...",$parframe);
+ $pstmpfile=$slcdoc;
+ last DOC_FORMAT;
+ };
+# convert pdf files to ps before printing
+ ($dummy[-1] =~ /pdf/) && do {
+ if ($pdfps_conv eq "") {
+ &popmsg(2,"No converter available for pdf->ps conversion.",
+ $parframe);
+ return;
+ }
+ &popmsg(-1,"Converting pdf to ps for printing and sending file to print...",$parframe);
+ system("$pdfps_conv $slcdoc $pstmpfile");
+ last DOC_FORMAT;
+ };
+# convert html files to ps before printing
+ ($dummy[-1] =~ /htm/) && do {
+ if ($htmlps_conv eq "") {
+ &popmsg(2,"No converter available for html->ps conversion.",
+ $parframe);
+ return;
+ }
+ &popmsg(-1,"Converting html to ps for printing and sending file to print...",$parframe);
+ my $htmlps_redir_sign=($htmlps_redir == 1) ? ">" :"";
+ system("$htmlps_conv $slcdoc $htmlps_redir_sign $pstmpfile");
+ last DOC_FORMAT;
+ };
+# convert txt files to ps before printing
+ ($dummy[-1] =~ /txt/ || $dummy[-1] =~ /faq$/
+ || $dummy[-1] =~ /README/i) && do {
+ if ($txtps_conv eq "") {
+ &popmsg(2,"No converter available for txt->ps conversion.",
+ $parframe);
+ return;
+ }
+ &popmsg(-1,"Converting txt to ps for printing and sending file to print...",$parframe);
+ my $txtps_redir_sign=($txtps_redir == 1) ? ">" :"";
+ system("$txtps_conv $slcdoc $txtps_redir_sign $pstmpfile");
+ last DOC_FORMAT;
+ };
+# convert extracted comments from sty files to ps before printing
+ ($dummy[-1] =~ /sty$/) && do {
+ if ($txtps_conv eq "") {
+ &popmsg(2,"No converter available for sty(txt)->ps conversion.",
+ $parframe);
+ return;
+ }
+ &popmsg(-1,"Converting sty(txt) to ps for printing and sending file to print...",$parframe);
+# try to get doc out of .sty file
+ &popmsg(-1,'Trying to extract documentation out of .sty file;
+might be cluttered with program comments.',
+ $parframe);
+ $slcdoc=&stripsty($slcdoc,substr($slc,7));
+ my $txtps_redir_sign=($txtps_redir == 1) ? ">" :"";
+ system("$txtps_conv $slcdoc $txtps_redir_sign $pstmpfile");
+ last DOC_FORMAT;
+ };
+ &popmsg(2,"$dummy[-1]: cannot print document format",$parframe);
+ return;
+ };
+ system("$print_cmd $pstmpfile");
+}
+
+# test existence and search a documentation which is not in specified place
+sub finddoc {
+ my($slcdoc,$slc,$parframe)=@_;
+ my ($dummy,$status);
+ SLCDOCFIND: foreach ($texdocpath,$distdocpath,$docdocpath) {
+ $slcdoc="$_/$slc";
+ if (-e $slcdoc) {
+# found where it should be
+ return $slcdoc;
+ } else {
+# see if the documentation file is in the local doc tree...
+ my @srchslcdoc=($slcdoc);
+ if ($localdocpath) {
+ push @srchslcdoc,"$localdocpath/$slc";
+ return $srchslcdoc[-1] if (-e $srchslcdoc[-1]);
+ }
+# ... or the user's doc tree...
+ if ($homedocpath) {
+ push @srchslcdoc,"$homedocpath/$slc";
+ return $srchslcdoc[-1] if (-e $srchslcdoc[-1]);
+ }
+# ... otherwise proceed with searching
+ $status=-1;
+# see if the documentation file is compressed
+ CMPREND: foreach my $cmprtype ("gz","bz2","zip") {
+ foreach (@srchslcdoc) {
+ $dummy="$_.$cmprtype";
+ if (-e $dummy) { # yes, it is compressed
+ $tmpfno=&randname;
+ my $rawname=basename($slc,"");
+ $slcdoc="${TempDir}/texdoc_$tmpfno$rawname";
+ push @tmpfiles,$slcdoc;
+ my ($dcmp,$dcmp_opt);
+ COMPRESS: { # determine compression type
+ ($cmprtype eq "gz") && do {
+ $dcmp="gzip";
+ $dcmp_opt="-cd";
+ last COMPRESS;
+ };
+ ($cmprtype eq "bz2") && do {
+ $dcmp="bzip2";
+ $dcmp_opt="-cd";
+ last COMPRESS;
+ };
+ ($cmprtype eq "zip") && do {
+ $dcmp="zip";
+ $dcmp_opt="-p";
+ last COMPRESS;
+ };
+ };
+# try to decompress
+ $status=system("$dcmp $dcmp_opt $dummy > $slcdoc");
+ if ($status != 0) { # failure
+ &popmsg(2,
+ "$dcmp: Couldn't decompress file, cancelling.",
+ $parframe);
+ $slcdoc="";
+ return $slcdoc;
+ }
+ last CMPREND;
+ }
+ }
+ }
+ }
+ }
+ if ($status != 0) {
+ $parframe->configure(-cursor=>'watch');
+# try to find it elsewhere with kpsewhich
+ my $rawname=basename($slc,"");
+ $slcdoc=($slcdoc =~ /\.sty$/) ?
+ `kpsewhich $rawname` :
+ `kpsewhich --format=${qq}TeX system documentation${qq} $rawname`;
+ if ($slcdoc eq "") { # nothing found; cancel
+ &popmsg(2,"$rawname not found, cancelling.",$parframe);
+ $slcdoc="";
+ }
+ $parframe->configure(-cursor=>$defcursor);
+ }
+ return $slcdoc;
+}
+
+# determine existence and show paths of files (Button-3)
+sub showpath {
+ my ($docselect,$tpbframe)=@_;
+ my $found=0;
+ if ($docselect =~ /\.sty$/) {
+ STYPATH: foreach my $fullpath ("$texmfmain/tex/$docselect",
+ "$texmfdist/tex/$docselect",
+ "$texmflocal/tex/$docselect",
+ "$texmfhome/tex/$docselect") {
+ if (-e $fullpath) {
+ &popmsg(0,"Selected file:\n$fullpath",$tpbframe);
+ $found=1;
+ last STYPATH;
+ }
+ }
+ if (!$found) {
+ &popmsg(2,"Selected file:\n$docselect\ndoes not exist.",$tpbframe) }
+ } else {
+ DOCPATH: foreach my $fullpath ("$texdocpath/$docselect",
+ "$distdocpath/$docselect",
+ "$docdocpath/$docselect",
+ "$localdocpath/$docselect",
+ "$homedocpath/$docselect") {
+ foreach ('','.gz','.bz2','.zip') {
+ my $fullpathext="$fullpath$_";
+ if (-e $fullpathext) {
+ &popmsg(0,"Selected file:\n$fullpathext",$tpbframe);
+ $found=1;
+ last DOCPATH;
+ }
+ }
+ }
+ if (!$found) {
+ &popmsg(2,"Selected file:\n$docselect\ndoes not exist (neither in normal form nor compressed).",$tpbframe) }
+ }
+}
+
+# make or destroy search entry widget
+sub mksrch {
+ if ($srchflag == 1) {
+ destroy $srchentry;
+ $srchflag=0;
+ } else {
+# get the search string
+ $srchentry=$cmdframe->Entry(-cursor=>'xterm',
+ -font=>$deffont,
+ -width=>20,
+ -takefocus=>1)->pack(-side=>'left');
+ $srchentry->focus();
+ $srchentry->bind('<Return>'=>[\&srchstr, $srchentry]);
+ $srchflag=1;
+# key binding
+ $srchentry->bind('<Control-c>'=>sub{destroy $srchentry; $srchflag=0;});
+ }
+}
+
+# search a string in @packname, @topic and @keywords
+sub srchstr {
+ my ($i,$j,$string);
+ my (@results,@reslist);
+ $main->configure(-cursor=>'watch');
+ $string=$srchentry->get();
+# search
+ if ($string) {
+ for ($i=0; $i<$ncat; ++$i) {
+ for ($j=0; $j<$maxind[$i]+1; ++$j) {
+ SRCH: {
+ ($topic[$i][$j] =~ /$string/i) && do {
+ push @results,($i,$j);
+ last SRCH;
+ };
+ (defined $keywords[$i][$j]) && do {
+ if ($keywords[$i][$j] =~ /$string/i) {
+ push @results,($i,$j);
+ last SRCH;
+ }
+ };
+ ($packname[$i][$j] =~ /$string/i) && do {
+ push @results,($i,$j);
+ last SRCH;
+ };
+ };
+ }
+ }
+ } else { # return full database
+ $string='all database entries';
+ for ($i=0; $i<$ncat; ++$i) {
+ for ($j=0; $j<$maxind[$i]+1; ++$j) { push @results,($i,$j); }
+ }
+ }
+# destroy entry widget and show results
+ destroy $srchentry;
+ $srchflag=0;
+ if (scalar @results == 0) {
+ &popmsg(0,"Search for $string: no matches found.",$cmdframe);
+ } else {
+# cancel multiple entries
+ my ($omit,$pack1,$pack2);
+ @reslist=($results[0],$results[1]);
+ for ($i=0; $i<$#results; $i+=2) {
+ $omit=0;
+ $pack1=$packname[$results[$i]][$results[$i+1]];
+ for ($j=0; $j<$#reslist; $j+=2) {
+ $pack2=$packname[$reslist[$j]][$reslist[$j+1]];
+ if ($pack1 eq $pack2) { $omit=1; last; }
+ }
+ if ($omit == 0) { push @reslist,($results[$i],$results[$i+1]); }
+ }
+ unshift @reslist,$string;
+ &tpslct(-1,@reslist);
+ }
+ $main->configure(-cursor=>$defcursor);
+}
+
+# extract documentation of .sty files; a flag in the @keywords array shows
+# where the doc is located:
+# -0-: no specific place; -1-: at end, behind \endinput; -2-: at beginning,
+# terminated by %%%%%%; -3-: at beginning, terminated with blank line
+sub stripsty {
+ my ($slcdoc,$slc)=@_;
+ my @stydoc;
+ $tmpfno=&randname;
+ my $tmpslcdoc="${TempDir}/texdoc_$tmpfno.txt";
+ push @tmpfiles,$tmpslcdoc;
+ open (STY,"$slcdoc");
+ LOC: {
+ ($stydoc{$slc} == 0) && do { # no specific place, suck in everything :-(
+ while ($line = <STY>) { push @stydoc,$line if ($line =~ /^%/); }
+ last LOC;
+ };
+ ($stydoc{$slc} == 1) && do { # at end, behind \endinput
+ while ($line = <STY>) {
+ last if ($line =~ /^\s*\\endinput/ && !($line =~ /^%/));
+ }
+ while ($line = <STY>) { push @stydoc,$line; }
+ last LOC;
+ };
+ ($stydoc{$slc} == 2) && do { # up to a certain %%%%%%%, hopefully the 1st
+ for (my $i=0; $i<9; ++$i) { $stydoc[$i]=<STY>; } # after the 8th line
+ while ($line = <STY>) {
+ last if ($line =~ /^%{4,}/);
+ push @stydoc,$line;
+ }
+ last LOC;
+ };
+ ($stydoc{$slc} == 3) && do { # up to 1st blank/apparently empty line
+ while ($line = <STY>) {
+ last if ($line =~ /^\s*$/);
+ push @stydoc,$line;
+ }
+ last LOC;
+ };
+ };
+ close(STY);
+ open(TMPSTY,">$tmpslcdoc");
+ foreach (@stydoc) { print TMPSTY $_; }
+ close(TMPSTY);
+ return $tmpslcdoc;
+}
+
+# pop up a note or an error or warning message toplevel window
+sub popmsg {
+ my($level,$msg,$parframe)=@_;
+ my $degree;
+ LEVEL: {
+ ($level == -1) && do { $degree="Info"; last LEVEL; };
+ ($level == 0) && do { $degree="Note"; last LEVEL; };
+ ($level == 1) && do {
+ return if ($quiet == 1);
+ $degree="Warning";
+ last LEVEL
+ };
+ ($level == 2) && do { $degree="Error"; last LEVEL; };
+ };
+ my $msgwin=$parframe->Toplevel(-title=>$degree);
+ my $lbl=$msgwin->Label(-text=>uc($degree),
+ -font=>$deffont)->pack(-side=>'top', -fill=>'x');
+# get size of message text
+ my @dummy=split("\n",$msg);
+ my $nline=scalar @dummy;
+ my $msgwidth=0;
+ my $lline;
+ foreach (@dummy) {
+ $lline=length $_;
+ if ($lline > $msgwidth) { $msgwidth=$lline; }
+ }
+ my $message=$msgwin->Text(-relief=>'flat',
+ -font=>$deffont,
+ -height=>$nline,
+ -width=>$msgwidth)->pack(-side=>'top');
+ $message->insert('end',$msg);
+ $message->configure(-state=>'disabled');
+ if ($level < 0) { # transient message window
+ $msgwin->after(3000,sub{destroy $msgwin});
+ } else { # persistent message window
+ $msgwin->Button(-text=>'Close',
+ -font=>$deffont,%butcol,
+ -command=>sub{destroy $msgwin})->pack(-side=>'bottom',
+ -fill=>'x');
+ $msgwin->bind('<Control-c>'=>sub{destroy $msgwin});
+ }
+}
+
+# show/change settings (don't show this to an expert :-/ )
+sub settings {
+ my ($homedocpath_tmp,$quiet_tmp,$autoview_tmp,$xfmt_viewer_tmp,
+ $dvi_viewer_tmp,$dvips_conv_tmp,
+ $ps_viewer_tmp,$pdf_viewer_tmp,$pdfps_conv_tmp,
+ $html_viewer_tmp,$htmlps_conv_tmp,$htmlps_redir_tmp,
+ $txt_viewer_tmp,$txtps_conv_tmp,$txtps_redir_tmp,$print_cmd_tmp)=
+ ($homedocpath,$quiet,$autoview,$xfmt_viewer,
+ $dvi_viewer,$dvips_conv,$ps_viewer,
+ $pdf_viewer,$pdfps_conv,$html_viewer,
+ $htmlps_conv,$htmlps_redir,$txt_viewer,
+ $txtps_conv,$txtps_redir,$print_cmd);
+ my @tdcolors_tmp=@tdcolors;
+# see if toplevel window is already there
+ if (Exists($tlwins{"setmenu"}{'addr'})) {
+ $tlwins{"setmenu"}{'addr'}->deiconify();
+ $tlwins{"setmenu"}{'addr'}->raise();
+ return;
+ }
+ my $setmenu=$main->Toplevel(-title=>'Settings');
+ $setmenu->resizable(0,0);
+ $tlwins{"setmenu"}{'addr'}=$setmenu;
+# documentation path
+ my $datlabel;
+ $datlabel="Database file(s) used: teTeX";
+ $datlabel.=", local database" if (-e $locdatabase);
+ $datlabel.=", user database" if (-e $homedatabase);
+ my $docframe=$setmenu->Frame(-relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -expand=>1);
+ my $docframestring="\nDistribution documentation root path(s):\n$texdocpath";
+ $docframestring.=", $distdocpath" if (-e $distdocpath);
+ $docframestring.=", $docdocpath" if (length $docdocpath);
+ if ($localdocpath && $localdocpath ne $texdocpath) {
+ $docframestring.="\nLocal documentation root path: $localdocpath\n";
+ }
+ $docframe->Label(-text=>"$docframestring",
+ -font=>$deffont)->pack(-side=>'top',
+ -anchor=>'w',
+ -fill=>'x',
+ -expand=>1);
+ if (defined $texmfhome && -d $texmfhome) {
+ $homedocpath_tmp=basename($homedocpath_tmp,"");
+ my $usrdocframe=$docframe->Frame(-relief=>'flat')->pack(-side=>'top',
+ -fill=>'x');
+ my $usrdoclabel=$usrdocframe->Label(-text=>"User's documentation root path: $texmfhome/",
+ -font=>$deffont)->pack(-side=>'left');
+ my $usrdocentry=$usrdocframe->Entry(-textvariable=>\$homedocpath_tmp,
+ -font=>$deffont)->pack(-side=>'left');
+ }
+ $docframe->Label(-text=>"$datlabel.",
+ -font=>$deffont)->pack(-side=>'top',
+ -anchor=>'w',
+ -ipady=>2,
+ -fill=>'x',
+ -expand=>1);
+# General viewer behaviour
+ my $genvframe=$setmenu->Frame(-label=>'General viewer behaviour',
+ -relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>6,
+ -expand=>1);
+ my $genvframe1=$genvframe->Frame()->pack(-side=>'left');
+ my $genvsub1=$genvframe1->Frame()->pack(-side=>'top',
+ -anchor=>'w',
+ -ipady=>3);
+ my $genvecbut=$genvsub1->
+ Checkbutton(-variable=>\$quiet_tmp)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $genvelabel=$genvsub1->Label(-text=>'Suppress error messages',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $genvsub2=$genvframe1->Frame()->pack(-side=>'top',
+ -anchor=>'w');
+ my $genvscbut=$genvsub2->
+ Checkbutton(-variable=>\$autoview_tmp)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $genvslabel=$genvsub2->Label(-text=>'Autostart viewer for one-item listboxes',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $genvsub3=$genvframe1->Frame()->pack(-side=>'top',
+ -anchor=>'w');
+ my $genvxcbut=$genvsub3->
+ Checkbutton(-variable=>\$xfmt_viewer_tmp)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $genvxlabel=$genvsub3->Label(-text=>'Use text viewer for unknown file format',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+# colours of GUI
+ my @tdcolors_d=@tdcolors_tmp;
+ $tlwins{'setmenu'}{'buttons'}[0]=
+ $genvframe->Button(-text=>'Change viewer colours',
+ -command=>sub {
+ @tdcolors_tmp=&popcolor($setmenu,@tdcolors_tmp);
+ @tdcolors_d=@tdcolors_tmp;
+ },
+ -font=>$deffont,%butcol)->pack(-side=>'right');
+# DVI
+ my $dviframe=$setmenu->Frame(-label=>'DVI',
+ -relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>6,
+ -expand=>1);
+ my $dvisub1=$dviframe->Frame()->pack(-side=>'top',
+ -anchor=>'w');
+ my $dvisub2=$dviframe->Frame()->pack(-side=>'top',
+ -anchor=>'w',
+ -ipady=>6);
+ my $dvivlabel=$dvisub1->Label(-text=>'Viewer command',
+ -anchor=>'w',
+ -font=>$deffont)->pack(-side=>'left');
+ my $dviventry=$dvisub1->Entry(-textvariable=>\$dvi_viewer_tmp,
+ -font=>$deffont)->pack(-side=>'left');
+ my $dviclabel=$dvisub2->Label(-text=>'DVI->PS converter command',
+ -anchor=>'w',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $dvilbwidth=length 'DVI->PS converter command';
+ $dvivlabel->configure(-width=>1.1*$dvilbwidth);
+ $dviclabel->configure(-width=>1.1*$dvilbwidth);
+ my $dvicentry=$dvisub2->Entry(-textvariable=>\$dvips_conv_tmp,
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+# PostScript
+ my $psframe=$setmenu->Frame(-label=>'PostScript',
+ -relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>10,
+ -expand=>1);
+ my $psvlabel=$psframe->Label(-text=>'Viewer command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'w');
+ my $psventry=$psframe->Entry(-textvariable=>\$ps_viewer_tmp,
+ -font=>$deffont)->pack(-side=>'left');
+# PDF
+ my $pdfframe=$setmenu->Frame(-label=>'PDF',
+ -relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>6,
+ -expand=>1);
+ my $pdfsub1=$pdfframe->Frame()->pack(-side=>'top',
+ -anchor=>'w');
+ my $pdfsub2=$pdfframe->Frame()->pack(-side=>'top',
+ -anchor=>'w',
+ -ipady=>6);
+ my $pdfvlabel=$pdfsub1->Label(-text=>'Viewer command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'w');
+ my $pdfventry=$pdfsub1->Entry(-textvariable=>\$pdf_viewer_tmp,
+ -font=>$deffont)->pack(-side=>'left');
+ my $pdfclabel=$pdfsub2->Label(-text=>'PDF->PS converter command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $pdfcentry=$pdfsub2->Entry(-textvariable=>\$pdfps_conv_tmp,
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+# HTML
+ my $htmlframe=$setmenu->Frame(-label=>'HTML',
+ -relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>6,
+ -expand=>1);
+ my $htmlsub1=$htmlframe->Frame()->pack(-side=>'top',
+ -anchor=>'w');
+ my $htmlsub2=$htmlframe->Frame()->pack(-side=>'top',
+ -anchor=>'w',
+ -ipady=>6);
+ my $htmlvlabel=$htmlsub1->Label(-text=>'Viewer command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'w');
+ my $htmlventry=$htmlsub1->Entry(-textvariable=>\$html_viewer_tmp,
+ -font=>$deffont)->pack(-side=>'left');
+ my $htmlclabel=$htmlsub2->Label(-text=>'HTML->PS converter command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $htmlcentry=$htmlsub2->Entry(-textvariable=>\$htmlps_conv_tmp,
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $htmlrlabel=$htmlsub2->Label(-text=>'Output redirect needed',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $htmlrcbut=$htmlsub2->
+ Checkbutton(-variable=>\$htmlps_redir_tmp)->pack(-side=>'left',
+ -anchor=>'sw');
+# plain text
+ my $txtframe=$setmenu->Frame(-label=>'Plain text',
+ -relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>6,
+ -expand=>1);
+ my $txtsub1=$txtframe->Frame()->pack(-side=>'top',
+ -anchor=>'w');
+ my $txtsub2=$txtframe->Frame()->pack(-side=>'top',
+ -anchor=>'w',
+ -ipady=>6);
+ my $txtvlabel=$txtsub1->Label(-text=>'Viewer command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'w');
+ my $txtventry=$txtsub1->Entry(-textvariable=>\$txt_viewer_tmp,
+ -font=>$deffont)->pack(-side=>'left');
+ my $txt_view_flag;
+ if ($txt_viewer_tmp eq "TDK_OWN") {
+ $txt_view_flag=1;
+ $txtventry->configure(-state=>'disabled');
+ } else {
+ $txt_view_flag=0;
+ $txtventry->configure(-state=>'normal');
+ }
+ my $txtvilabel=$txtsub1->Label(-text=>"\tUse texdoctk\'s own viewer",
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $txtvcbut=$txtsub1->
+ Checkbutton(-variable=>\$txt_view_flag,
+ -command=>sub {
+ if ($txt_view_flag == 1) {
+ $txt_viewer_tmp="TDK_OWN";
+ $txtventry->configure(-state=>'disabled');
+ } else {
+ $txt_viewer_tmp=$txt_viewer;
+ $txtventry->configure(-state=>'normal');
+ $txtventry->focus();
+ }
+ })->pack(-side=>'left',
+ -anchor=>'sw');
+ my $txtclabel=$txtsub2->Label(-text=>'Text->PS converter command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $txtcentry=$txtsub2->Entry(-textvariable=>\$txtps_conv_tmp,
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $txtrlabel=$txtsub2->Label(-text=>'Output redirect needed',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $txtrcbut=$txtsub2->
+ Checkbutton(-variable=>\$txtps_redir_tmp)->pack(-side=>'left',
+ -anchor=>'sw');
+# printer
+ my $prtframe=$setmenu->Frame(-label=>'Printer',
+ -relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>10,
+ -expand=>1);
+ my $prtclabel=$prtframe->Label(-text=>'Command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'w');
+ my $prtcentry=$prtframe->Entry(-textvariable=>\$print_cmd_tmp,
+ -font=>$deffont)->pack(-side=>'left');
+# buttons and key bindings
+ my $setbfr=$setmenu->Frame()->pack(-side=>'bottom');
+ $tlwins{'setmenu'}{'buttons'}[1]=
+ $setbfr->Button(-text=>'OK',
+ -font=>$deffont,%butcol,
+ -command=>sub{
+ $homedocpath="$texmfhome/$homedocpath_tmp";
+ ($quiet,$autoview,$xfmt_viewer,
+ $dvi_viewer,$dvips_conv,
+ $ps_viewer,$pdf_viewer,
+ $pdfps_conv,$html_viewer,
+ $htmlps_conv,$htmlps_redir,
+ $txt_viewer,$txtps_conv,$txtps_redir,$print_cmd)=
+ ($quiet_tmp,$autoview_tmp,$xfmt_viewer_tmp,
+ $dvi_viewer_tmp,$dvips_conv_tmp,
+ $ps_viewer_tmp,
+ $pdf_viewer_tmp,$pdfps_conv_tmp,
+ $html_viewer_tmp,
+ $htmlps_conv_tmp,$htmlps_redir_tmp,
+ $txt_viewer_tmp,$txtps_conv_tmp,
+ $txtps_redir_tmp,$print_cmd_tmp);
+ @tdcolors=@tdcolors_tmp;
+ %butcol=('-background'=>$tdcolors[0],
+ '-foreground'=>$tdcolors[1],
+ '-activebackground'=>$tdcolors[2],
+ '-activeforeground'=>$tdcolors[3]);
+ foreach my $tlkey (keys %tlwins) {
+ foreach (@{$tlwins{$tlkey}{'buttons'}}) {
+ $_->configure(%butcol);
+ }
+ }
+ if ($txt_viewer eq "" &&
+ defined $ENV{PAGER}) {
+ $txt_viewer=$ENV{PAGER};
+ }
+ destroy $setmenu},
+ -width=>6)->pack(-side=>'left',
+ -padx=>10,
+ -pady=>10);
+ $tlwins{'setmenu'}{'buttons'}[2]=
+ $setbfr->Button(-text=>'Save',
+ -font=>$deffont,%butcol,
+ -command=>sub{
+ $setmenu->configure(-cursor=>'watch');
+ &popmsg(-1,"Writing settings to $myrc",$setmenu);
+ my $tdcolors_tmp=join(' ',@tdcolors_tmp);
+ &writerc($homedocpath_tmp,
+ $quiet_tmp,$autoview_tmp,$xfmt_viewer_tmp,
+ $tdcolors_tmp,
+ $dvi_viewer_tmp,$dvips_conv_tmp,
+ $ps_viewer_tmp,
+ $pdf_viewer_tmp,$pdfps_conv_tmp,
+ $html_viewer_tmp,
+ $htmlps_conv_tmp,$htmlps_redir_tmp,
+ $txt_viewer_tmp,$txtps_conv_tmp,
+ $txtps_redir_tmp,$print_cmd_tmp,$setmenu);
+ $setmenu->configure(-cursor=>$defcursor);
+ })->pack(-side=>'left',
+ -padx=>10);
+ $tlwins{'setmenu'}{'buttons'}[3]=
+ $setbfr->Button(-text=>'Cancel',
+ -font=>$deffont,%butcol,
+ -command=>sub{destroy $setmenu;
+ undef $tlwins{"setmenu"};
+ })->pack(-side=>'left',
+ -padx=>10);
+ $setmenu->bind('<Control-c>'=>sub{destroy $setmenu;
+ undef $tlwins{"setmenu"};});
+}
+
+# dialog toplevel for color settings
+sub popcolor {
+ my ($parframe,@entryvar)=@_;
+# see if toplevel window is already there
+ if (Exists($tlwins{'chngcol'}{'addr'})) {
+ $tlwins{'chngcol'}{'addr'}->deiconify();
+ $tlwins{'chngcol'}{'addr'}->raise();
+ return;
+ }
+ my $dlgwin=$parframe->Toplevel(-title=>'Change colours');
+ $dlgwin->resizable(0,0);
+ $tlwins{'chngcol'}{'addr'}=$dlgwin;
+# entry widgets for default/active back/foreground
+ $dlgwin->Label(-text=>'Enter colours as names or RGB #xxxxxx values',
+ -font=>$deffont)->pack(-side=>'top');
+ my $dlgdef=$dlgwin->Frame()->pack(-side=>'top');
+ my $dlgact=$dlgwin->Frame()->pack(-side=>'top');
+ my $dlgdef1=$dlgdef->Frame()->pack(-side=>'left');
+ my $dlgtfr0=$dlgdef1->Frame()->pack(-side=>'top');
+ my $dlgtfr1=$dlgdef1->Frame()->pack(-side=>'top');
+ my $dlgact1=$dlgact->Frame()->pack(-side=>'left');
+ my $dlgtfr2=$dlgact1->Frame()->pack(-side=>'top');
+ my $dlgtfr3=$dlgact1->Frame()->pack(-side=>'top');
+ $dlgtfr0->Label(-text=>"Default background",
+ -anchor=>'w',
+ -width=>18,
+ -font=>$deffont)->pack(-side=>'left');
+ $dlgtfr0->Entry(-textvariable=>\$entryvar[0],
+ -font=>$deffont)->pack(-side=>'left');
+ $dlgtfr1->Label(-text=>"Default foreground",
+ -anchor=>'w',
+ -width=>18,
+ -font=>$deffont)->pack(-side=>'left');
+ $dlgtfr1->Entry(-textvariable=>\$entryvar[1],
+ -font=>$deffont)->pack(-side=>'left');
+ my $deflabel=$dlgdef->Label(-text=>'Default',
+ -relief=>'ridge',
+ -width=>10,
+ -height=>2)->pack(-side=>'right',
+ -padx=>7);
+ $dlgtfr2->Label(-text=>"Active background",
+ -anchor=>'w',
+ -width=>18,
+ -font=>$deffont)->pack(-side=>'left');
+ $dlgtfr2->Entry(-textvariable=>\$entryvar[2],
+ -font=>$deffont)->pack(-side=>'left');
+ $dlgtfr3->Label(-text=>"Active foreground",
+ -anchor=>'w',
+ -width=>18,
+ -font=>$deffont)->pack(-side=>'left');
+ $dlgtfr3->Entry(-textvariable=>\$entryvar[3],
+ -font=>$deffont)->pack(-side=>'left');
+ my $actlabel=$dlgact->Label(-text=>'Active',
+ -background=>$entryvar[2],
+ -foreground=>$entryvar[3],
+ -relief=>'ridge',
+ -width=>10,
+ -height=>2)->pack(-side=>'right',
+ -padx=>7);
+# buttons
+ my $setbfr=$dlgwin->Frame()->pack(-side=>'bottom');
+ my $chngflag=0;
+ $tlwins{'chngcol'}{'buttons'}[0]=
+ $setbfr->Button(-text=>'OK',
+ -font=>$deffont,%butcol,
+ -command=>sub {
+ foreach (@entryvar) { # RGB form with leading #
+ $_="#$_" if (/^[A-Fa-f0-9]{6}$/);
+ }
+ $chngflag=1 if (&colcheck($dlgwin,@entryvar));
+ },
+ -width=>6)->pack(-side=>'left',
+ -padx=>5,
+ -pady=>10);
+ $tlwins{'chngcol'}{'buttons'}[1]=
+ $setbfr->Button(-text=>'Preview',
+ -font=>$deffont,%butcol,
+ -command=>sub {
+ foreach (@entryvar) { # RGB form with leading #
+ $_="#$_" if (/^[A-Fa-f0-9]{6}$/);
+ }
+ if (&colcheck($dlgwin,@entryvar)) {
+ $deflabel->
+ configure(-background=>$entryvar[0],
+ -foreground=>$entryvar[1]);
+ $actlabel->
+ configure(-background=>$entryvar[2],
+ -foreground=>$entryvar[3]);
+ }
+ },
+ -width=>6)->pack(-side=>'left',
+ -padx=>5,
+ -pady=>10);
+ $tlwins{'chngcol'}{'buttons'}[2]=
+ $setbfr->Button(-text=>'Cancel',
+ -font=>$deffont,%butcol,
+ -command=>sub{destroy $dlgwin;
+ undef $tlwins{'chngcol'};
+ })->pack(-side=>'right',
+ -padx=>5,
+ -pady=>10);
+ $dlgwin->bind('<Control-c>'=>sub{destroy $dlgwin;
+ undef $tlwins{'chngcol'}; });
+ $dlgwin->waitVariable(\$chngflag);
+ destroy $dlgwin;
+ undef $tlwins{'chngcol'};
+ return @entryvar;
+}
+
+# check colours set in popcolor; relies on the existence of X11's showrgb
+sub colcheck {
+ my ($dlgwin,@entryvar)=@_;
+ my $ecnt=0;
+ foreach (@entryvar) { # all colours defined?
+ last unless ($_);
+ ++$ecnt;
+ }
+ &popmsg(2,'Some colours undefined.',$dlgwin) if ($ecnt != 4);
+ my $defcol=0;
+ if (`which showrgb`) { # test for proper name
+ my @rgb=`showrgb`;
+ my @norgb;
+ foreach my $colour (@entryvar) {
+ if ($colour =~ /^#[A-Fa-f0-9]{6}$/ || grep /\b$colour\b/i,@rgb) {
+ ++$defcol;
+ } else {
+ push @norgb,$colour;
+ }
+ }
+ if ($defcol != 4) {
+ my $norgb=join("\n",@norgb);
+ &popmsg(2,"Some colours invalid:\n$norgb",$dlgwin);
+ }
+ } else { $defcol=4; }
+ return ($ecnt == 4 && $defcol == 4) ? 1 : 0;
+}
+
+# write user's ~/.texdocrc
+sub writerc {
+ use File::Copy qw/cp mv/;
+ my ($homedocpath_tmp,$quiet_tmp,$autoview_tmp,$xfmt_viewer_tmp,
+ $tdcolors_tmp,
+ $dvi_viewer_tmp,$dvips_conv_tmp,
+ $ps_viewer_tmp,
+ $pdf_viewer_tmp,$pdfps_conv_tmp,
+ $html_viewer_tmp,
+ $htmlps_conv_tmp,$htmlps_redir_tmp,
+ $txt_viewer_tmp,$txtps_conv_tmp,
+ $txtps_redir_tmp,$print_cmd_tmp,$parframe)=@_;
+ my $err=0;
+ mv $myrc,"$myrc.save" if (-e $myrc);
+ open(MYRC,">$myrc");
+ print MYRC "# user's .texdocrc, generated by program\n
+# root of user's doc directory (from \$HOMETEXMF)
+# can be left empty if \$TEXMFHOME is undefined
+HOMEDOCPATH=$homedocpath_tmp
+# general viewer behaviour (y or yes to make active)
+QUIET=$quiet_tmp
+AUTOVIEW=$autoview_tmp
+XFMT_VIEWER=$xfmt_viewer_tmp
+# button colours: default and active back-/foreground
+# names and RGB values are both allowed; use the form #xxxxxx for RGB
+TDCOLORS=$tdcolors_tmp
+# the following variables contain whole commands, i.e. options can be given
+# DVI settings
+DVI_VIEWER=$dvi_viewer_tmp
+DVIPS_CONV=$dvips_conv_tmp
+# PostScript handling
+PS_VIEWER=$ps_viewer_tmp
+# PDF handling
+PDF_VIEWER=$pdf_viewer_tmp
+PDFPS_CONV=$pdfps_conv_tmp
+# HTML handling
+HTML_VIEWER=$html_viewer_tmp
+HTMLPS_CONV=$htmlps_conv_tmp
+# HTMLPS_REDIR must be on, if the html->ps converter normally writes its output
+# to stdout instead of a file (e.g. as html2ps) (y or yes to make active)
+HTMLPS_REDIR=$htmlps_redir_tmp
+# Plain text handling
+# TDK_OWN is texdoctk's own text file viewer
+TXT_VIEWER=$txt_viewer_tmp
+TXTPS_CONV=$txtps_conv_tmp
+# TXTPS_REDIR must be on, if the txt->ps converter normally writes its output
+# to stdout instead of a file (e.g. as a2ps) (y or yes to make active)
+TXTPS_REDIR=$txtps_redir_tmp
+# printer
+PRINT_CMD=$print_cmd_tmp
+\n# end of config\n";
+ close(MYRC);
+}
+
+# help window (toplevel)
+sub helptext {
+# see if toplevel window is already there
+ if (Exists($tlwins{"helptext"}{'addr'})) {
+ $tlwins{"helptext"}{'addr'}->deiconify();
+ $tlwins{"helptext"}{'addr'}->raise();
+ return;
+ }
+ my $help=$main->Toplevel(-title=>'Help/About');
+ $help->resizable(0,1);
+ $tlwins{'helptext'}{'addr'}=$help;
+ $help->Label(-text=>"texdoctk
+TeX documentation browser
+ v.0.6.0a (Nov 5, 2004)",
+ -font=>$deffont)->pack(-side=>'top',
+ -ipady=>10,
+ -anchor=>'s');
+ my $helpbody=$help->Scrolled("Text",
+ -relief=>'flat',
+ -font=>$deffont,
+ -height=>20,
+ -width=>60,
+ -scrollbars=>"e")->pack(-side=>'top',
+ -fill=>'y',
+ -expand=>1);
+ my $pos=tell DATA;
+ while (<DATA>) {
+ $_ =~ s/\$sysrc/$sysrc/;
+ last if (/^#/);
+ $helpbody->insert('end',$_);
+ }
+ seek(DATA,$pos,0);
+ $helpbody->configure(-state=>'disabled');
+ $tlwins{'helptext'}{'buttons'}[0]=
+ $help->Button(-text=>'Close',
+ -font=>$deffont,%butcol,
+ -command=>sub{destroy $help;
+ undef $tlwins{"helptext"};
+ })->pack(-side=>'bottom',
+ -fill=>'x');
+ $help->bind('<Control-c>'=>sub{destroy $help; undef $tlwins{"helptext"};});
+}
+
+# read config file; personal settings override the default settings
+sub readrc {
+ my($rcfile,$icall)=@_;
+ my ($var,$val);
+ my $pathflag=0;
+ my $pathflagl=0;
+ my $pathflagh=0;
+ my $tdcolors='';
+# for backward compatibility of converter/printer options
+ my ($dvips_opts,$pdfps_opts,$print_opts);
+# read defaults resp. local/personal settings
+ CALL: {
+ ($icall == 1) && do {
+ open (RC,"$rcfile") ||
+ &fatalmsg("Couldn't open system-wide default config file ${TeXDocRcDefaults}.\n");
+ last CALL;
+ };
+ ($icall == 2) && do {
+ open (RC,"$rcfile") ||
+ &fatalmsg("Couldn't open personal config file ~/.texdocrc.\n");
+ last CALL;
+ };
+ };
+ while ($line = <RC>) {
+ next if ($line =~ /^($|#)/);
+ chomp $line;
+ ($var,$val)=split("=",$line,2);
+ RCVARS: {
+ ($var =~ /texdocpath/i) && do { # TEXDOCPATH
+ if (length $val > 0) {
+ $pathflag=1;
+ eval(join("",("\$",lc($var),"=\$val")));
+ }
+ last RCVARS;
+ };
+ ($var =~ /localdocpath/i) && do { # LOCALDOCPATH
+ if (length $val > 0) {
+ $pathflagl=1;
+ eval(join("",("\$",lc($var),"=\$val")));
+ }
+ last RCVARS;
+ };
+ ($var =~ /homedocpath/i) && do { # HOMEDOCPATH
+ if ($icall == 2 && length $val > 0) { # set only in ~/.texdocrc
+ $pathflagh=1;
+ eval(join("",("\$",lc($var),"=\$val")));
+ }
+ last RCVARS;
+ };
+ # other variables
+ eval(join("",("\$",lc($var),"=\$val")));
+ };
+ }
+ close(RC);
+# find texmf/doc, and possibly other distribution texmf trees
+ if ($rcfile eq $sysrc || $pathflag == 1) {
+ $texmfmain=`kpsewhich --expand-path=${qq}\$TEXMFMAIN${qq}`;
+ chomp $texmfmain;
+ $texdocpath="$texmfmain/$texdocpath";
+ $texmfdist=`kpsewhich --expand-path=${qq}\$TEXMFDIST${qq}`;
+ chomp $texmfdist;
+ $distdocpath=join('/',"$texmfdist",basename($texdocpath,""))
+ if (length $texmfdist);
+ # TeXLive has this texmf-doc
+ $texmfdoc=join('/',"$texmfmain-doc",basename($texdocpath,""));
+ if (-e $texmfdoc) {
+ chomp $texmfdoc;
+ $docdocpath="$texmfdoc/$docdocpath";
+ }
+ }
+# find texmf-local/doc, if there is one
+ if ($rcfile eq $sysrc || $pathflagl == 1) {
+ $texmflocal=`kpsewhich --expand-path=${qq}\$TEXMFLOCAL${qq}`;
+ chomp $texmflocal;
+ if (length $texmflocal) {
+ # if LOCALDOCPATH is not explicitly defined, it equals TEXDOCPATH
+ unless (defined $localdocpath) {
+ $localdocpath=basename($texdocpath,"");
+ }
+ $localdocpath="$texmflocal/$localdocpath";
+ }
+ }
+# find user's $HOMETEXMF/doc, if there is one
+ if ($icall == 2 || $pathflagh == 1) {
+ $texmfhome=`kpsewhich --expand-path=${qq}\$HOMETEXMF${qq}`;
+ chomp $texmfhome;
+ if (length $texmfhome) {
+ # if HOMEDOCPATH is not explicitly defined, it equals TEXDOCPATH
+ unless (defined $homedocpath) {
+ $homedocpath=basename($texdocpath,"");
+ }
+ $homedocpath="$texmfhome/$homedocpath";
+ }
+ }
+# colours: create array
+ @tdcolors=split(' ',$tdcolors);
+ if (scalar @tdcolors != 4) { # if old texdocrc file is used
+ if (!(-e $myrc) || (-e $myrc && $icall == 2)) {
+ print "NOTE: Button colours not set in $rcfile; using defaults.\n";
+ @tdcolors=('#d9d9d9','Black','#ececec','red');
+ }
+ }
+ %butcol=('-background'=>$tdcolors[0],
+ '-foreground'=>$tdcolors[1],
+ '-activebackground'=>$tdcolors[2],
+ '-activeforeground'=>$tdcolors[3]);
+# viewer: suppress viewer warnings/use $PAGER if no $txt_viewer is defined
+ $quiet=($quiet =~ /y/i || $quiet eq "1") ? 1 : 0;
+ if (!(defined $txt_viewer) && defined $ENV{PAGER}) {
+ $txt_viewer=$ENV{PAGER};
+ }
+# viewer: autostart viewer if listbox of search results contains only 1 item
+ $autoview=($autoview =~ /y/i || $autoview eq "1") ? 1 : 0;
+# viewer: use text viewer to open files with unrecognized format
+ $xfmt_viewer=($xfmt_viewer =~ /y/i || $xfmt_viewer eq "1") ? 1 : 0;
+# converter: output redirection flags for HTML/Text->PS converters
+ $htmlps_redir=($htmlps_redir =~ /(y|1)/i) ? 1 : 0;
+ $txtps_redir=($txtps_redir =~ /(y|1)/i) ? 1 : 0;
+# for backward compatibility of converter/printer options
+ $dvips_conv.=" $dvips_opts" if ($dvips_opts);
+ $pdfps_conv.=" $pdfps_opts" if ($pdfps_opts);
+ $print_cmd.=" $print_opts" if ($print_opts);
+}
+
+# determine resolution if xwininfo is available
+# slightly modified from a patch contributed by Reinhard Kotucha
+sub x_resolution {
+ my $x_res;
+ if ($IsWin32) {
+ $x_res = &GetScreenWidth;
+ }
+ else {
+ open(XINF,"xwininfo -root|") or return 1200;
+ while (<XINF>) {
+ chop;
+ if (/Width:/) { ($x_res=$_)=/Width:\s+(\d+)/; last; }
+ }
+ close(XINF);
+ }
+ return $x_res;
+}
+
+# generate a random name for temporary files
+sub randname {
+ my $namestr;
+ my @chars=("A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z","a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z");
+ my $time=time;
+ my $maxcnt=3+substr($time,-1);
+ for (my $i=0; $i<=$maxcnt; $i++) { $namestr.=$chars[rand(51)] }
+ my @tmp=split(/./,$time/$$);
+ $namestr.=$tmp[1];
+ until (length($namestr) > 16) { $namestr.=int(rand(1000000)) }
+ return $namestr;
+}
+
+# find index of an array entry
+sub arrindex {
+ my @array=@_;
+ my $item=pop @array;
+ my $i=0;
+ foreach (@array) {
+ last if ($_ eq $item);
+ ++$i;
+ }
+ return $i;
+}
+
+# clean up and exit
+sub clean_exit {
+ foreach (@tmpfiles) { if (-e $_) { unlink $_; } }
+ exit;
+}
+
+# alternative main window, launched for fatal error messages on startup
+sub fatalmsg {
+ my($msg)=@_;
+ print STDERR $msg; # also print to stderr
+# create frame for main window
+ my $main=new MainWindow;
+ $main->resizable(0,0);
+ $main->title("TeX Documentation Browser");
+ $main->bind('<Control-q>'=>sub { exit });
+ $main->bind('<Control-k>'=>sub { exit });
+ my $msgframe=$main->Frame(-background=>"#ffcc99");
+ my $cmdframe=$main->Frame;
+ $msgframe->pack(-side=>'top');
+ $cmdframe->pack(-side=>'bottom',-fill=>'x');
+# make buttons for command frame
+ my $Qbut=$cmdframe->Button(-text=>'Kill',%butcol,
+ -command=>sub { exit })->pack(-fill=>'x');
+# define common default font for labels and text explicitly
+ my @deffont=$Qbut->configure(-font);
+# ensure readability on high-res screens (suggested by R.Kotucha)
+ $deffont='Helvetica -16 bold' if &x_resolution > 1200;
+ $Qbut->configure(-font=>$deffont);
+ $msgframe->Label(-text=>'FATAL ERROR',
+ -font=>$deffont)->pack(-side=>'top', -fill=>'x');
+# get size of message text
+ my @dummy=split("\n",$msg);
+ my $nline=scalar @dummy;
+ my $msgwidth=0;
+ my $lline;
+ foreach (@dummy) {
+ $lline=length $_;
+ if ($lline > $msgwidth) { $msgwidth=$lline; }
+ }
+ my $message=$msgframe->Text(-relief=>'flat',
+ -font=>$deffont,
+ -height=>$nline,
+ -width=>$msgwidth)->pack(-side=>'top');
+ $message->insert('end',$msg);
+ $message->configure(-state=>'disabled');
+ MainLoop;
+}
+
+if ($IsWin32) {
+ sub GetScreenWidth {
+ my $GetDeviceCaps = new Win32::API('gdi32', 'GetDeviceCaps', 'NN', 'N');
+ my $HORZRES = 8; # from WinGDI.h
+ if(not defined $GetDeviceCaps) {
+ die "Can't import API GetDeviceCaps: $!\n";
+ }
+ return $GetDeviceCaps->Call(0, $HORZRES);
+ }
+
+ sub GetTempPath {
+ my $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', 'N');
+ if(not defined $GetTempPath) {
+ die "Can't import API GetTempPath: $!\n";
+ }
+ my $lpBuffer = " " x 260;
+
+ $GetTempPath->Call(80, $lpBuffer);
+ }
+
+ sub ShellExecute {
+ my ($command, $file) = @_;
+ my $ShellExecute = new Win32::API('shell32', 'ShellExecute', 'NPPPPN', 'N');
+ if(not defined $ShellExecute) {
+ die "Can't import API ShellExecute: $!\n";
+ }
+ $ShellExecute->Call(0, $command, $file, '', '', 0);
+ }
+
+ sub GetHomeDir {
+ my $home = $ENV{'HOME'};
+ # Should check for CSIDL_...
+ return $home;
+ }
+}
+__END__
+Many TeX programmers provide more or less detailed manuals for
+their programs or packages. They are usually available as .dvi,
+.ps, .pdf, .html or plain text files (sometimes included in the
+.sty files instead of a separate documentation file) and can be
+accessed with this browser, which is simply an interface to find a
+documentation more easily. It starts the respective viewer for
+reading the selected documentation making use of a database file
+which contains the path entries according to the current teTeX
+texmf/doc structure; additional usage of a system-wide local and
+of individual user texmf trees with corresponding databases is also
+possible.
+The documentations are grouped in several categories shown in the
+main window; pressing one of its buttons lists all documentations
+belonging to this topic.
+The topic window lets you select one documentation file, view or
+send it to the default printer. By right-clicking on the selected
+item you get the complete path of the file.
+The search button of the main window allows you to search the
+database for a string; it does not search file names. Enter the
+string and hit <Return> to start the search or <Control-c> to
+cancel. Just hitting <Return> without typing something in will
+show the full list of files in the database.
+Defaults for the documentation root directory, the viewers, the
+converters, certain options and the printer are set in the global
+configuration file $sysrc.
+However, each user can put a copy of it as .texdocrc into his home
+directory to modify them according to his needs; modification or
+generation of ~/.texdocrc can also be done with the Settings menu.
+Additionally, the settings can be changed temporarily with this
+menu.
+
+The following key shortcuts are defined for use with the browser:
+ <Ctrl-q> Quit browser
+ <Ctrl-m> Raise the Main window to the foreground
+ <Ctrl-s> Search a keyword in database (case insensitive)
+ <Ctrl-c> Cancel/close subwindow or search entry widget
+ <Ctrl-v> View selected document (topic windows)
+ <Ctrl-p> Print selected document (topic windows)
+ <Ctrl-t> Open settings menu
+ <Ctrl-k> Kill fatal error message window (same as
+ <Ctrl-q>)
+ <Ctrl-h> Open this help
+ <Return> Equivalent to button press;
+ OK in selection menu and search
+ <Tab> Next/previous widget
+
+There are the following command line options:
+ -a autostart viewer if a listbox of search results
+ contains only one item; can also be set in a
+ configuration file
+ -v disable suppression of viewer messages sent to
+ stderr and of certain permanent message popup
+ windows, in case this was not set in a
+ configuration file; default: off
+
+Some more information is available in the manpage of texdoctk.
+
+Comments and suggestions to:
+Thomas Ruedas
+tr@dlc.ku.dk
+# Local Variables:
+# mode: perl
+# auto-fill-hook: do-auto-fill
+# End:
diff --git a/Master/texmf/scripts/tetex/texi2html.pl b/Master/texmf/scripts/tetex/texi2html.pl
new file mode 100644
index 00000000000..067899e896d
--- /dev/null
+++ b/Master/texmf/scripts/tetex/texi2html.pl
@@ -0,0 +1,2125 @@
+#+##############################################################################
+# #
+# File: texi2html #
+# #
+# Description: Program to transform most Texinfo documents to HTML #
+# #
+#-##############################################################################
+
+# From @(#)texi2html 1.52 01/05/98 Written (mainly) by Lionel Cons, Lionel.Cons@cern.ch
+# $Id: texi2html,v 1.5 1999/02/20 20:27:00 karl Exp $
+# This version of texi2html is currently maintained at
+# ftp://ftp.cs.umb.edu/pub/tex/texi2html by kb@cs.umb.edu.
+
+# The man page for this program is included at the end of this file and can be
+# viewed using the command 'nroff -man texi2html'.
+# Please read the copyright at the end of the man page.
+
+#+++############################################################################
+# #
+# Constants #
+# #
+#---############################################################################
+
+$DEBUG_TOC = 1;
+$DEBUG_INDEX = 2;
+$DEBUG_BIB = 4;
+$DEBUG_GLOSS = 8;
+$DEBUG_DEF = 16;
+$DEBUG_HTML = 32;
+$DEBUG_USER = 64;
+
+$BIBRE = '\[[\w\/-]+\]'; # RE for a bibliography reference
+$FILERE = '[\/\w.+-]+'; # RE for a file name
+$VARRE = '[^\s\{\}]+'; # RE for a variable name
+$NODERE = '[^@{}:\'`",]+'; # RE for a node name
+$NODESRE = '[^@{}:\'`"]+'; # RE for a list of node names
+$XREFRE = '[^@{}]+'; # RE for a xref (should use NODERE)
+
+$ERROR = "***"; # prefix for errors and warnings
+$THISVERSION = "1.56k";
+$THISPROG = "texi2html $THISVERSION"; # program name and version
+$HOMEPAGE = "http://wwwinfo.cern.ch/dis/texi2html/"; # program home page
+$TODAY = &pretty_date; # like "20 September 1993"
+$SPLITTAG = "<!-- SPLIT HERE -->\n"; # tag to know where to split
+$PROTECTTAG = "_ThisIsProtected_"; # tag to recognize protected sections
+$html2_doctype = '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0 Strict Level 2//EN">';
+
+#
+# language dependent constants
+#
+#$LDC_SEE = 'see';
+#$LDC_SECTION = 'section';
+#$LDC_IN = 'in';
+#$LDC_TOC = 'Table of Contents';
+#$LDC_GOTO = 'Go to the';
+#$LDC_FOOT = 'Footnotes';
+# TODO: @def* shortcuts
+
+#
+# pre-defined indices
+#
+%predefined_index = (
+ 'cp', 'c',
+ 'fn', 'f',
+ 'vr', 'v',
+ 'ky', 'k',
+ 'pg', 'p',
+ 'tp', 't',
+ );
+
+#
+# valid indices
+#
+%valid_index = (
+ 'c', 1,
+ 'f', 1,
+ 'v', 1,
+ 'k', 1,
+ 'p', 1,
+ 't', 1,
+ );
+
+#
+# texinfo section names to level
+#
+%sec2level = (
+ 'top', 0,
+ 'chapter', 1,
+ 'unnumbered', 1,
+ 'majorheading', 1,
+ 'chapheading', 1,
+ 'appendix', 1,
+ 'section', 2,
+ 'unnumberedsec', 2,
+ 'heading', 2,
+ 'appendixsec', 2,
+ 'appendixsection', 2,
+ 'subsection', 3,
+ 'unnumberedsubsec', 3,
+ 'subheading', 3,
+ 'appendixsubsec', 3,
+ 'subsubsection', 4,
+ 'unnumberedsubsubsec', 4,
+ 'subsubheading', 4,
+ 'appendixsubsubsec', 4,
+ );
+
+#
+# accent map, TeX command to ISO name
+#
+%accent_map = (
+ '"', 'uml',
+ '~', 'tilde',
+ '^', 'circ',
+ '`', 'grave',
+ '\'', 'acute',
+ );
+
+#
+# texinfo "simple things" (@foo) to HTML ones
+#
+%simple_map = (
+ # cf. makeinfo.c
+ "*", "<BR>", # HTML+
+ " ", " ",
+ "\t", " ",
+ "-", "&#173;", # soft hyphen
+ "\n", "\n",
+ "|", "",
+ 'tab', '<\/TD><TD>',
+ # spacing commands
+ ":", "",
+ "!", "!",
+ "?", "?",
+ ".", ".",
+ "-", "",
+ );
+
+#
+# texinfo "things" (@foo{}) to HTML ones
+#
+%things_map = (
+ 'TeX', 'TeX',
+ 'br', '<P>', # paragraph break
+ 'bullet', '*',
+ 'copyright', '(C)',
+ 'dots', '...',
+ 'equiv', '==',
+ 'error', 'error-->',
+ 'expansion', '==>',
+ 'minus', '-',
+ 'point', '-!-',
+ 'print', '-|',
+ 'result', '=>',
+ 'today', $TODAY,
+ );
+
+#
+# texinfo styles (@foo{bar}) to HTML ones
+#
+%style_map = (
+ 'asis', '',
+ 'b', 'B',
+ 'cite', 'CITE',
+ 'code', 'CODE',
+ 'ctrl', '&do_ctrl', # special case
+ 'dfn', 'EM', # DFN tag is illegal in the standard
+ 'dmn', '', # useless
+ 'email', '&do_email', # insert a clickable email address
+ 'emph', 'EM',
+ 'file', '"TT', # will put quotes, cf. &apply_style
+ 'i', 'I',
+ 'kbd', 'KBD',
+ 'key', 'KBD',
+ 'math', 'EM',
+ 'r', '', # unsupported
+ 'samp', '"SAMP', # will put quotes, cf. &apply_style
+ 'sc', '&do_sc', # special case
+ 'strong', 'STRONG',
+ 't', 'TT',
+ 'titlefont', '', # useless
+ 'uref', '&do_uref', # insert a clickable URL
+ 'url', '&do_url', # insert a clickable URL
+ 'var', 'VAR',
+ 'w', '', # unsupported
+ );
+
+#
+# texinfo format (@foo/@end foo) to HTML ones
+#
+%format_map = (
+ 'display', 'PRE',
+ 'example', 'PRE',
+ 'format', 'PRE',
+ 'lisp', 'PRE',
+ 'quotation', 'BLOCKQUOTE',
+ 'smallexample', 'PRE',
+ 'smalllisp', 'PRE',
+ # lists
+ 'itemize', 'UL',
+ 'enumerate', 'OL',
+ # poorly supported
+ 'flushleft', 'PRE',
+ 'flushright', 'PRE',
+ );
+
+#
+# texinfo definition shortcuts to real ones
+#
+%def_map = (
+ # basic commands
+ 'deffn', 0,
+ 'defvr', 0,
+ 'deftypefn', 0,
+ 'deftypevr', 0,
+ 'defcv', 0,
+ 'defop', 0,
+ 'deftp', 0,
+ # basic x commands
+ 'deffnx', 0,
+ 'defvrx', 0,
+ 'deftypefnx', 0,
+ 'deftypevrx', 0,
+ 'defcvx', 0,
+ 'defopx', 0,
+ 'deftpx', 0,
+ # shortcuts
+ 'defun', 'deffn Function',
+ 'defmac', 'deffn Macro',
+ 'defspec', 'deffn {Special Form}',
+ 'defvar', 'defvr Variable',
+ 'defopt', 'defvr {User Option}',
+ 'deftypefun', 'deftypefn Function',
+ 'deftypevar', 'deftypevr Variable',
+ 'defivar', 'defcv {Instance Variable}',
+ 'defmethod', 'defop Method',
+ # x shortcuts
+ 'defunx', 'deffnx Function',
+ 'defmacx', 'deffnx Macro',
+ 'defspecx', 'deffnx {Special Form}',
+ 'defvarx', 'defvrx Variable',
+ 'defoptx', 'defvrx {User Option}',
+ 'deftypefunx', 'deftypefnx Function',
+ 'deftypevarx', 'deftypevrx Variable',
+ 'defivarx', 'defcvx {Instance Variable}',
+ 'defmethodx', 'defopx Method',
+ );
+
+#
+# things to skip
+#
+%to_skip = (
+ # comments
+ 'c', 1,
+ 'comment', 1,
+ 'ifnothtml', 1,
+ # useless
+ 'detailmenu', 1,
+ 'direntry', 1,
+ 'contents', 1,
+ 'shortcontents', 1,
+ 'summarycontents', 1,
+ 'footnotestyle', 1,
+ 'end ifclear', 1,
+ 'end ifset', 1,
+ 'titlepage', 1,
+ 'end titlepage', 1,
+ # unsupported commands (formatting)
+ 'afourpaper', 1,
+ 'cropmarks', 1,
+ 'finalout', 1,
+ 'headings', 1,
+ 'sp', 1,
+ 'need', 1,
+ 'page', 1,
+ 'setchapternewpage', 1,
+ 'everyheading', 1,
+ 'everyfooting', 1,
+ 'evenheading', 1,
+ 'evenfooting', 1,
+ 'oddheading', 1,
+ 'oddfooting', 1,
+ 'smallbook', 1,
+ 'vskip', 1,
+ 'filbreak', 1,
+ 'paragraphindent', 1,
+ # unsupported formats
+ 'cartouche', 1,
+ 'end cartouche', 1,
+ 'group', 1,
+ 'end group', 1,
+ );
+
+#+++############################################################################
+# #
+# Argument parsing, initialisation #
+# #
+#---############################################################################
+
+%value = (); # hold texinfo variables, see also -D
+
+$use_bibliography = 1;
+$use_acc = 0;
+$debug = 0;
+$doctype = '';
+$check = 0;
+$expandinfo = 0;
+$use_glossary = 0;
+$invisible_mark = '';
+$use_iso = 0;
+@include_dirs = ();
+$show_menu = 0;
+$number_sections = 0;
+$split_node = 0;
+$split_chapter = 0;
+$monolithic = 0;
+$verbose = 0;
+$usage = <<EOT;
+This is $THISPROG
+To convert a Texinfo file to HMTL: $0 [options] file
+ where options can be:
+ -expandinfo : use \@ifinfo sections, not \@iftex
+ -glossary : handle a glossary
+ -invisible name: use 'name' as an invisible anchor
+ -Dname : define name like with \@set
+ -I dir : search also for files in 'dir'
+ -menu : handle menus
+ -monolithic : output only one file including ToC
+ -number : number sections
+ -split_chapter : split on main sections
+ -split_node : split on nodes
+ -usage : print usage instructions
+ -verbose : verbose output
+To check converted files: $0 -check [-verbose] files
+EOT
+
+while (@ARGV && $ARGV[0] =~ /^-/) {
+ $_ = shift(@ARGV);
+ if (/^-acc$/) { $use_acc = 1; next; }
+ if (/^-d(ebug)?(\d+)?$/) { $debug = $2 || shift(@ARGV); next; }
+ if (/^-doctype$/) { $doctype = shift(@ARGV); next; }
+ if (/^-c(heck)?$/) { $check = 1; next; }
+ if (/^-e(xpandinfo)?$/) { $expandinfo = 1; next; }
+ if (/^-g(lossary)?$/) { $use_glossary = 1; next; }
+ if (/^-i(nvisible)?$/) { $invisible_mark = shift(@ARGV); next; }
+ if (/^-iso$/) { $use_iso = 1; next; }
+ if (/^-D(.+)?$/) { $value{$1 || shift(@ARGV)} = 1; next; }
+ if (/^-I(.+)?$/) { push(@include_dirs, $1 || shift(@ARGV)); next; }
+ if (/^-m(enu)?$/) { $show_menu = 1; next; }
+ if (/^-mono(lithic)?$/) { $monolithic = 1; next; }
+ if (/^-n(umber)?$/) { $number_sections = 1; next; }
+ if (/^-s(plit)?_?(n(ode)?|c(hapter)?)?$/) {
+ if ($2 =~ /^n/) {
+ $split_node = 1;
+ } else {
+ $split_chapter = 1;
+ }
+ next;
+ }
+ if (/^-v(erbose)?$/) { $verbose = 1; next; }
+ die $usage;
+}
+if ($check) {
+ die $usage unless @ARGV > 0;
+ &check;
+ exit;
+}
+
+if (($split_node || $split_chapter) && $monolithic) {
+ warn "Can't use -monolithic with -split, -monolithic ignored.\n";
+ $monolithic = 0;
+}
+if ($expandinfo) {
+ $to_skip{'ifinfo'}++;
+ $to_skip{'end ifinfo'}++;
+ $to_skip{'ifnottex'}++;
+ $to_skip{'end ifnottex'}++;
+} else {
+ $to_skip{'iftex'}++;
+ $to_skip{'end iftex'}++;
+}
+$invisible_mark = '<IMG SRC="invisible.xbm">' if $invisible_mark eq 'xbm';
+die $usage unless @ARGV == 1;
+$docu = shift(@ARGV);
+if ($docu =~ /.*\//) {
+ chop($docu_dir = $&);
+ $docu_name = $';
+} else {
+ $docu_dir = '.';
+ $docu_name = $docu;
+}
+unshift(@include_dirs, $docu_dir);
+$docu_name =~ s/\.te?x(i|info)?$//; # basename of the document
+
+$docu_doc = "$docu_name.html"; # document's contents
+if ($monolithic) {
+ $docu_toc = $docu_foot = $docu_doc;
+} else {
+ $docu_toc = "${docu_name}_toc.html"; # document's table of contents
+ $docu_foot = "${docu_name}_foot.html"; # document's footnotes
+}
+
+#
+# variables
+#
+$value{'html'} = 1; # predefine html (the output format)
+$value{'texi2html'} = $THISVERSION; # predefine texi2html (the translator)
+# _foo: internal to track @foo
+foreach ('_author', '_title', '_subtitle',
+ '_settitle', '_setfilename') {
+ $value{$_} = ''; # prevent -w warnings
+}
+%node2sec = (); # node to section name
+%node2href = (); # node to HREF
+%bib2href = (); # bibliography reference to HREF
+%gloss2href = (); # glossary term to HREF
+@sections = (); # list of sections
+%tag2pro = (); # protected sections
+
+#
+# initial indexes
+#
+$bib_num = 0;
+$foot_num = 0;
+$gloss_num = 0;
+$idx_num = 0;
+$sec_num = 0;
+$doc_num = 0;
+$html_num = 0;
+
+#
+# can I use ISO8879 characters? (HTML+)
+#
+if ($use_iso) {
+ $things_map{'bullet'} = "&bull;";
+ $things_map{'copyright'} = "&copy;";
+ $things_map{'dots'} = "&hellip;";
+ $things_map{'equiv'} = "&equiv;";
+ $things_map{'expansion'} = "&rarr;";
+ $things_map{'point'} = "&lowast;";
+ $things_map{'result'} = "&rArr;";
+}
+
+#
+# read texi2html extensions (if any)
+#
+$extensions = 'texi2html.ext'; # extensions in working directory
+if (-f $extensions) {
+ print "# reading extensions from $extensions\n" if $verbose;
+ require($extensions);
+}
+($progdir = $0) =~ s/[^\/]+$//;
+if ($progdir && ($progdir ne './')) {
+ $extensions = "${progdir}texi2html.ext"; # extensions in texi2html directory
+ if (-f $extensions) {
+ print "# reading extensions from $extensions\n" if $verbose;
+ require($extensions);
+ }
+}
+
+print "# reading from $docu\n" if $verbose;
+
+#+++############################################################################
+# #
+# Pass 1: read source, handle command, variable, simple substitution #
+# #
+#---############################################################################
+
+@lines = (); # whole document
+@toc_lines = (); # table of contents
+$toplevel = 0; # top level seen in hierarchy
+$curlevel = 0; # current level in TOC
+$node = ''; # current node name
+$in_table = 0; # am I inside a table
+$table_type = ''; # type of table ('', 'f', 'v', 'multi')
+@tables = (); # nested table support
+$in_bibliography = 0; # am I inside a bibliography
+$in_glossary = 0; # am I inside a glossary
+$in_top = 0; # am I inside the top node
+$in_pre = 0; # am I inside a preformatted section
+$in_list = 0; # am I inside a list
+$in_html = 0; # am I inside an HTML section
+$first_line = 1; # is it the first line
+$dont_html = 0; # don't protect HTML on this line
+$split_num = 0; # split index
+$deferred_ref = ''; # deferred reference for indexes
+@html_stack = (); # HTML elements stack
+$html_element = ''; # current HTML element
+&html_reset;
+
+# build code for simple substitutions
+# the maps used (%simple_map and %things_map) MUST be aware of this
+# watch out for regexps, / and escaped characters!
+$subst_code = '';
+foreach (keys(%simple_map)) {
+ ($re = $_) =~ s/(\W)/\\$1/g; # protect regexp chars
+ $subst_code .= "s/\\\@$re/$simple_map{$_}/g;\n";
+}
+foreach (keys(%things_map)) {
+ $subst_code .= "s/\\\@$_\\{\\}/$things_map{$_}/g;\n";
+}
+if ($use_acc) {
+ # accentuated characters
+ foreach (keys(%accent_map)) {
+ if ($_ eq "`") {
+ $subst_code .= "s/$;3";
+ } elsif ($_ eq "'") {
+ $subst_code .= "s/$;4";
+ } else {
+ $subst_code .= "s/\\\@\\$_";
+ }
+ $subst_code .= "([aeiou])/&\${1}$accent_map{$_};/gi;\n";
+ }
+}
+eval("sub simple_substitutions { $subst_code }");
+
+&init_input;
+while ($_ = &next_line) {
+ #
+ # remove \input on the first lines only
+ #
+ if ($first_line) {
+ next if /^\\input/;
+ $first_line = 0;
+ }
+ #
+ # parse texinfo tags
+ #
+ $tag = '';
+ $end_tag = '';
+ if (/^\s*\@end\s+(\w+)\b/) {
+ $end_tag = $1;
+ } elsif (/^\s*\@(\w+)\b/) {
+ $tag = $1;
+ }
+ #
+ # handle @ifhtml / @end ifhtml
+ #
+ if ($in_html) {
+ if ($end_tag eq 'ifhtml') {
+ $in_html = 0;
+ } else {
+ $tag2pro{$in_html} .= $_;
+ }
+ next;
+ } elsif ($tag eq 'ifhtml') {
+ $in_html = $PROTECTTAG . ++$html_num;
+ push(@lines, $in_html);
+ next;
+ }
+ #
+ # try to skip the line
+ #
+ if ($end_tag) {
+ next if $to_skip{"end $end_tag"};
+ } elsif ($tag) {
+ next if $to_skip{$tag};
+ last if $tag eq 'bye';
+ }
+ if ($in_top) {
+ # parsing the top node
+ if ($tag eq 'node' || $tag eq 'include' || $sec2level{$tag}) {
+ # no more in top
+ $in_top = 0;
+ } else {
+ # skip it
+ next;
+ }
+ }
+ #
+ # try to remove inlined comments
+ # syntax from tex-mode.el comment-start-skip
+ #
+ s/((^|[^\@])(\@\@)*)\@c(omment)? .*/$1/;
+ # non-@ substitutions cf. texinfmt.el
+ unless ($in_pre) {
+ s/``/\"/g;
+ s/''/\"/g;
+ s/([\w ])---([\w ])/$1--$2/g;
+ }
+ #
+ # analyze the tag
+ #
+ if ($tag) {
+ # skip lines
+ &skip_until($tag), next if $tag eq 'ignore';
+ if ($expandinfo) {
+ &skip_until($tag), next if $tag eq 'iftex';
+ } else {
+ &skip_until($tag), next if $tag eq 'ifinfo';
+ }
+ &skip_until($tag), next if $tag eq 'tex';
+ # handle special tables
+ if ($tag =~ /^(|f|v|multi)table$/) {
+ $table_type = $1;
+ $tag = 'table';
+ }
+ # special cases
+ if ($tag eq 'top' || ($tag eq 'node' && /^\@node\s+top\s*,/i)) {
+ $in_top = 1;
+ @lines = (); # ignore all lines before top (title page garbage)
+ next;
+ } elsif ($tag eq 'node') {
+ $in_top = 0;
+ warn "$ERROR Bad node line: $_" unless $_ =~ /^\@node\s$NODESRE$/o;
+ $_ = &protect_html($_); # if node contains '&' for instance
+ s/^\@node\s+//;
+ ($node) = split(/,/);
+ &normalise_node($node);
+ if ($split_node) {
+ &next_doc;
+ push(@lines, $SPLITTAG) if $split_num++;
+ push(@sections, $node);
+ }
+ next;
+ } elsif ($tag eq 'include') {
+ if (/^\@include\s+($FILERE)\s*$/o) {
+ $file = $1;
+ unless (-e $file) {
+ foreach $dir (@include_dirs) {
+ $file = "$dir/$1";
+ last if -e $file;
+ }
+ }
+ if (-e $file) {
+ &open($file);
+ print "# including $file\n" if $verbose;
+ } else {
+ warn "$ERROR Can't find $file, skipping";
+ }
+ } else {
+ warn "$ERROR Bad include line: $_";
+ }
+ next;
+ } elsif ($tag eq 'ifclear') {
+ if (/^\@ifclear\s+($VARRE)\s*$/o) {
+ next unless defined($value{$1});
+ &skip_until($tag);
+ } else {
+ warn "$ERROR Bad ifclear line: $_";
+ }
+ next;
+ } elsif ($tag eq 'ifset') {
+ if (/^\@ifset\s+($VARRE)\s*$/o) {
+ next if defined($value{$1});
+ &skip_until($tag);
+ } else {
+ warn "$ERROR Bad ifset line: $_";
+ }
+ next;
+ } elsif ($tag eq 'menu') {
+ unless ($show_menu) {
+ &skip_until($tag);
+ next;
+ }
+ &html_push_if($tag);
+ push(@lines, &html_debug("\n", __LINE__));
+ } elsif ($format_map{$tag}) {
+ $in_pre = 1 if $format_map{$tag} eq 'PRE';
+ &html_push_if($format_map{$tag});
+ push(@lines, &html_debug("\n", __LINE__));
+ $in_list++ if $format_map{$tag} eq 'UL' || $format_map{$tag} eq 'OL' ;
+ push(@lines, &debug("<$format_map{$tag}>\n", __LINE__));
+ next;
+ } elsif ($tag eq 'table') {
+ if (/^\s*\@(|f|v|multi)table\s+\@(\w+)/) {
+ $in_table = $2;
+ unshift(@tables, join($;, $table_type, $in_table));
+ if ($table_type eq "multi") {
+ push(@lines, &debug("<TABLE BORDER>\n", __LINE__));
+ &html_push_if('TABLE');
+ } else {
+ push(@lines, &debug("<DL COMPACT>\n", __LINE__));
+ &html_push_if('DL');
+ }
+ push(@lines, &html_debug("\n", __LINE__));
+ } else {
+ warn "$ERROR Bad table line: $_";
+ }
+ next;
+ } elsif ($tag eq 'synindex' || $tag eq 'syncodeindex') {
+ if (/^\@$tag\s+(\w)\w\s+(\w)\w\s*$/) {
+ eval("*${1}index = *${2}index");
+ } else {
+ warn "$ERROR Bad syn*index line: $_";
+ }
+ next;
+ } elsif ($tag eq 'sp') {
+ push(@lines, &debug("<P>\n", __LINE__));
+ next;
+ } elsif ($tag eq 'setref') {
+ &protect_html; # if setref contains '&' for instance
+ if (/^\@$tag\s*{($NODERE)}\s*$/) {
+ $setref = $1;
+ $setref =~ s/\s+/ /g; # normalize
+ $setref =~ s/ $//;
+ $node2sec{$setref} = $name;
+ $node2href{$setref} = "$docu_doc#$docid";
+ } else {
+ warn "$ERROR Bad setref line: $_";
+ }
+ next;
+ } elsif ($tag eq 'defindex' || $tag eq 'defcodeindex') {
+ if (/^\@$tag\s+(\w\w)\s*$/) {
+ $valid_index{$1} = 1;
+ } else {
+ warn "$ERROR Bad defindex line: $_";
+ }
+ next;
+ } elsif ($tag eq 'lowersections') {
+ local ($sec, $level);
+ while (($sec, $level) = each %sec2level) {
+ $sec2level{$sec} = $level + 1;
+ }
+ next;
+ } elsif ($tag eq 'raisesections') {
+ local ($sec, $level);
+ while (($sec, $level) = each %sec2level) {
+ $sec2level{$sec} = $level - 1;
+ }
+ next;
+ } elsif (defined($def_map{$tag})) {
+ if ($def_map{$tag}) {
+ s/^\@$tag\s+//;
+ $tag = $def_map{$tag};
+ $_ = "\@$tag $_";
+ $tag =~ s/\s.*//;
+ }
+ } elsif (defined($user_sub{$tag})) {
+ s/^\@$tag\s+//;
+ $sub = $user_sub{$tag};
+ print "# user $tag = $sub, arg: $_" if $debug & $DEBUG_USER;
+ if (defined(&$sub)) {
+ chop($_);
+ &$sub($_);
+ } else {
+ warn "$ERROR Bad user sub for $tag: $sub\n";
+ }
+ next;
+ }
+ if (defined($def_map{$tag})) {
+ s/^\@$tag\s+//;
+ if ($tag =~ /x$/) {
+ # extra definition line
+ $tag = $`;
+ $is_extra = 1;
+ } else {
+ $is_extra = 0;
+ }
+ while (/\{([^\{\}]*)\}/) {
+ # this is a {} construct
+ ($before, $contents, $after) = ($`, $1, $');
+ # protect spaces
+ $contents =~ s/\s+/$;9/g;
+ # restore $_ protecting {}
+ $_ = "$before$;7$contents$;8$after";
+ }
+ @args = split(/\s+/, &protect_html($_));
+ foreach (@args) {
+ s/$;9/ /g; # unprotect spaces
+ s/$;7/\{/g; # ... {
+ s/$;8/\}/g; # ... }
+ }
+ $type = shift(@args);
+ $type =~ s/^\{(.*)\}$/$1/;
+ print "# def ($tag): {$type} ", join(', ', @args), "\n"
+ if $debug & $DEBUG_DEF;
+ $type .= ':'; # it's nicer like this
+ $name = shift(@args);
+ $name =~ s/^\{(.*)\}$/$1/;
+ if ($is_extra) {
+ $_ = &debug("<DT>", __LINE__);
+ } else {
+ $_ = &debug("<DL>\n<DT>", __LINE__);
+ }
+ if ($tag eq 'deffn' || $tag eq 'defvr' || $tag eq 'deftp') {
+ $_ .= "<U>$type</U> <B>$name</B>";
+ $_ .= " <I>@args</I>" if @args;
+ } elsif ($tag eq 'deftypefn' || $tag eq 'deftypevr'
+ || $tag eq 'defcv' || $tag eq 'defop') {
+ $ftype = $name;
+ $name = shift(@args);
+ $name =~ s/^\{(.*)\}$/$1/;
+ $_ .= "<U>$type</U> $ftype <B>$name</B>";
+ $_ .= " <I>@args</I>" if @args;
+ } else {
+ warn "$ERROR Unknown definition type: $tag\n";
+ $_ .= "<U>$type</U> <B>$name</B>";
+ $_ .= " <I>@args</I>" if @args;
+ }
+ $_ .= &debug("\n<DD>", __LINE__);
+ $name = &unprotect_html($name);
+ if ($tag eq 'deffn' || $tag eq 'deftypefn') {
+ unshift(@input_spool, "\@findex $name\n");
+ } elsif ($tag eq 'defop') {
+ unshift(@input_spool, "\@findex $name on $ftype\n");
+ } elsif ($tag eq 'defvr' || $tag eq 'deftypevr' || $tag eq 'defcv') {
+ unshift(@input_spool, "\@vindex $name\n");
+ } else {
+ unshift(@input_spool, "\@tindex $name\n");
+ }
+ $dont_html = 1;
+ }
+ } elsif ($end_tag) {
+ if ($format_map{$end_tag}) {
+ $in_pre = 0 if $format_map{$end_tag} eq 'PRE';
+ $in_list-- if $format_map{$end_tag} eq 'UL' || $format_map{$end_tag} eq 'OL' ;
+ &html_pop_if('LI', 'P');
+ &html_pop_if();
+ push(@lines, &debug("</$format_map{$end_tag}>\n", __LINE__));
+ push(@lines, &html_debug("\n", __LINE__));
+ } elsif ($end_tag =~ /^(|f|v|multi)table$/) {
+ unless (@tables) {
+ warn "$ERROR \@end $end_tag without \@*table\n";
+ next;
+ }
+ ($table_type, $in_table) = split($;, shift(@tables));
+ unless ($1 eq $table_type) {
+ warn "$ERROR \@end $end_tag without matching \@$end_tag\n";
+ next;
+ }
+ if ($table_type eq "multi") {
+ push(@lines, "</TR></TABLE>\n");
+ &html_pop_if('TR');
+ } else {
+ push(@lines, "</DL>\n");
+ &html_pop_if('DD');
+ }
+ &html_pop_if();
+ if (@tables) {
+ ($table_type, $in_table) = split($;, $tables[0]);
+ } else {
+ $in_table = 0;
+ }
+ } elsif (defined($def_map{$end_tag})) {
+ push(@lines, &debug("</DL>\n", __LINE__));
+ } elsif ($end_tag eq 'menu') {
+ &html_pop_if();
+ push(@lines, $_); # must keep it for pass 2
+ }
+ next;
+ }
+ #
+ # misc things
+ #
+ # protect texi and HTML things
+ &protect_texi;
+ $_ = &protect_html($_) unless $dont_html;
+ $dont_html = 0;
+ # substitution (unsupported things)
+ s/^\@center\s+//g;
+ s/^\@exdent\s+//g;
+ s/\@noindent\s+//g;
+ s/\@refill\s+//g;
+ # other substitutions
+ &simple_substitutions;
+ s/\@value{($VARRE)}/$value{$1}/eg;
+ s/\@footnote\{/\@footnote$docu_doc\{/g; # mark footnotes, cf. pass 4
+ #
+ # analyze the tag again
+ #
+ if ($tag) {
+ if (defined($sec2level{$tag}) && $sec2level{$tag} > 0) {
+ if (/^\@$tag\s+(.+)$/) {
+ $name = $1;
+ $name =~ s/\s+$//;
+ $level = $sec2level{$tag};
+ $name = &update_sec_num($tag, $level) . " $name"
+ if $number_sections && $tag !~ /^unnumbered/;
+ if ($tag =~ /heading$/) {
+ push(@lines, &html_debug("\n", __LINE__));
+ if ($html_element ne 'body') {
+ # We are in a nice pickle here. We are trying to get a H? heading
+ # even though we are not in the body level. So, we convert it to a
+ # nice, bold, line by itself.
+ $_ = &debug("\n\n<P><STRONG>$name</STRONG>\n\n", __LINE__);
+ } else {
+ $_ = &debug("<H$level>$name</H$level>\n", __LINE__);
+ &html_push_if('body');
+ }
+ print "# heading, section $name, level $level\n"
+ if $debug & $DEBUG_TOC;
+ } else {
+ if ($split_chapter) {
+ unless ($toplevel) {
+ # first time we see a "section"
+ unless ($level == 1) {
+ warn "$ERROR The first section found is not of level 1: $_";
+ warn "$ERROR I'll split on sections of level $level...\n";
+ }
+ $toplevel = $level;
+ }
+ if ($level == $toplevel) {
+ &next_doc;
+ push(@lines, $SPLITTAG) if $split_num++;
+ push(@sections, $name);
+ }
+ }
+ $sec_num++;
+ $docid = "SEC$sec_num";
+ $tocid = "TOC$sec_num";
+ # check biblio and glossary
+ $in_bibliography = ($name =~ /^([A-Z]|\d+)?(\.\d+)*\s*bibliography$/i);
+ $in_glossary = ($name =~ /^([A-Z]|\d+)?(\.\d+)*\s*glossary$/i);
+ # check node
+ if ($node) {
+ if ($node2sec{$node}) {
+ warn "$ERROR Duplicate node found: $node\n";
+ } else {
+ $node2sec{$node} = $name;
+ $node2href{$node} = "$docu_doc#$docid";
+ print "# node $node, section $name, level $level\n"
+ if $debug & $DEBUG_TOC;
+ }
+ $node = '';
+ } else {
+ print "# no node, section $name, level $level\n"
+ if $debug & $DEBUG_TOC;
+ }
+ # update TOC
+ while ($level > $curlevel) {
+ $curlevel++;
+ push(@toc_lines, "<UL>\n");
+ }
+ while ($level < $curlevel) {
+ $curlevel--;
+ push(@toc_lines, "</UL>\n");
+ }
+ $_ = "<LI>" . &anchor($tocid, "$docu_doc#$docid", $name, 1);
+ push(@toc_lines, &substitute_style($_));
+ # update DOC
+ push(@lines, &html_debug("\n", __LINE__));
+ &html_reset;
+ $_ = "<H$level>".&anchor($docid, "$docu_toc#$tocid", $name)."</H$level>\n";
+ $_ = &debug($_, __LINE__);
+ push(@lines, &html_debug("\n", __LINE__));
+ }
+ # update DOC
+ foreach $line (split(/\n+/, $_)) {
+ push(@lines, "$line\n");
+ }
+ next;
+ } else {
+ warn "$ERROR Bad section line: $_";
+ }
+ } else {
+ # track variables
+ $value{$1} = $2, next if /^\@set\s+($VARRE)\s+(.*)$/o;
+ delete $value{$1}, next if /^\@clear\s+($VARRE)\s*$/o;
+ # store things
+ $value{'_setfilename'} = $1, next if /^\@setfilename\s+(.*)$/;
+ $value{'_settitle'} = $1, next if /^\@settitle\s+(.*)$/;
+ $value{'_author'} .= "$1\n", next if /^\@author\s+(.*)$/;
+ $value{'_subtitle'} .= "$1\n", next if /^\@subtitle\s+(.*)$/;
+ $value{'_title'} .= "$1\n", next if /^\@title\s+(.*)$/;
+ # index
+ if (/^\@(..?)index\s+/) {
+ unless ($valid_index{$1}) {
+ warn "$ERROR Undefined index command: $_";
+ next;
+ }
+ $id = 'IDX' . ++$idx_num;
+ $index = $1 . 'index';
+ $what = &substitute_style($');
+ $what =~ s/\s+$//;
+ print "# found $index for '$what' id $id\n"
+ if $debug & $DEBUG_INDEX;
+ eval(<<EOC);
+ if (defined(\$$index\{\$what\})) {
+ \$$index\{\$what\} .= "$;$docu_doc#$id";
+ } else {
+ \$$index\{\$what\} = "$docu_doc#$id";
+ }
+EOC
+ #
+ # dirty hack to see if I can put an invisible anchor...
+ #
+ if ($html_element eq 'P' ||
+ $html_element eq 'LI' ||
+ $html_element eq 'DT' ||
+ $html_element eq 'DD' ||
+ $html_element eq 'ADDRESS' ||
+ $html_element eq 'B' ||
+ $html_element eq 'BLOCKQUOTE' ||
+ $html_element eq 'PRE' ||
+ $html_element eq 'SAMP') {
+ push(@lines, &anchor($id, '', $invisible_mark, !$in_pre));
+ } elsif ($html_element eq 'body') {
+ push(@lines, &debug("<P>\n", __LINE__));
+ push(@lines, &anchor($id, '', $invisible_mark, !$in_pre));
+ &html_push('P');
+ } elsif ($html_element eq 'DL' ||
+ $html_element eq 'UL' ||
+ $html_element eq 'OL' ) {
+ $deferred_ref .= &anchor($id, '', $invisible_mark, !$in_pre) . " ";
+ }
+ next;
+ }
+ # list item
+ if (/^\s*\@itemx?\s+/) {
+ $what = $';
+ $what =~ s/\s+$//;
+ if ($in_bibliography && $use_bibliography) {
+ if ($what =~ /^$BIBRE$/o) {
+ $id = 'BIB' . ++$bib_num;
+ $bib2href{$what} = "$docu_doc#$id";
+ print "# found bibliography for '$what' id $id\n"
+ if $debug & $DEBUG_BIB;
+ $what = &anchor($id, '', $what);
+ }
+ } elsif ($in_glossary && $use_glossary) {
+ $id = 'GLOSS' . ++$gloss_num;
+ $entry = $what;
+ $entry =~ tr/A-Z/a-z/ unless $entry =~ /^[A-Z\s]+$/;
+ $gloss2href{$entry} = "$docu_doc#$id";
+ print "# found glossary for '$entry' id $id\n"
+ if $debug & $DEBUG_GLOSS;
+ $what = &anchor($id, '', $what);
+ }
+ &html_pop_if('P');
+ if ($html_element eq 'DL' || $html_element eq 'DD') {
+ if ($things_map{$in_table} && !$what) {
+ # special case to allow @table @bullet for instance
+ push(@lines, &debug("<DT>$things_map{$in_table}\n", __LINE__));
+ } else {
+ push(@lines, &debug("<DT>\@$in_table\{$what\}\n", __LINE__));
+ }
+ push(@lines, "<DD>");
+ &html_push('DD') unless $html_element eq 'DD';
+ if ($table_type) { # add also an index
+ unshift(@input_spool, "\@${table_type}index $what\n");
+ }
+ } elsif ($html_element eq 'TABLE') {
+ push(@lines, &debug("<TR><TD>$what</TD>\n", __LINE__));
+ &html_push('TR');
+ } elsif ($html_element eq 'TR') {
+ push(@lines, &debug("</TR>\n", __LINE__));
+ push(@lines, &debug("<TR><TD>$what</TD>\n", __LINE__));
+ } else {
+ push(@lines, &debug("<LI>$what\n", __LINE__));
+ &html_push('LI') unless $html_element eq 'LI';
+ }
+ push(@lines, &html_debug("\n", __LINE__));
+ if ($deferred_ref) {
+ push(@lines, &debug("$deferred_ref\n", __LINE__));
+ $deferred_ref = '';
+ }
+ next;
+ } elsif (/^\@tab\s+(.*)$/) {
+ push(@lines, "<TD>$1</TD>\n");
+ next;
+ }
+ }
+ }
+ # paragraph separator
+ if ($_ eq "\n") {
+ next if $#lines >= 0 && $lines[$#lines] eq "\n";
+ if ($html_element eq 'P') {
+ push(@lines, "\n");
+ $_ = &debug("\n", __LINE__);
+ &html_pop;
+ }
+ } elsif ($html_element eq 'body' || $html_element eq 'BLOCKQUOTE') {
+ push(@lines, "<P>\n");
+ &html_push('P');
+ $_ = &debug($_, __LINE__);
+ }
+ # otherwise
+ push(@lines, $_);
+}
+
+# finish TOC
+$level = 0;
+while ($level < $curlevel) {
+ $curlevel--;
+ push(@toc_lines, "</UL>\n");
+}
+
+print "# end of pass 1\n" if $verbose;
+
+#+++############################################################################
+# #
+# Pass 2/3: handle style, menu, index, cross-reference #
+# #
+#---############################################################################
+
+@lines2 = (); # whole document (2nd pass)
+@lines3 = (); # whole document (3rd pass)
+$in_menu = 0; # am I inside a menu
+
+while (@lines) {
+ $_ = shift(@lines);
+ #
+ # special case (protected sections)
+ #
+ if (/^$PROTECTTAG/o) {
+ push(@lines2, $_);
+ next;
+ }
+ #
+ # menu
+ #
+ $in_menu = 1, push(@lines2, &debug("<UL>\n", __LINE__)), next if /^\@menu\b/;
+ $in_menu = 0, push(@lines2, &debug("</UL>\n", __LINE__)), next if /^\@end\s+menu\b/;
+ if ($in_menu) {
+ if (/^\*\s+($NODERE)::/o) {
+ $descr = $';
+ chop($descr);
+ &menu_entry($1, $1, $descr);
+ } elsif (/^\*\s+(.+):\s+([^\t,\.\n]+)[\t,\.\n]/) {
+ $descr = $';
+ chop($descr);
+ &menu_entry($1, $2, $descr);
+ } elsif (/^\*/) {
+ warn "$ERROR Bad menu line: $_";
+ } else { # description continued?
+ push(@lines2, $_);
+ }
+ next;
+ }
+ #
+ # printindex
+ #
+ if (/^\@printindex\s+(\w\w)\b/) {
+ local($index, *ary, @keys, $key, $letter, $last_letter, @refs);
+ if ($predefined_index{$1}) {
+ $index = $predefined_index{$1} . 'index';
+ } else {
+ $index = $1 . 'index';
+ }
+ eval("*ary = *$index");
+ @keys = keys(%ary);
+ foreach $key (@keys) {
+ $_ = $key;
+ 1 while s/<(\w+)>\`(.*)\'<\/\1>/$2/; # remove HTML tags with quotes
+ 1 while s/<(\w+)>(.*)<\/\1>/$2/; # remove HTML tags
+ $_ = &unprotect_html($_);
+ &unprotect_texi;
+ tr/A-Z/a-z/; # lowercase
+ $key2alpha{$key} = $_;
+ print "# index $key sorted as $_\n"
+ if $key ne $_ && $debug & $DEBUG_INDEX;
+ }
+ push(@lines2, "Jump to:\n");
+ $last_letter = undef;
+ foreach $key (sort byalpha @keys) {
+ $letter = substr($key2alpha{$key}, 0, 1);
+ $letter = substr($key2alpha{$key}, 0, 2) if $letter eq $;;
+ if (!defined($last_letter) || $letter ne $last_letter) {
+ push(@lines2, "-\n") if defined($last_letter);
+ push(@lines2, "<A HREF=\"#$index\_$letter\">" . &protect_html($letter) . "</A>\n");
+ $last_letter = $letter;
+ }
+ }
+ push(@lines2, "<P>\n");
+ $last_letter = undef;
+ foreach $key (sort byalpha @keys) {
+ $letter = substr($key2alpha{$key}, 0, 1);
+ $letter = substr($key2alpha{$key}, 0, 2) if $letter eq $;;
+ if (!defined($last_letter) || $letter ne $last_letter) {
+ push(@lines2, "</DIR>\n") if defined($last_letter);
+ push(@lines2, "<H2><A NAME=\"$index\_$letter\">" . &protect_html($letter) . "</A></H2>\n");
+ push(@lines2, "<DIR>\n");
+ $last_letter = $letter;
+ }
+ @refs = ();
+ foreach (split(/$;/, $ary{$key})) {
+ push(@refs, &anchor('', $_, $key, 0));
+ }
+ push(@lines2, "<LI>" . join(", ", @refs) . "\n");
+ }
+ push(@lines2, "</DIR>\n") if defined($last_letter);
+ next;
+ }
+ #
+ # simple style substitutions
+ #
+ $_ = &substitute_style($_);
+ #
+ # xref
+ #
+ while (/\@(x|px|info|)ref{($XREFRE)(}?)/o) {
+ # note: Texinfo may accept other characters
+ ($type, $nodes, $full) = ($1, $2, $3);
+ ($before, $after) = ($`, $');
+ if (! $full && $after) {
+ warn "$ERROR Bad xref (no ending } on line): $_";
+ $_ = "$before$;0${type}ref\{$nodes$after";
+ next; # while xref
+ }
+ if ($type eq 'x') {
+ $type = 'See ';
+ } elsif ($type eq 'px') {
+ $type = 'see ';
+ } elsif ($type eq 'info') {
+ $type = 'See Info';
+ } else {
+ $type = '';
+ }
+ unless ($full) {
+ $next = shift(@lines);
+ $next = &substitute_style($next);
+ chop($nodes); # remove final newline
+ if ($next =~ /\}/) { # split on 2 lines
+ $nodes .= " $`";
+ $after = $';
+ } else {
+ $nodes .= " $next";
+ $next = shift(@lines);
+ $next = &substitute_style($next);
+ chop($nodes);
+ if ($next =~ /\}/) { # split on 3 lines
+ $nodes .= " $`";
+ $after = $';
+ } else {
+ warn "$ERROR Bad xref (no ending }): $_";
+ $_ = "$before$;0xref\{$nodes$after";
+ unshift(@lines, $next);
+ next; # while xref
+ }
+ }
+ }
+ $nodes =~ s/\s+/ /g; # remove useless spaces
+ @args = split(/\s*,\s*/, $nodes);
+ $node = $args[0]; # the node is always the first arg
+ &normalise_node($node);
+ $sec = $node2sec{$node};
+ if (@args == 5) { # reference to another manual
+ $sec = $args[2] || $node;
+ $man = $args[4] || $args[3];
+ $_ = "${before}${type}section `$sec' in \@cite{$man}$after";
+ } elsif ($type =~ /Info/) { # inforef
+ warn "$ERROR Wrong number of arguments: $_" unless @args == 3;
+ ($nn, $_, $in) = @args;
+ $_ = "${before}${type} file `$in', node `$nn'$after";
+ } elsif ($sec) {
+ $href = $node2href{$node};
+ $_ = "${before}${type}section " . &anchor('', $href, $sec) . $after;
+ } else {
+ warn "$ERROR Undefined node ($node): $_";
+ $_ = "$before$;0xref{$nodes}$after";
+ }
+ }
+
+ if (/^\@image\s*{/) {
+ s/\@image\s*{//;
+ my (@args) = split (/,/);
+ my $base = $args[0];
+ my $image;
+ if (-r "$base.jpg") {
+ $image = "$base.jpg";
+ } elsif (-r "$base.png") {
+ $image = "$base.png";
+ } elsif (-r "$base.gif") {
+ $image = "$base.gif";
+ } else {
+ warn "$ERROR no image file for $base: $_";
+ }
+ $_ = "<IMG SRC=\"$image\" ALT=\"$base\">";
+ }
+
+ #
+ # try to guess bibliography references or glossary terms
+ #
+ unless (/^<H\d><A NAME=\"SEC\d/) {
+ if ($use_bibliography) {
+ $done = '';
+ while (/$BIBRE/o) {
+ ($pre, $what, $post) = ($`, $&, $');
+ $href = $bib2href{$what};
+ if (defined($href) && $post !~ /^[^<]*<\/A>/) {
+ $done .= $pre . &anchor('', $href, $what);
+ } else {
+ $done .= "$pre$what";
+ }
+ $_ = $post;
+ }
+ $_ = $done . $_;
+ }
+ if ($use_glossary) {
+ $done = '';
+ while (/\b\w+\b/) {
+ ($pre, $what, $post) = ($`, $&, $');
+ $entry = $what;
+ $entry =~ tr/A-Z/a-z/ unless $entry =~ /^[A-Z\s]+$/;
+ $href = $gloss2href{$entry};
+ if (defined($href) && $post !~ /^[^<]*<\/A>/) {
+ $done .= $pre . &anchor('', $href, $what);
+ } else {
+ $done .= "$pre$what";
+ }
+ $_ = $post;
+ }
+ $_ = $done . $_;
+ }
+ }
+ # otherwise
+ push(@lines2, $_);
+}
+print "# end of pass 2\n" if $verbose;
+
+#
+# split style substitutions
+#
+while (@lines2) {
+ $_ = shift(@lines2);
+ #
+ # special case (protected sections)
+ #
+ if (/^$PROTECTTAG/o) {
+ push(@lines3, $_);
+ next;
+ }
+ #
+ # split style substitutions
+ #
+ $old = '';
+ while ($old ne $_) {
+ $old = $_;
+ if (/\@(\w+)\{/) {
+ ($before, $style, $after) = ($`, $1, $');
+ if (defined($style_map{$style})) {
+ $_ = $after;
+ $text = '';
+ $after = '';
+ $failed = 1;
+ while (@lines2) {
+ if (/\}/) {
+ $text .= $`;
+ $after = $';
+ $failed = 0;
+ last;
+ } else {
+ $text .= $_;
+ $_ = shift(@lines2);
+ }
+ }
+ if ($failed) {
+ die "* Bad syntax (\@$style) after: $before\n";
+ } else {
+ $text = &apply_style($style, $text);
+ $_ = "$before$text$after";
+ }
+ }
+ }
+ }
+ # otherwise
+ push(@lines3, $_);
+}
+print "# end of pass 3\n" if $verbose;
+
+#+++############################################################################
+# #
+# Pass 4: foot notes, final cleanup #
+# #
+#---############################################################################
+
+@foot_lines = (); # footnotes
+@doc_lines = (); # final document
+$end_of_para = 0; # true if last line is <P>
+
+while (@lines3) {
+ $_ = shift(@lines3);
+ #
+ # special case (protected sections)
+ #
+ if (/^$PROTECTTAG/o) {
+ push(@doc_lines, $_);
+ $end_of_para = 0;
+ next;
+ }
+ #
+ # footnotes
+ #
+ while (/\@footnote([^\{\s]+)\{/) {
+ ($before, $d, $after) = ($`, $1, $');
+ $_ = $after;
+ $text = '';
+ $after = '';
+ $failed = 1;
+ while (@lines3) {
+ if (/\}/) {
+ $text .= $`;
+ $after = $';
+ $failed = 0;
+ last;
+ } else {
+ $text .= $_;
+ $_ = shift(@lines3);
+ }
+ }
+ if ($failed) {
+ die "* Bad syntax (\@footnote) after: $before\n";
+ } else {
+ $foot_num++;
+ $docid = "DOCF$foot_num";
+ $footid = "FOOT$foot_num";
+ $foot = "($foot_num)";
+ push(@foot_lines, "<H3>" . &anchor($footid, "$d#$docid", $foot) . "</H3>\n");
+ $text = "<P>$text" unless $text =~ /^\s*<P>/;
+ push(@foot_lines, "$text\n");
+ $_ = $before . &anchor($docid, "$docu_foot#$footid", $foot) . $after;
+ }
+ }
+ #
+ # remove unnecessary <P>
+ #
+ if (/^\s*<P>\s*$/) {
+ next if $end_of_para++;
+ } else {
+ $end_of_para = 0;
+ }
+ # otherwise
+ push(@doc_lines, $_);
+}
+print "# end of pass 4\n" if $verbose;
+
+#+++############################################################################
+# #
+# Pass 5: print things #
+# #
+#---############################################################################
+
+$header = <<EOT;
+<!-- Created by $THISPROG from $docu on $TODAY -->
+EOT
+
+$full_title = $value{'_title'} || $value{'_settitle'} || "Untitled Document";
+$title = $value{'_settitle'} || $full_title;
+$_ = &substitute_style($full_title);
+&unprotect_texi;
+s/\n$//; # rmv last \n (if any)
+$full_title = "<H1>" . join("</H1>\n<H1>", split(/\n/, $_)) . "</H1>\n";
+
+#
+# print ToC
+#
+if (!$monolithic && @toc_lines) {
+ if (open(FILE, "> $docu_toc")) {
+ print "# creating $docu_toc...\n" if $verbose;
+ &print_toplevel_header("$title - Table of Contents");
+ &print_ruler;
+ &print(*toc_lines, FILE);
+ &print_toplevel_footer;
+ close(FILE);
+ } else {
+ warn "$ERROR Can't write to $docu_toc: $!\n";
+ }
+}
+
+#
+# print footnotes
+#
+if (!$monolithic && @foot_lines) {
+ if (open(FILE, "> $docu_foot")) {
+ print "# creating $docu_foot...\n" if $verbose;
+ &print_toplevel_header("$title - Footnotes");
+ &print_ruler;
+ &print(*foot_lines, FILE);
+ &print_toplevel_footer;
+ close(FILE);
+ } else {
+ warn "$ERROR Can't write to $docu_foot: $!\n";
+ }
+}
+
+#
+# print document
+#
+if ($split_chapter || $split_node) { # split
+ $doc_num = 0;
+ $last_num = scalar(@sections);
+ $first_doc = &doc_name(1);
+ $last_doc = &doc_name($last_num);
+ while (@sections) {
+ $section = shift(@sections);
+ &next_doc;
+ if (open(FILE, "> $docu_doc")) {
+ print "# creating $docu_doc...\n" if $verbose;
+ &print_header("$title - $section");
+ $prev_doc = ($doc_num == 1 ? undef : &doc_name($doc_num - 1));
+ $next_doc = ($doc_num == $last_num ? undef : &doc_name($doc_num + 1));
+ $navigation = "Go to the ";
+ $navigation .= ($prev_doc ? &anchor('', $first_doc, "first") : "first");
+ $navigation .= ", ";
+ $navigation .= ($prev_doc ? &anchor('', $prev_doc, "previous") : "previous");
+ $navigation .= ", ";
+ $navigation .= ($next_doc ? &anchor('', $next_doc, "next") : "next");
+ $navigation .= ", ";
+ $navigation .= ($next_doc ? &anchor('', $last_doc, "last") : "last");
+ $navigation .= " section, " . &anchor('', $docu_toc, "table of contents") . ".\n";
+ print FILE $navigation;
+ &print_ruler;
+ # find corresponding lines
+ @tmp_lines = ();
+ while (@doc_lines) {
+ $_ = shift(@doc_lines);
+ last if ($_ eq $SPLITTAG);
+ push(@tmp_lines, $_);
+ }
+ &print(*tmp_lines, FILE);
+ &print_ruler;
+ print FILE $navigation;
+ &print_footer;
+ close(FILE);
+ } else {
+ warn "$ERROR Can't write to $docu_doc: $!\n";
+ }
+ }
+} else { # not split
+ if (open(FILE, "> $docu_doc")) {
+ print "# creating $docu_doc...\n" if $verbose;
+ if ($monolithic || !@toc_lines) {
+ &print_toplevel_header($title);
+ } else {
+ &print_header($title);
+ print FILE $full_title;
+ }
+ if ($monolithic && @toc_lines) {
+ &print_ruler;
+ print FILE "<H1>Table of Contents</H1>\n";
+ &print(*toc_lines, FILE);
+ }
+ &print_ruler;
+ &print(*doc_lines, FILE);
+ if ($monolithic && @foot_lines) {
+ &print_ruler;
+ print FILE "<H1>Footnotes</H1>\n";
+ &print(*foot_lines, FILE);
+ }
+ if ($monolithic || !@toc_lines) {
+ &print_toplevel_footer;
+ } else {
+ &print_footer;
+ }
+ close(FILE);
+ } else {
+ warn "$ERROR Can't write to $docu_doc: $!\n";
+ }
+}
+
+print "# that's all folks\n" if $verbose;
+
+#+++############################################################################
+# #
+# Low level functions #
+# #
+#---############################################################################
+
+sub update_sec_num {
+ local($name, $level) = @_;
+ my $ret;
+
+ $level--; # here we start at 0
+ if ($name =~ /^appendix/) {
+ # appendix style
+ if (defined(@appendix_sec_num)) {
+ &incr_sec_num($level, @appendix_sec_num);
+ } else {
+ @appendix_sec_num = ('A', 0, 0, 0);
+ }
+ $ret = join('.', @appendix_sec_num[0..$level]);
+ } else {
+ # normal style
+ if (defined(@normal_sec_num)) {
+ &incr_sec_num($level, @normal_sec_num);
+ } else {
+ @normal_sec_num = (1, 0, 0, 0);
+ }
+ $ret = join('.', @normal_sec_num[0..$level]);
+ }
+
+ $ret .= "." if $level == 0;
+ return $ret;
+}
+
+sub incr_sec_num {
+ local($level, $l);
+ $level = shift(@_);
+ $_[$level]++;
+ foreach $l ($level+1 .. 3) {
+ $_[$l] = 0;
+ }
+}
+
+sub check {
+ local($_, %seen, %context, $before, $match, $after);
+
+ while (<>) {
+ if (/\@(\*|\.|\:|\@|\{|\})/) {
+ $seen{$&}++;
+ $context{$&} .= "> $_" if $verbose;
+ $_ = "$`XX$'";
+ redo;
+ }
+ if (/\@(\w+)/) {
+ ($before, $match, $after) = ($`, $&, $');
+ if ($before =~ /\b[\w-]+$/ && $after =~ /^[\w-.]*\b/) { # e-mail address
+ $seen{'e-mail address'}++;
+ $context{'e-mail address'} .= "> $_" if $verbose;
+ } else {
+ $seen{$match}++;
+ $context{$match} .= "> $_" if $verbose;
+ }
+ $match =~ s/^\@/X/;
+ $_ = "$before$match$after";
+ redo;
+ }
+ }
+
+ foreach (sort(keys(%seen))) {
+ if ($verbose) {
+ print "$_\n";
+ print $context{$_};
+ } else {
+ print "$_ ($seen{$_})\n";
+ }
+ }
+}
+
+sub open {
+ local($name) = @_;
+
+ ++$fh_name;
+ if (open($fh_name, $name)) {
+ unshift(@fhs, $fh_name);
+ } else {
+ warn "$ERROR Can't read file $name: $!\n";
+ }
+}
+
+sub init_input {
+ @fhs = (); # hold the file handles to read
+ @input_spool = (); # spooled lines to read
+ $fh_name = 'FH000';
+ &open($docu);
+}
+
+sub next_line {
+ local($fh, $line);
+
+ if (@input_spool) {
+ $line = shift(@input_spool);
+ return($line);
+ }
+ while (@fhs) {
+ $fh = $fhs[0];
+ $line = <$fh>;
+ return($line) if $line;
+ close($fh);
+ shift(@fhs);
+ }
+ return(undef);
+}
+
+# used in pass 1, use &next_line
+sub skip_until {
+ local($tag) = @_;
+ local($_);
+
+ while ($_ = &next_line) {
+ return if /^\@end\s+$tag\s*$/;
+ }
+ die "* Failed to find '$tag' after: " . $lines[$#lines];
+}
+
+#
+# HTML stacking to have a better HTML output
+#
+
+sub html_reset {
+ @html_stack = ('html');
+ $html_element = 'body';
+}
+
+sub html_push {
+ local($what) = @_;
+ push(@html_stack, $html_element);
+ $html_element = $what;
+}
+
+sub html_push_if {
+ local($what) = @_;
+ push(@html_stack, $html_element)
+ if ($html_element && $html_element ne 'P');
+ $html_element = $what;
+}
+
+sub html_pop {
+ $html_element = pop(@html_stack);
+}
+
+sub html_pop_if {
+ local($elt);
+
+ if (@_) {
+ foreach $elt (@_) {
+ if ($elt eq $html_element) {
+ $html_element = pop(@html_stack) if @html_stack;
+ last;
+ }
+ }
+ } else {
+ $html_element = pop(@html_stack) if @html_stack;
+ }
+}
+
+sub html_debug {
+ local($what, $line) = @_;
+ return("<!-- $line @html_stack, $html_element -->$what")
+ if $debug & $DEBUG_HTML;
+ return($what);
+}
+
+# to debug the output...
+sub debug {
+ local($what, $line) = @_;
+ return("<!-- $line -->$what")
+ if $debug & $DEBUG_HTML;
+ return($what);
+}
+
+sub normalise_node {
+ $_[0] =~ s/\s+/ /g;
+ $_[0] =~ s/ $//;
+ $_[0] =~ s/^ //;
+}
+
+sub menu_entry {
+ local($entry, $node, $descr) = @_;
+ local($href);
+
+ &normalise_node($node);
+ $href = $node2href{$node};
+ if ($href) {
+ $descr =~ s/^\s+//;
+ $descr = ": $descr" if $descr;
+ push(@lines2, "<LI>" . &anchor('', $href, $entry) . "$descr\n");
+ } else {
+ warn "$ERROR Undefined node ($node): $_";
+ }
+}
+
+sub do_ctrl { "^$_[0]" }
+
+sub do_email {
+ local($addr, $text) = split(/,\s*/, $_[0]);
+
+ $text = $addr unless $text;
+ &anchor('', "mailto:$addr", $text);
+}
+
+sub do_sc { "\U$_[0]\E" }
+
+sub do_uref {
+ local($url, $text) = split(/,\s*/, $_[0]);
+
+ $text = $url unless $text;
+ &anchor('', $url, $text);
+}
+
+sub do_url { &anchor('', $_[0], $_[0]) }
+
+sub apply_style {
+ local($texi_style, $text) = @_;
+ local($style);
+
+ $style = $style_map{$texi_style};
+ if (defined($style)) { # known style
+ if ($style =~ /^\"/) { # add quotes
+ $style = $';
+ $text = "\`$text\'";
+ }
+ if ($style =~ /^\&/) { # custom
+ $style = $';
+ $text = &$style($text);
+ } elsif ($style) { # good style
+ $text = "<$style>$text</$style>";
+ } else { # no style
+ }
+ } else { # unknown style
+ $text = undef;
+ }
+ return($text);
+}
+
+# remove Texinfo styles
+sub remove_style {
+ local($_) = @_;
+ s/\@\w+{([^\{\}]+)}/$1/g;
+ return($_);
+}
+
+sub substitute_style {
+ local($_) = @_;
+ local($changed, $done, $style, $text);
+
+ $changed = 1;
+ while ($changed) {
+ $changed = 0;
+ $done = '';
+ while (/\@(\w+){([^\{\}]+)}/) {
+ $text = &apply_style($1, $2);
+ if ($text) {
+ $_ = "$`$text$'";
+ $changed = 1;
+ } else {
+ $done .= "$`\@$1";
+ $_ = "{$2}$'";
+ }
+ }
+ $_ = $done . $_;
+ }
+ return($_);
+}
+
+sub anchor {
+ local($name, $href, $text, $newline) = @_;
+ local($result);
+
+ $result = "<A";
+ $result .= " NAME=\"$name\"" if $name;
+ $result .= " HREF=\"$href\"" if $href;
+ $result .= ">$text</A>";
+ $result .= "\n" if $newline;
+ return($result);
+}
+
+sub pretty_date {
+ local(@MoY, $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
+
+ @MoY = ('January', 'February', 'March', 'April', 'May', 'June',
+ 'July', 'August', 'September', 'October', 'November', 'December');
+ ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
+ $year += ($year < 70) ? 2000 : 1900;
+ return("$mday $MoY[$mon] $year");
+}
+
+sub doc_name {
+ local($num) = @_;
+
+ return("${docu_name}_$num.html");
+}
+
+sub next_doc {
+ $docu_doc = &doc_name(++$doc_num);
+}
+
+sub print {
+ local(*lines, $fh) = @_;
+ local($_);
+
+ while (@lines) {
+ $_ = shift(@lines);
+ if (/^$PROTECTTAG/o) {
+ $_ = $tag2pro{$_};
+ } else {
+ &unprotect_texi;
+ }
+ print $fh $_;
+ }
+}
+
+sub print_ruler {
+ print FILE "<P><HR><P>\n";
+}
+
+sub print_header {
+ local($_);
+
+ # clean the title
+ $_ = &remove_style($_[0]);
+ &unprotect_texi;
+ # print the header
+ if ($doctype eq 'html2') {
+ print FILE $html2_doctype;
+ } elsif ($doctype) {
+ print FILE $doctype;
+ }
+ print FILE <<EOT;
+<HTML>
+<HEAD>
+$header
+<TITLE>$_</TITLE>
+</HEAD>
+<BODY>
+EOT
+}
+
+sub print_toplevel_header {
+ local($_);
+
+ &print_header; # pass given arg...
+ print FILE $full_title;
+ if ($value{'_subtitle'}) {
+ $value{'_subtitle'} =~ s/\n+$//;
+ foreach (split(/\n/, $value{'_subtitle'})) {
+ $_ = &substitute_style($_);
+ &unprotect_texi;
+ print FILE "<H2>$_</H2>\n";
+ }
+ }
+ if ($value{'_author'}) {
+ $value{'_author'} =~ s/\n+$//;
+ foreach (split(/\n/, $value{'_author'})) {
+ $_ = &substitute_style($_);
+ &unprotect_texi;
+ s/[\w.-]+\@[\w.-]+/<A HREF="mailto:$&">$&<\/A>/g;
+ print FILE "<ADDRESS>$_</ADDRESS>\n";
+ }
+ }
+ print FILE "<P>\n";
+}
+
+sub print_footer {
+ print FILE <<EOT;
+</BODY>
+</HTML>
+EOT
+}
+
+sub print_toplevel_footer {
+ &print_ruler;
+ print FILE <<EOT;
+This document was generated on $TODAY using
+<A HREF=\"$HOMEPAGE\">texi2html</A>&nbsp;$value{texi2html}.
+EOT
+ &print_footer;
+}
+
+sub protect_texi {
+ # protect @ { } ` '
+ s/\@\@/$;0/go;
+ s/\@\{/$;1/go;
+ s/\@\}/$;2/go;
+ s/\@\`/$;3/go;
+ s/\@\'/$;4/go;
+}
+
+sub protect_html {
+ local($what) = @_;
+ # protect & < >
+ $what =~ s/\&/\&\#38;/g;
+ $what =~ s/\</\&\#60;/g;
+ $what =~ s/\>/\&\#62;/g;
+ # but recognize some HTML things
+ $what =~ s/\&\#60;\/A\&\#62;/<\/A>/g; # </A>
+ $what =~ s/\&\#60;A ([^\&]+)\&\#62;/<A $1>/g; # <A [^&]+>
+ $what =~ s/\&\#60;IMG ([^\&]+)\&\#62;/<IMG $1>/g; # <IMG [^&]+>
+ return($what);
+}
+
+sub unprotect_texi {
+ s/$;0/\@/go;
+ s/$;1/\{/go;
+ s/$;2/\}/go;
+ s/$;3/\`/go;
+ s/$;4/\'/go;
+}
+
+sub unprotect_html {
+ local($what) = @_;
+ $what =~ s/\&\#38;/\&/g;
+ $what =~ s/\&\#60;/\</g;
+ $what =~ s/\&\#62;/\>/g;
+ return($what);
+}
+
+sub byalpha {
+ $key2alpha{$a} cmp $key2alpha{$b};
+}
+
+##############################################################################
+
+ # These next few lines are legal in both Perl and nroff.
+
+.00 ; # finish .ig
+
+'di \" finish diversion--previous line must be blank
+.nr nl 0-1 \" fake up transition to first page again
+.nr % 0 \" start at page 1
+'; __END__ ############# From here on it's a standard manual page ############
+.TH TEXI2HTML 1 "01/05/98"
+.AT 3
+.SH NAME
+texi2html \- a Texinfo to HTML converter
+.SH SYNOPSIS
+.B texi2html [options] file
+.PP
+.B texi2html -check [-verbose] files
+.SH DESCRIPTION
+.I Texi2html
+converts the given Texinfo file to a set of HTML files. It tries to handle
+most of the Texinfo commands. It creates hypertext links for cross-references,
+footnotes...
+.PP
+It also tries to add links from a reference to its corresponding entry in the
+bibliography (if any). It may also handle a glossary (see the
+.B \-glossary
+option).
+.PP
+.I Texi2html
+creates several files depending on the contents of the Texinfo file and on
+the chosen options (see FILES).
+.PP
+The HTML files created by
+.I texi2html
+are closer to TeX than to Info, that's why
+.I texi2html
+converts @iftex sections and not @ifinfo ones by default. You can reverse
+this with the \-expandinfo option.
+.SH OPTIONS
+.TP 12
+.B \-check
+Check the given file and give the list of all things that may be Texinfo commands.
+This may be used to check the output of
+.I texi2html
+to find the Texinfo commands that have been left in the HTML file.
+.TP
+.B \-expandinfo
+Expand @ifinfo sections, not @iftex ones.
+.TP
+.B \-glossary
+Use the section named 'Glossary' to build a list of terms and put links in the HTML
+document from each term toward its definition.
+.TP
+.B \-invisible \fIname\fP
+Use \fIname\fP to create invisible destination anchors for index links
+(you can for instance use the invisible.xbm file shipped with this program).
+This is a workaround for a known bug of many WWW browsers, including netscape.
+.TP
+.B \-I \fIdir\fP
+Look also in \fIdir\fP to find included files.
+.TP
+.B \-menu
+Show the Texinfo menus; by default they are ignored.
+.TP
+.B \-monolithic
+Output only one file, including the table of contents and footnotes.
+.TP
+.B \-number
+Number the sections.
+.TP
+.B \-split_chapter
+Split the output into several HTML files (one per main section:
+chapter, appendix...).
+.TP
+.B \-split_node
+Split the output into several HTML files (one per node).
+.TP
+.B \-usage
+Print usage instructions, listing the current available command-line options.
+.TP
+.B \-verbose
+Give a verbose output. Can be used with the
+.B \-check
+option.
+.PP
+.SH FILES
+By default
+.I texi2html
+creates the following files (foo being the name of the Texinfo file):
+.TP 16
+.B foo_toc.html
+The table of contents.
+.TP
+.B foo.html
+The document's contents.
+.TP
+.B foo_foot.html
+The footnotes (if any).
+.PP
+When used with the
+.B \-split
+option, it creates several files (one per chapter or node), named
+.B foo_n.html
+(n being the indice of the chapter or node), instead of the single
+.B foo.html
+file.
+.PP
+When used with the
+.B \-monolithic
+option, it creates only one file:
+.B foo.html
+.SH VARIABLES
+.I texi2html
+predefines the following variables: \fBhtml\fP, \fBtexi2html\fP.
+.SH ADDITIONAL COMMANDS
+.I texi2html
+implements the following non-Texinfo commands (maybe they are in Texinfo now...):
+.TP 16
+.B @ifhtml
+This indicates the start of an HTML section, this section will passed through
+without any modification.
+.TP
+.B @end ifhtml
+This indicates the end of an HTML section.
+.SH VERSION
+This is \fItexi2html\fP version 1.56k, 1999-02-20.
+.PP
+The latest version of \fItexi2html\fP can be found in WWW, cf. URLs
+http://wwwinfo.cern.ch/dis/texi2html/
+.br
+http://texinfo.org/texi2html/
+.SH AUTHOR
+The main author is Lionel Cons, CERN IT/DIS/OSE, Lionel.Cons@cern.ch.
+Many other people around the net contributed to this program.
+.SH COPYRIGHT
+This program is the intellectual property of the European
+Laboratory for Particle Physics (known as CERN). No guarantee whatsoever is
+provided by CERN. No liability whatsoever is accepted for any loss or damage
+of any kind resulting from any defect or inaccuracy in this information or
+code.
+.PP
+CERN, 1211 Geneva 23, Switzerland
+.SH "SEE ALSO"
+GNU Texinfo Documentation Format,
+HyperText Markup Language (HTML),
+World Wide Web (WWW).
+.SH BUGS
+This program does not understand all Texinfo commands (yet).
+.PP
+TeX specific commands (normally enclosed in @iftex) will be
+passed unmodified.
+.ex
diff --git a/Master/texmf/scripts/tetex/updmap.pl b/Master/texmf/scripts/tetex/updmap.pl
new file mode 100644
index 00000000000..ef227926cbc
--- /dev/null
+++ b/Master/texmf/scripts/tetex/updmap.pl
@@ -0,0 +1,1101 @@
+###############################################################################
+# updmap: utility to maintain map files for outline fonts.
+#
+# Thomas Esser, (C) 2002. Public domain.
+# Fabrice Popineau, for the Perl version.
+#
+# Commands:
+# --edit edit config file
+# --help show help message
+#
+# Options:
+# --cnffile file specify configuration file
+# --dvipsoutputdir directory specify output directory (dvips syntax)
+# --pdftexoutputdir directory specify output directory (pdftex syntax)
+# --dvipdfmoutputdir directory specify output directory (dvipdfm syntax)
+# --outputdir directory specify output directory (for all files)
+# --quiet reduce verbosity
+###############################################################################
+
+require "newgetopt.pl";
+use Cwd;
+use Strict;
+use File::Copy;
+use File::Compare;
+use File::Path;
+
+# my $IsWin32 = ($^O =~ /MSWin32/i);
+
+# if ($IsWin32) {
+# use Win32::Registry;
+# use Win32::API;
+# }
+
+my $progname;
+my $cnfFile;
+my $cnfFileShort;
+my $outputdir;
+my $dvipsoutputdir;
+my $pdftexoutputdir;
+my $dvipdfmoutputdir;
+my $quiet;
+my $texhashEnabled;
+my $mkmapEnabled;
+
+my %enableItem = ();
+my %setOption = ();
+my @showoptions = ();
+my @disableItem = ();
+my $listmaps;
+my $needsCleanup;
+
+my $verbose;
+my $debug;
+my $opt_edit;
+my $opt_help;
+
+my $TEXMFMAIN;
+my $TEXMFVAR;
+
+my $mode;
+my $dvipsPreferOutline;
+my $dvipsDownloadBase35;
+my $pdftexDownloadBase14;
+my $dvipdfmDownloadBase14;
+
+my $dvips35;
+my $pdftex35;
+my $dvipdfm35;
+my $ps2pk35;
+
+my @cfg = ( );
+
+my @psADOBE = (
+ 's/ URWGothicL-Demi / AvantGarde-Demi /x',
+ 's/ URWGothicL-DemiObli / AvantGarde-DemiOblique /x',
+ 's/ URWGothicL-Book / AvantGarde-Book /x',
+ 's/ URWGothicL-BookObli / AvantGarde-BookOblique /x',
+ 's/ URWBookmanL-DemiBold / Bookman-Demi /x',
+ 's/ URWBookmanL-DemiBoldItal / Bookman-DemiItalic /x',
+ 's/ URWBookmanL-Ligh / Bookman-Light /x',
+ 's/ URWBookmanL-LighItal / Bookman-LightItalic /x',
+ 's/ NimbusMonL-Bold / Courier-Bold /x',
+ 's/ NimbusMonL-BoldObli / Courier-BoldOblique /x',
+ 's/ NimbusMonL-Regu / Courier /x',
+ 's/ NimbusMonL-ReguObli / Courier-Oblique /x',
+ 's/ NimbusSanL-Bold / Helvetica-Bold /x',
+ 's/ NimbusSanL-BoldCond / Helvetica-Narrow-Bold /x',
+ 's/ NimbusSanL-BoldItal / Helvetica-BoldOblique /x',
+ 's/ NimbusSanL-BoldCondItal / Helvetica-Narrow-BoldOblique /x',
+ 's/ NimbusSanL-Regu / Helvetica /x',
+ 's/ NimbusSanL-ReguCond / Helvetica-Narrow /x',
+ 's/ NimbusSanL-ReguItal / Helvetica-Oblique /x',
+ 's/ NimbusSanL-ReguCondItal / Helvetica-Narrow-Oblique /x',
+ 's/ CenturySchL-Bold / NewCenturySchlbk-Bold /x',
+ 's/ CenturySchL-BoldItal / NewCenturySchlbk-BoldItalic /x',
+ 's/ CenturySchL-Roma / NewCenturySchlbk-Roman /x',
+ 's/ CenturySchL-Ital / NewCenturySchlbk-Italic /x',
+ 's/ URWPalladioL-Bold / Palatino-Bold /x',
+ 's/ URWPalladioL-BoldItal / Palatino-BoldItalic /x',
+ 's/ URWPalladioL-Roma / Palatino-Roman /x',
+ 's/ URWPalladioL-Ital / Palatino-Italic /x',
+ 's/ StandardSymL / Symbol /x',
+ 's/ NimbusRomNo9L-Medi / Times-Bold /x',
+ 's/ NimbusRomNo9L-MediItal / Times-BoldItalic /x',
+ 's/ NimbusRomNo9L-Regu / Times-Roman /x',
+ 's/ NimbusRomNo9L-ReguItal / Times-Italic /x',
+ 's/ URWChanceryL-MediItal / ZapfChancery-MediumItalic /x',
+ 's/ Dingbats / ZapfDingbats /x'
+ );
+
+my @fileADOBEkb = (
+ 's/\buagd8a.pfb\b/pagd8a.pfb/x',
+ 's/\buagdo8a.pfb\b/pagdo8a.pfb/x',
+ 's/\buagk8a.pfb\b/pagk8a.pfb/x',
+ 's/\buagko8a.pfb\b/pagko8a.pfb/x',
+ 's/\bubkd8a.pfb\b/pbkd8a.pfb/x',
+ 's/\bubkdi8a.pfb\b/pbkdi8a.pfb/x',
+ 's/\bubkl8a.pfb\b/pbkl8a.pfb/x',
+ 's/\bubkli8a.pfb\b/pbkli8a.pfb/x',
+ 's/\bucrb8a.pfb\b/pcrb8a.pfb/x',
+ 's/\bucrbo8a.pfb\b/pcrbo8a.pfb/x',
+ 's/\bucrr8a.pfb\b/pcrr8a.pfb/x',
+ 's/\bucrro8a.pfb\b/pcrro8a.pfb/x',
+ 's/\buhvb8a.pfb\b/phvb8a.pfb/x',
+ 's/\buhvb8ac.pfb\b/phvb8an.pfb/x',
+ 's/\buhvbo8a.pfb\b/phvbo8a.pfb/x',
+ 's/\buhvbo8ac.pfb\b/phvbo8an.pfb/x',
+ 's/\buhvr8a.pfb\b/phvr8a.pfb/x',
+ 's/\buhvr8ac.pfb\b/phvr8an.pfb/x',
+ 's/\buhvro8a.pfb\b/phvro8a.pfb/x',
+ 's/\buhvro8ac.pfb\b/phvro8an.pfb/x',
+ 's/\buncb8a.pfb\b/pncb8a.pfb/x',
+ 's/\buncbi8a.pfb\b/pncbi8a.pfb/x',
+ 's/\buncr8a.pfb\b/pncr8a.pfb/x',
+ 's/\buncri8a.pfb\b/pncri8a.pfb/x',
+ 's/\buplb8a.pfb\b/pplb8a.pfb/x',
+ 's/\buplbi8a.pfb\b/pplbi8a.pfb/x',
+ 's/\buplr8a.pfb\b/pplr8a.pfb/x',
+ 's/\buplri8a.pfb\b/pplri8a.pfb/x',
+ 's/\busyr.pfb\b/psyr.pfb/x',
+ 's/\butmb8a.pfb\b/ptmb8a.pfb/x',
+ 's/\butmbi8a.pfb\b/ptmbi8a.pfb/x',
+ 's/\butmr8a.pfb\b/ptmr8a.pfb/x',
+ 's/\butmri8a.pfb\b/ptmri8a.pfb/x',
+ 's/\buzcmi8a.pfb\b/pzcmi8a.pfb/x',
+ 's/\buzdr.pfb\b/pzdr.pfb/x'
+ );
+
+my @fileURW = (
+ 's/\buagd8a.pfb\b/a010015l.pfb/x',
+ 's/\buagdo8a.pfb\b/a010035l.pfb/x',
+ 's/\buagk8a.pfb\b/a010013l.pfb/x',
+ 's/\buagko8a.pfb\b/a010033l.pfb/x',
+ 's/\bubkd8a.pfb\b/b018015l.pfb/x',
+ 's/\bubkdi8a.pfb\b/b018035l.pfb/x',
+ 's/\bubkl8a.pfb\b/b018012l.pfb/x',
+ 's/\bubkli8a.pfb\b/b018032l.pfb/x',
+ 's/\bucrb8a.pfb\b/n022004l.pfb/x',
+ 's/\bucrbo8a.pfb\b/n022024l.pfb/x',
+ 's/\bucrr8a.pfb\b/n022003l.pfb/x',
+ 's/\bucrro8a.pfb\b/n022023l.pfb/x',
+ 's/\buhvb8a.pfb\b/n019004l.pfb/x',
+ 's/\buhvb8ac.pfb\b/n019044l.pfb/x',
+ 's/\buhvbo8a.pfb\b/n019024l.pfb/x',
+ 's/\buhvbo8ac.pfb\b/n019064l.pfb/x',
+ 's/\buhvr8a.pfb\b/n019003l.pfb/x',
+ 's/\buhvr8ac.pfb\b/n019043l.pfb/x',
+ 's/\buhvro8a.pfb\b/n019023l.pfb/x',
+ 's/\buhvro8ac.pfb\b/n019063l.pfb/x',
+ 's/\buncb8a.pfb\b/c059016l.pfb/x',
+ 's/\buncbi8a.pfb\b/c059036l.pfb/x',
+ 's/\buncr8a.pfb\b/c059013l.pfb/x',
+ 's/\buncri8a.pfb\b/c059033l.pfb/x',
+ 's/\buplb8a.pfb\b/p052004l.pfb/x',
+ 's/\buplbi8a.pfb\b/p052024l.pfb/x',
+ 's/\buplr8a.pfb\b/p052003l.pfb/x',
+ 's/\buplri8a.pfb\b/p052023l.pfb/x',
+ 's/\busyr.pfb\b/s050000l.pfb/x',
+ 's/\butmb8a.pfb\b/n021004l.pfb/x',
+ 's/\butmbi8a.pfb\b/n021024l.pfb/x',
+ 's/\butmr8a.pfb\b/n021003l.pfb/x',
+ 's/\butmri8a.pfb\b/n021023l.pfb/x',
+ 's/\buzcmi8a.pfb\b/z003034l.pfb/x',
+ 's/\buzdr.pfb\b/d050000l.pfb/x'
+ );
+
+my @fileADOBE = (
+ 's/\buagd8a.pfb\b/agd_____.pfb/x',
+ 's/\buagdo8a.pfb\b/agdo____.pfb/x',
+ 's/\buagk8a.pfb\b/agw_____.pfb/x',
+ 's/\buagko8a.pfb\b/agwo____.pfb/x',
+ 's/\bubkd8a.pfb\b/bkd_____.pfb/x',
+ 's/\bubkdi8a.pfb\b/bkdi____.pfb/x',
+ 's/\bubkl8a.pfb\b/bkl_____.pfb/x',
+ 's/\bubkli8a.pfb\b/bkli____.pfb/x',
+ 's/\bucrb8a.pfb\b/cob_____.pfb/x',
+ 's/\bucrbo8a.pfb\b/cobo____.pfb/x',
+ 's/\bucrr8a.pfb\b/com_____.pfb/x',
+ 's/\bucrro8a.pfb\b/coo_____.pfb/x',
+ 's/\buhvb8a.pfb\b/hvb_____.pfb/x',
+ 's/\buhvb8ac.pfb\b/hvnb____.pfb/x',
+ 's/\buhvbo8a.pfb\b/hvbo____.pfb/x',
+ 's/\buhvbo8ac.pfb\b/hvnbo___.pfb/x',
+ 's/\buhvr8a.pfb\b/hv______.pfb/x',
+ 's/\buhvr8ac.pfb\b/hvn_____.pfb/x',
+ 's/\buhvro8a.pfb\b/hvo_____.pfb/x',
+ 's/\buhvro8ac.pfb\b/hvno____.pfb/x',
+ 's/\buncb8a.pfb\b/ncb_____.pfb/x',
+ 's/\buncbi8a.pfb\b/ncbi____.pfb/x',
+ 's/\buncr8a.pfb\b/ncr_____.pfb/x',
+ 's/\buncri8a.pfb\b/nci_____.pfb/x',
+ 's/\buplb8a.pfb\b/pob_____.pfb/x',
+ 's/\buplbi8a.pfb\b/pobi____.pfb/x',
+ 's/\buplr8a.pfb\b/por_____.pfb/x',
+ 's/\buplri8a.pfb\b/poi_____.pfb/x',
+ 's/\busyr.pfb\b/sy______.pfb/x',
+ 's/\butmb8a.pfb\b/tib_____.pfb/x',
+ 's/\butmbi8a.pfb\b/tibi____.pfb/x',
+ 's/\butmr8a.pfb\b/tir_____.pfb/x',
+ 's/\butmri8a.pfb\b/tii_____.pfb/x',
+ 's/\buzcmi8a.pfb\b/zcmi____.pfb/x',
+ 's/\buzdr.pfb\b/zd______.pfb/x'
+ );
+
+&main;
+
+exit 0;
+
+# if ($IsWin32) {
+
+# sub GetTempPath {
+# my $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', 'N');
+# if(not defined $GetTempPath) {
+# die "Can't import API GetTempPath: $!\n";
+# }
+# my $lpBuffer = " " x 260;
+
+# $GetTempPath->Call(80, $lpBuffer);
+# }
+
+# sub ShellExecute {
+# my ($command, $file) = @_;
+# my $ShellExecute = new Win32::API('shell32', 'ShellExecute', 'NPPPPN', 'N');
+# if(not defined $ShellExecute) {
+# die "Can't import API ShellExecute: $!\n";
+# }
+# $ShellExecute->Call(0, $command, $file, '', '', 0);
+# }
+
+# sub GetHomeDir {
+# my $home = $ENV{'HOME'};
+# # Should check for CSIDL_...
+# return $home;
+# }
+# }
+
+###############################################################################
+# getLines()
+# return the lines in $filename
+###############################################################################
+sub getLines {
+ my @lines = ();
+ foreach my $fname (@_) {
+ next if (! $fname);
+ open FILE, "<$fname" or die "can't get lines from $fname: $!";
+ push @lines, <FILE>;
+ close FILE;
+ }
+ chomp @lines;
+ return @lines;
+}
+
+###############################################################################
+# writeLines()
+# write the lines in $filename
+###############################################################################
+sub writeLines {
+ my ($fname, @lines) = @_;
+ map { ($_ !~ m/\n$/ ? s/$/\n/ : $_ ) } @lines;
+ open FILE, ">$fname" or die "can't write lines to $fname: $!";
+ print FILE @lines;
+ close FILE;
+}
+
+###############################################################################
+# copyFile()
+# copy file $src to $dst, sets $dst creation and mod time
+###############################################################################
+sub copyFile {
+ my ($src, $dst) = @_;
+
+ $src eq $dst && return "can't copy $src to itself!\n";
+
+ open IN, "<$src" or die "can't open source file $src for copying: $!";
+ open OUT, ">$dst";
+
+ binmode(IN);
+ binmode(OUT);
+ print OUT <IN>;
+ close(OUT);
+ close(IN);
+ my @t = stat($src);
+ utime($t[8], $t[9], $dst);
+}
+
+###############################################################################
+# start_redirection(), stop_redirection()
+# redirects stdout and stderr to log file (possibly "nul")
+###############################################################################
+sub start_redirection {
+ my ($log) = @_;
+
+ # start redirection if asked
+ if ($log) {
+ open(SO, ">&STDOUT");
+ open(SE, ">&STDERR");
+
+ close(STDOUT);
+ close(STDERR);
+
+ open(STDOUT, ">$log");
+ open(STDERR,">&STDOUT");
+
+ select(STDERR); $| = 1;
+ select(STDOUT); $| = 1;
+ }
+}
+
+sub stop_redirection {
+ close(STDOUT);
+ close(STDERR);
+ open(STDOUT, ">&SO");
+ open(STDERR, ">&SE");
+}
+
+###############################################################################
+# help()
+# display help message and exit
+###############################################################################
+sub help {
+ print "Usage: $0 [option] ... [command]\n";
+ print "\n";
+ print "Valid options:\n";
+ print " --cnffile file specify configuration file\n";
+ print " --dvipsoutputdir directory specify output directory (dvips syntax)\n";
+ print " --pdftexoutputdir directory specify output directory (pdftex syntax)\n";
+ print " --dvipdfmoutputdir directory specify output directory (dvipdfm syntax)\n";
+ print " --outputdir directory specify output directory (for all files)\n";
+ print " --nohash do not run texhash\n";
+ print " --nomkmap do not recreate map files\n";
+ print " --quiet reduce verbosity\n";
+ print "\n";
+ print "Valid commands:\n";
+ print " --edit edit updmap.cfg file\n";
+ print " --help show this message\n";
+ print " --showoptions item show alternatives for options\n";
+ print " --setoption option=value set option where option is one\n";
+ print " of dvipsPreferOutline, LW35, dvipsDownloadBase35\n";
+ print " or pdftexDownloadBase14\n";
+ print " --enable maptype=mapfile add or enable a Map or MixedMap\n";
+ print " --disable mapfile disable Map or MixedMap for mapfile\n";
+ print " --listmaps list all active and inactive maps\n";
+ exit 0;
+}
+
+###############################################################################
+# abort(errmsg)
+# print `errmsg' to stderr and exit with error code 1
+###############################################################################
+sub abort {
+ my ($msg) = @_;
+ print STDERR "$progname: $msg\n";
+ exit 1;
+}
+
+###############################################################################
+# cfgval(variable)
+# read variable ($1) from config file
+###############################################################################
+sub cfgval {
+ my ($variable) = @_;
+ my $value;
+
+ if ($#cfg < 0) {
+ open FILE, "<$cnfFile" or die "can't open configuration file $cnfFile: $!";
+ @cfg = <FILE>;
+ close FILE;
+ }
+ for my $line (@cfg) {
+ if ($line =~ m/^\s*${variable}[\s=]+(.*)\s*$/) {
+ $value = $1;
+ if ($value =~ m/^(true|yes|t|y|1)$/) {
+ $value = 1;
+ }
+ else {
+ $value = 0;
+ }
+ break;
+ }
+ }
+ print "$variable => " . ($value ? "true\n" : "false\n");
+ return $value;
+}
+
+###############################################################################
+# setupSymlinks()
+# set symlink for psfonts.map according to dvipsPreferOutline variable
+###############################################################################
+sub setupSymlinks {
+ my $src;
+
+ if ($dvipsPreferOutline ) {
+ $src = "psfonts_t1.map";
+ } else {
+ $src = "psfonts_pk.map";
+ }
+ unlink "$dvipsoutputdir/psfonts.map";
+ &copyFile("$dvipsoutputdir/$src", "$dvipsoutputdir/psfonts.map");
+
+ if ($pdftexDownloadBase14) {
+ $src = "pdftex_dl14.map";
+ } else {
+ $src = "pdftex_ndl14.map";
+ }
+ unlink "$pdftexoutputdir/pdftex.map";
+ &copyFile("$pdftexoutputdir/$src", "$pdftexoutputdir/pdftex.map");
+
+ if ($dvipdfmDownloadBase14) {
+ $src = "dvipdfm_dl14.map";
+ } else {
+ $src = "dvipdfm_ndl14.map";
+ }
+ unlink "$dvipdfmoutputdir/dvipdfm.map";
+ &copyFile("$dvipdfmoutputdir/$src", "$dvipdfmoutputdir/dvipdfm.map");
+}
+
+###############################################################################
+# transLW35(args ...)
+# transform fontname and filenames according to transformation specified
+# by mode
+###############################################################################
+sub transLW35 {
+ my ($name) = @_;
+ my @lines = &getLines($name);
+
+ if ($mode eq "" || $mode eq "URWkb") {
+ # do nothing
+ } elsif ($mode eq "URW") {
+ for my $r (@fileURW) {
+ map { eval($r); } @lines;
+ }
+ } elsif ($mode eq "ADOBE" || $mode eq "ADOBEkb") {
+ for my $r (@psADOBE) {
+ map { eval($r); } @lines;
+ }
+ my @filemode = eval ("\@file" .$mode);
+ for my $r (@filemode) {
+ map { eval($r); } @lines;
+ }
+ }
+ return @lines;
+}
+
+###############################################################################
+# locateWeb2c (file ...)
+# apply kpsewhich with format 'web2c files'
+###############################################################################
+sub locateWeb2c {
+
+ my @files = @_;
+
+ return @files if ($#files < 0);
+
+ @files = split (/\n/, `kpsewhich --format="web2c files" @files`);
+
+ if (wantarray) {
+ return @files;
+ }
+ else {
+ return $files[0];
+ }
+}
+
+###############################################################################
+# locateMap (file ...)
+# apply kpsewhich with format 'dvips config'
+###############################################################################
+sub locateMap {
+ my @files = @_;
+
+ return @files if ($#files < 0);
+
+ @files = `kpsewhich --format=map @files`;
+ if (wantarray) {
+ return @files;
+ }
+ else {
+ return $files[0];
+ }
+}
+
+###############################################################################
+# catMaps(regex)
+# filter config file by regex for map lines and extract the map filenames.
+# These are then looked up (by kpsewhich in locateMap) and the content of
+# all map files is send to stdout.
+###############################################################################
+sub catMaps {
+ my ($map) = @_;
+ my %count = ( );
+ my @maps = grep { $_ =~ m/$map/ } @cfg;
+ map{
+ $_ =~ s/\#.*//;
+ $_ =~ s/\s*([^\s]*)\s*([^\s]*)/\2/;
+ } @maps;
+ @maps = sort(@maps);
+ @maps = grep { ++$count{$_} < 2; } @maps;
+
+ @maps = &locateMap(@maps);
+ return @maps;
+}
+
+###############################################################################
+# configReplace(file, pattern, line)
+# The first line in file that matches pattern gets replaced by line.
+# line will be added at the end of the file if pattern does not match.
+###############################################################################
+sub configReplace {
+ my ($file, $pat, $line) = @_;
+ my @lines = &getLines($file);
+ my $found = 0;
+ map {
+ if (/$pat/) {
+ $found = 1; $_ = $line;
+ }
+ } @lines;
+ if (! $found) {
+ push @lines, $line;
+ }
+ &writeLines($file, @lines);
+}
+
+###############################################################################
+# setOption (option, value)
+# sets option to value in the config file (replacing the existing setting
+# or by adding a new line to the config file).
+###############################################################################
+sub setOption {
+ my ($opt, $val) = @_;
+
+ if ($opt eq "LW35") {
+ if ($val !~ m/^(URWkb|URW|ADOBE|ADOBEkb)$/) {
+ printf STDERR "invalid value $val for option $opt\n";
+ exit 1;
+ }
+ }
+ elsif ($opt =~ m/^(dvipsPreferOutline|dvipsDownloadBase35|pdftexDownloadBase14|dvipdfmDownloadBase14)$/) {
+ if ($val !~ m/^(true|false)$/) {
+ printf STDERR "invalid value $val for option $opt\n";
+ exit 1;
+ }
+ }
+ else {
+ printf STDERR "unsupported option $opt\n";
+ exit 1;
+ }
+
+ &configReplace("$cnfFile", "^" . "$opt" . "\\s", "$opt $val");
+}
+
+###############################################################################
+# enableMap (type, map)
+# enables an entry in the config file for map with a given type.
+###############################################################################
+sub enableMap {
+ my ($type, $map) = @_;
+
+ if ($type !~ m/^(Map|MixedMap)$/) {
+ printf STDERR "invalid mapType $type\n";
+ exit 1;
+ }
+ # a map can only have one type, so we carefully disable everything
+ # about map here:
+ &disableMap("$map");
+
+ # now enable with the right type:
+ &configReplace("$cnfFile", "^#!\\s*" . "$type" . "\\s*$map", "$type $map");
+}
+
+###############################################################################
+# disableMap (map)
+# disables map in config file (any type)
+###############################################################################
+sub disableMap {
+ my ($map) = @_;
+ my %count = ( );
+ my $type;
+
+ my @mapType = grep {
+ my @fields = split;
+ if ($fields[0] =~ /^(MixedMap|Map)$/
+ and $fields[1] eq $map
+ and ++$count{$fields[0]}) {
+ $_ = $fields[0];
+ }
+ else {
+ $_ = '';
+ }
+ } &getLines($cnfFile);
+
+ foreach $type (@mapType) {
+ &configReplace("$cnfFile", "^$type" . "\\s*$map", "#! $type $map");
+ }
+}
+
+###############################################################################
+# initVars()
+# initialize global variables
+###############################################################################
+sub initVars {
+ $progname="updmap";
+
+ $quiet = 0;
+ $texhashEnabled = 1;
+ $mkmapEnabled = 1;
+ $verbose = 1;
+ $needsCleanup = 0;
+
+ $cnfFile = "";
+ $cnfFileShort = "updmap.cfg";
+ $outputdir = "";
+ $TEXMFMAIN =`kpsewhich --expand-var="\$TEXMFMAIN"`;
+ chomp($TEXMFMAIN);
+ # tmpdir=${TMP-/tmp}/$progname.$$
+ # tmp1=$tmpdir/a
+ # tmp2=$tmpdir/b
+ # tmp3=$tmpdir/c
+}
+
+###############################################################################
+# setupTmpDir()
+# set up a temp directory and a trap to remove it
+###############################################################################
+sub setupTmpDir {
+
+}
+
+###############################################################################
+# showOptions(item)
+# show Options for an item
+###############################################################################
+sub showOptions {
+
+ foreach my $item (@_) {
+ if ($item eq "LW35") {
+ print "URWkb URW ADOBE ADOBEkb\n";
+ }
+ elsif ($item =~ m/"(dvipsPreferOutline|pdftexDownloadBase14|dvipdfmDownloadBase14|dvipsDownloadBase35)"/) {
+ print "true false\n";
+ }
+ else {
+ print "Unknown item \"$item\". Choose one of LW35, dvipsPreferOutline, dvipsDownloadBase35, pdftexDownloadBase14 or dvipdfmDownloadBase14\n";
+# exit 1;
+ }
+ }
+
+ exit 0
+}
+
+###############################################################################
+# setupDestDir()
+# find an output directory if none specified on cmd line. First choice is
+# $TEXMFVAR/fonts/map/updmap (if TEXMFVAR is set), next is relative to
+# config file location. Fallback is $TEXMFMAIN/fonts/map/updmap.
+###############################################################################
+sub setupOutputDir {
+ my($od, $driver) = @_;
+
+ if (!$od) {
+ my $rel = "fonts/map/$driver/updmap";
+
+ # Try TEXMFVAR tree. Use it if variable is set and $rel can
+ # be written. Copy config file if it does not exist there.
+ my $tf = `kpsewhich -expand-var="\$TEXMFVAR"`;
+ chomp($tf);
+ if ($tf) {
+ mkpath("$tf/$rel");
+ # system("$TEXMFMAIN/web2c/mktexdir \"$tf/$rel\"");
+ if (! -d "$tf/$rel" || ! -w "$tf/$rel") {
+ # forget about TEXMFVAR tree...
+ $tf = "";
+ }
+ }
+
+ # Try something relative to config file, fall back to $TEXMFMAIN.
+ if (! $tf) {
+ $tf = $cnfFile;
+ if ($tf =~ m@/web2c/[^/]*$@) {
+ $tf =~ s@/web2c/[^/]*$@@;
+ }
+ else {
+ $tf = "";
+ }
+ $tf = $TEXMFMAIN if (! $tf);
+ }
+
+ $od = "$tf/$rel";
+ }
+
+ # No need to call mktexdir !
+ # system("$TEXMFMAIN/bin/win32/mktexdir \"$od\"");
+ mkpath($od);
+ &abort("output directory `$od' does not exist\n") if (! -d $od);
+ &abort("output directory `$od' is not writable\n") if (! -w $od);
+ print "using $driver output directory `$od'\n";
+
+ return $od;
+}
+
+sub setupDestDir {
+
+ $dvipsoutputdir = &setupOutputDir($dvipsoutputdir, "dvips");
+ $pdftexoutputdir = &setupOutputDir($pdftexoutputdir, "pdftex");
+ $dvipdfmoutputdir = &setupOutputDir($dvipdfmoutputdir, "dvipdfm");
+
+}
+
+###############################################################################
+# setupCfgFile()
+# find config file if none specified on cmd line.
+###############################################################################
+sub setupCfgFile {
+
+ if (! $cnfFile) {
+ my $tf = `kpsewhich -expand-var="\$TEXMFVAR"`;
+ chomp($tf);
+ if ($tf && ! -f "$tf/web2c/$cnfFileShort") {
+ mkpath("$tf/web2c") if (! -d "$tf/web2c");
+# &start_redirection("nul");
+# system("mktexdir $tf/web2c");
+# &stop_redirection;
+ if (-d "$tf/web2c" && -w "$tf/web2c") {
+ unlink "$tf/web2c/$cnfFileShort";
+ &copyFile("$TEXMFMAIN/web2c/$cnfFileShort", "$tf/web2c/$cnfFileShort");
+ &start_redirection("nul");
+ system("mktexupd $tf/web2c $cnfFileShort");
+ &stop_redirection;
+ }
+ }
+
+ $cnfFile = &locateWeb2c("updmap.cfg");
+ if ($cnfFile) {
+ print "using config file $cnfFile\n" if (! $quiet);
+ }
+ else {
+ &abort("config file updmap.cfg not found");
+ }
+ }
+}
+
+
+###############################################################################
+# processOptions()
+# process cmd line options
+###############################################################################
+sub processOptions {
+
+ unless (&NGetOpt ("quiet" => \$quiet,
+ "cnffile=s" => \$cnfFile,
+ "outputdir=s" => \$outputdir,
+ "dvipsoutputdir=s" => \$dvipsoutputdir,
+ "pdftexoutputdir=s" => \$pdftexoutputdir,
+ "dvipdfmoutputdir=s" => \$dvipdfmoutputdir,
+ "setoption=s" => \%setOption,
+ "enable=s" => \%enableItem,
+ "disable=s" => \@disableItem,
+ "edit" => \$opt_edit,
+ "listmaps" => \$listmaps,
+ "showoptions=s" => \@showoptions,
+ "hash!" => \$texhashEnabled,
+ "mkmap!" => \$mkmapEnabled,
+ "verbose" => \$verbose,
+ "debug" => \$debug,
+ "help" => \$opt_help)) {
+ print STDERR "Try `$0 --help'";
+ exit 1;
+ }
+
+ if ($outputdir) {
+ $dvipsoutputdir = $outputdir if (! $dvipsoutputdir);
+ $pdftexoutputdir = $outputdir if (! $pdftexoutputdir);
+ $dvipdfmoutputdir = $outputdir if (! $dvipdfmoutputdir);
+ }
+ if ($cnfFile && ! -f $cnfFile) {
+ &abort("config file `$cnfFile' not found");
+ }
+
+ if ($dvipsoutputdir && ! -d $dvipsoutputdir) {
+ &abort("dvips output directory `$dvipsoutputdir' not found");
+ }
+ if ($pdftexoutputdir && ! -d $pdftexoutputdir) {
+ &abort("pdftex output directory `$pdftexoutputdir' not found");
+ }
+ if ($dvipdfmoutputdir && ! -d $dvipdfmoutputdir) {
+ &abort("dvipdfm output directory `$dvipdfmoutputdir' not found");
+ }
+
+}
+
+###############################################################################
+# listMaps()
+# list all maps mentioned in the config file
+###############################################################################
+sub listMaps {
+ my @lines = grep {
+ $_ =~ m/^(\#! *)?(Mixed)?Map/
+ } &getLines($cnfFile);
+ map { print "$_\n"; } @lines;
+# &writeLines("con", @lines);
+}
+
+###############################################################################
+# normalizeLines()
+# remove comments, whitespace is exactly one space, no empty lines,
+# no whitespace at end of line, one space before and after "
+###############################################################################
+sub normalizeLines {
+ my @lines = @_;
+ my %count = ();
+
+ @lines = grep { $_ !~ m/^[*#;%]/ } @lines;
+ map {$_ =~ s/\s+/ /gx } @lines;
+ @lines = grep { $_ !~ m/^\s*$/x } @lines;
+ map { $_ =~ s/\s$//x ;
+ $_ =~ s/\s*\"\s*/ \" /gx;
+ $_ =~ s/\" ([^\"]*) \"/\"\1\"/gx;
+ } @lines;
+
+ @lines = grep {++$count{$_} < 2 } (sort @lines);
+
+ return @lines;
+}
+
+###############################################################################
+# dvips2dvipdfm()
+# reads from stdin, writes to stdout. It transforms "dvips"-like syntax into
+# "dvipdfm"-like syntax. It is a very ugly hack.
+###############################################################################
+sub dvips2dvipdfm {
+ my @lines = @_;
+
+ map {
+ $_ =~ s@$@ %@;
+ $_ =~ s@^(([^ ]*).*)@\1\2@;
+ $_ =~ s@(.*<\[* *([^ ]*)\.enc(.*))@\1 \2@;
+ $_ = (m/%[^ ]*$/x ? "$_ default" : $_) ;
+ $_ =~ s@(.*<<* *([^ ]*)\.pf[ab].*)@\1 \2@;
+ if (m/%[^ ]* [^ ]*$/x) { $_ =~ s@( ([^ ]*).*)$@\1 \2@; }
+ $_ =~ s@(.* ([\.0-9-][\.0-9-]*) *ExtendFont.*)@\1 -e \2@;
+ $_ =~ s@(.* ([\.0-9-][\.0-9-]*) *SlantFont.*)@\1 -s \2@;
+ $_ =~ s@.*%@@ ;
+ } @lines;
+
+ map {
+ my @elts = split (' ', $_);
+ if ($elts[0] eq $elts[2]
+ && $elts[1] eq "default") {
+ $elts[1] = '';
+ $elts[2] = '';
+ };
+ $_ = join ' ',@elts;
+ } @lines;
+
+ map {
+ if (/^(cm|eu|la|lc|line|msam|xy)/) {
+ $_ .= " -r" ;
+ $_ =~ s/(fmex[789]) -r/\1/;
+ }
+ } @lines;
+
+ return @lines;
+}
+
+###############################################################################
+# mkMaps()
+# the main task of this script: create the output files
+###############################################################################
+sub mkMaps {
+
+ $mode = &cfgval("LW35");
+ $mode = "URWkb" if ($mode = undef);
+
+ $dvipsPreferOutline = &cfgval("dvipsPreferOutline");
+ $dvipsPreferOutline = 1 if ($dvipsPreferOutline eq undef);
+
+ $dvipsDownloadBase35 = &cfgval("dvipsDownloadBase35");
+ $dvipsDownloadBase35 = 0 if ($dvipsDownloadBase35 eq undef);
+
+ $pdftexDownloadBase14 = &cfgval("pdftexDownloadBase14");
+ $pdftexDownloadBase14 = 0 if ($pdftexDownloadBase14 eq undef);
+
+ $dvipdfmDownloadBase14 = &cfgval("dvipdfmDownloadBase14");
+ $dvipdfmDownloadBase14 = 0 if ($dvipdfmDownloadBase14 eq undef);
+
+ if (! $quiet) {
+ print "\
+updmap is creating new map files using the following configuration:\
+\
+ config file : " . ($cnfFile ? "true" : "false") ."\
+ prefer outlines : " . ($dvipsPreferOutline ? "true" : "false") ."\
+ texhash enabled : " . ($texhashEnabled ? "true" : "false") ."\
+ download standard fonts (dvips) : " . ($dvipsDownloadBase35 ? "true" : "false") ."\
+ download standard fonts (pdftex) : " . ($pdftexDownloadBase14 ? "true" : "false") . "\
+ download standard fonts (dvipdfm): " . ($dvipdfmDownloadBase14 ? "true" : "false") . "\
+"
+ };
+
+ print "Scanning for LW35 support files\n" if (! $quiet);
+ $dvips35 = &locateMap("dvips35.map");
+ $pdftex35 = &locateMap("pdftex35.map");
+ $dvipdfm35 = &locateMap("dvipdfm35.map");
+ $ps2pk35 = &locateMap("ps2pk35.map");
+
+ print "Scanning for MixedMap entries\n" if (! $quiet);
+ my @tmp1 = &catMaps('^MixedMap');
+ print "Scanning for Map entries\n" if (! $quiet);
+ my @tmp2 = &catMaps('^Map');
+
+ # Create psfonts_t1.map, psfonts_pk.map, ps2pk.map and pdftex.map:
+ for my $file ("$dvipsoutputdir/download35.map",
+ "$dvipsoutputdir/builtin35.map",
+ "$dvipsoutputdir/psfonts_t1.map",
+ "$dvipsoutputdir/psfonts_pk.map",
+ "$pdftexoutputdir/pdftex_dl14.map",
+ "$pdftexoutputdir/pdftex_ndl14.map",
+ "$dvipdfmoutputdir/dvipdfm_dl14.map",
+ "$dvipdfmoutputdir/dvipdfm_ndl14.map",
+ "$dvipsoutputdir/ps2pk.map") {
+ open FILE, ">$file";
+ print FILE "% $file: maintained by the script updmap.\
+% Don't change this file directly. Edit texmf/web2c/$cnfFileShort\
+% and run updmap to recreate this file.\
+";
+ close FILE;
+ }
+
+# print "$dvips35 $pdftex35 $dvipdfm35 $ps2pk35 @tmp1 @tmp2\n";
+
+ my @ps2pk_map = &transLW35($ps2pk35);
+ push @ps2pk_map, &getLines(@tmp1);
+ push @ps2pk_map, &getLines(@tmp2);
+ &writeLines(">$dvipsoutputdir/ps2pk.map", &normalizeLines(@ps2pk_map));
+
+ my @download35_map = &transLW35($ps2pk35);
+ &writeLines(">$dvipsoutputdir/download35.map", &normalizeLines(@download35_map));
+ my @builtin35_map = &transLW35($dvips35);
+ &writeLines(">$dvipsoutputdir/builtin35.map", &normalizeLines(@builtin35_map));
+
+ my $dftdvips = ($dvipsDownloadBase35 ? $ps2pk35 : $dvips35);
+
+ my @psfonts_t1_map = &transLW35($dftdvips);
+ push @psfonts_t1_map, &getLines(@tmp1);
+ push @psfonts_t1_map, &getLines(@tmp2);
+ &writeLines(">$dvipsoutputdir/psfonts_t1.map", &normalizeLines(@psfonts_t1_map));
+
+ my @psfonts_pk_map = &transLW35($dftdvips);
+ push @psfonts_pk_map, &getLines(@tmp2);
+ &writeLines(">$dvipsoutputdir/psfonts_pk.map", &normalizeLines(@psfonts_pk_map));
+
+ # remove PaintType due to Sebastian's request
+ my @tmp3 = &transLW35($pdftex35);
+ push @tmp3, &getLines(@tmp1);
+ push @tmp3, &getLines(@tmp2);
+ @tmp3 = grep { $_ !~ m/(^%|PaintType)/ } @tmp3;
+
+ my @tmp6 = &transLW35($dvipdfm35);
+ push @tmp6, &getLines(@tmp1);
+ push @tmp6, &getLines(@tmp2);
+ @tmp6 = grep { $_ !~ m/(^%|PaintType)/ } @tmp6;
+
+ my @tmp7 = &transLW35($ps2pk35);
+ push @tmp7, &getLines(@tmp1);
+ push @tmp7, &getLines(@tmp2);
+ @tmp7 = grep { $_ !~ m/(^%|PaintType)/ } @tmp7;
+
+ my @pdftex_ndl14_map = @tmp3;
+ @pdftex_ndl14_map = &normalizeLines(@pdftex_ndl14_map);
+ &writeLines(">$pdftexoutputdir/pdftex_ndl14.map", @pdftex_ndl14_map);
+
+ my @pdftex_dl14_map = @tmp7;
+ @pdftex_dl14_map = &normalizeLines(@pdftex_dl14_map);
+ &writeLines(">$pdftexoutputdir/pdftex_dl14.map", @pdftex_dl14_map);
+
+ my @dvipdfm_dl14_map = @tmp7;
+ @dvipdfm_dl14_map = &normalizeLines(&dvips2dvipdfm(&normalizeLines(@dvipdfm_dl14_map)));
+ &writeLines(">$dvipdfmoutputdir/dvipdfm_dl14.map", @dvipdfm_dl14_map);
+
+ my @dvipdfm_ndl14_map = @tmp6;
+ @dvipdfm_ndl14_map = &normalizeLines(&dvips2dvipdfm(&normalizeLines(@dvipdfm_ndl14_map)));
+ &writeLines(">$dvipdfmoutputdir/dvipdfm_ndl14.map", @dvipdfm_ndl14_map);
+
+ &setupSymlinks;
+
+ if ($texhashEnabled) {
+ my $cmd = "mktexlsr";
+ &start_redirection("nul") if ($quiet);
+ system($cmd);
+ &stop_redirection if ($quiet);
+ }
+
+ if (! $quiet) {
+ print STDOUT "Files generated:\n";
+ for my $f ("$dvipsoutputdir/download35.map",
+ "$dvipsoutputdir/builtin35.map",
+ "$dvipsoutputdir/psfonts_t1.map",
+ "$dvipsoutputdir/psfonts_pk.map",
+ "$pdftexoutputdir/pdftex_dl14.map",
+ "$pdftexoutputdir/pdftex_ndl14.map",
+ "$dvipdfmoutputdir/dvipdfm_dl14.map",
+ "$dvipdfmoutputdir/dvipdfm_ndl14.map",
+ "$dvipsoutputdir/ps2pk.map") {
+ $f =~ s@/@\\@g; $f = "\"$f\"" if ($f =~ m/\s/);
+ my @lines = `dir $f`;
+ chomp @lines;
+ my $rx = "(^ |dvipdfm.map|dvipdfm_dl14.map|dvipdfm_ndl14.map|pdftex.map|pdftex_dl14.map|pdftex_ndl14.map|ps2pk.map|psfonts.map|psfonts_pk.map|psfonts_t1.map|builtin35.map|download35.map)";
+ @lines = grep /$rx/, @lines;
+ map { print "$_\n"; } @lines;
+ }
+ }
+}
+
+###############################################################################
+# main()
+# execution starts here
+###############################################################################
+sub main {
+
+ &initVars;
+ &processOptions;
+
+ if (@showoptions) {
+ &showOptions(@showoptions);
+ exit 0;
+ }
+
+ &help if ($opt_help);
+
+ &setupCfgFile;
+
+ if ($listmaps) {
+ &listMaps;
+ exit 0;
+ }
+
+ my $bakFile = $cnfFile;
+ $bakFile =~ s/\.cfg$/.bak/;
+ &copyFile($cnfFile, $bakFile);
+
+ my $cmd = '';
+
+ if ($opt_edit) {
+ my $editor = `kpsewhich --expand-var \$TEXEDIT`;
+ chomp($editor);
+ $editor = "notepad" if ($editor eq "");
+ $cmd = 'edit';
+ system("$editor $cnfFile");
+ }
+
+ elsif (keys %setOption) {
+ $cmd = 'setOption';
+ foreach my $m (keys %setOption) {
+ &setOption ($m, $setOption{$m});
+ }
+ }
+
+ elsif (keys %enableItem) {
+ $cmd = 'enableMap';
+ foreach my $m (keys %enableItem) {
+ &enableMap($m, $enableItem{$m});
+ }
+ }
+ elsif (@disableItem) {
+ $cmd = 'disableMap';
+ foreach my $m (@disableItem) {
+ &disableMap($m);
+ }
+ }
+
+ if ($cmd && ! compare($bakFile, $cnfFile)) {
+ print "$cnfFile unchanged. Map files not recreated.\n" unless ($quiet);
+ }
+ else {
+ if ($mkmapEnabled) {
+ &setupDestDir;
+ &mkMaps;
+ }
+ # &cleanup;
+ unlink ($bakFile);
+ }
+
+}
diff --git a/Master/texmf/scripts/tex4ht/htcopy.pl b/Master/texmf/scripts/tex4ht/htcopy.pl
new file mode 100644
index 00000000000..2d52965ebf5
--- /dev/null
+++ b/Master/texmf/scripts/tex4ht/htcopy.pl
@@ -0,0 +1,45 @@
+use File::Copy;
+use File::Path;
+use File::Basename;
+
+&main ;
+
+0;
+
+sub is_absolute {
+ my ($f) = @_;
+ return $f =~ m@^([a-zA-Z]:)?[\\/]@ ;
+}
+
+sub canonicalize {
+ my ($f) = @_;
+ $f =~ s@/@\\@g;
+ return $f;
+}
+
+sub main {
+ my $src = &canonicalize($ARGV[0]);
+ my $dst = &canonicalize($ARGV[1]);
+
+ if (&is_absolute($src)) {
+ if (-d $dst) {
+ $dst = $dst . "\\" . &basename($src);
+ }
+ }
+ else {
+ if (-d $dst) {
+ $dst = "$dst\\$src";
+ &mkpath(&dirname($dst));
+ }
+ }
+
+ if ($0 =~ m/htmove\.pl$/) {
+ &move($src, $dst);
+ }
+ elsif ($0 =~ m/htcopy\.pl$/) {
+ &copy($src, $dst);
+ }
+ else {
+ print STDERR "$0: bad verb $ARGV[0]\n";
+ }
+}
diff --git a/Master/texmf/scripts/tex4ht/htmove.pl b/Master/texmf/scripts/tex4ht/htmove.pl
new file mode 100644
index 00000000000..2d52965ebf5
--- /dev/null
+++ b/Master/texmf/scripts/tex4ht/htmove.pl
@@ -0,0 +1,45 @@
+use File::Copy;
+use File::Path;
+use File::Basename;
+
+&main ;
+
+0;
+
+sub is_absolute {
+ my ($f) = @_;
+ return $f =~ m@^([a-zA-Z]:)?[\\/]@ ;
+}
+
+sub canonicalize {
+ my ($f) = @_;
+ $f =~ s@/@\\@g;
+ return $f;
+}
+
+sub main {
+ my $src = &canonicalize($ARGV[0]);
+ my $dst = &canonicalize($ARGV[1]);
+
+ if (&is_absolute($src)) {
+ if (-d $dst) {
+ $dst = $dst . "\\" . &basename($src);
+ }
+ }
+ else {
+ if (-d $dst) {
+ $dst = "$dst\\$src";
+ &mkpath(&dirname($dst));
+ }
+ }
+
+ if ($0 =~ m/htmove\.pl$/) {
+ &move($src, $dst);
+ }
+ elsif ($0 =~ m/htcopy\.pl$/) {
+ &copy($src, $dst);
+ }
+ else {
+ print STDERR "$0: bad verb $ARGV[0]\n";
+ }
+}
diff --git a/Master/texmf/scripts/thumbpdf/thumbpdf.pl b/Master/texmf/scripts/thumbpdf/thumbpdf.pl
new file mode 100644
index 00000000000..832e4e76717
--- /dev/null
+++ b/Master/texmf/scripts/thumbpdf/thumbpdf.pl
@@ -0,0 +1,1562 @@
+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
+#
+# thumbpdf.pl
+#
+# Copyright (C) 1999-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.txt" for a list of files that belong to this project.
+#
+# This file "thumbpdf.pl" may be renamed to "thumbpdf"
+# for installation purposes.
+#
+my $file = "thumbpdf.pl";
+my $program = uc($&) if $file =~ /^\w+/;
+my $version = "3.8";
+my $date = "2005/07/06";
+my $author = "Heiko Oberdiek";
+my $copyright = "Copyright (c) 1999-2005 by $author.";
+#
+# Reqirements: Perl5, Ghostscript
+# History:
+# 1999/02/14 v1.0: First release.
+# 1999/02/23 v1.1:
+# * Looking for the media box to calculate the resolution
+# for Ghostscript
+# * new option --resolution
+# 1999/03/01 v1.2:
+# * optimization: indirect objects for length values removed.
+# * "first line" from epstopdf
+# 1999/03/12 v1.3:
+# * Copyright: LPPL
+# 1999/05/05 v1.4:
+# * Detecting of cygwin32 environment.
+# * Minor corrections of output of error messages.
+# * Sharing RGB objects.
+# 1999/06/13 v1.5:
+# * gs detection extended.
+# 1999/07/27 v1.6
+# 1999/08/08 v1.7:
+# * \immediate before \pdfobj (pdfTeX 0.14a)
+# 1999/09/09 v1.8
+# 1999/09/06 v1.9:
+# * Check for direct /Length values (for jpg images)
+# 2000/01/11 v1.10:
+# * Bug fix: /Length (direct) as last entry.
+# * Direct /Length in RGB objects supported.
+# 2000/01/19 v1.11:
+# * "for (my $j=0;...;...)" replaced by "my $j; for($j=0;...;...)",
+# because there exist perl versions that have problems with.
+# 2000/02/11 v1.12:
+# * Option `clean' added.
+# * The name of thumbnail data file: jobname.tnd,
+# if thumbpdf is called: thumbpdf jobname[.pdf] [options]
+# 2000/02/22 v2.0:
+# * pdfmark support for dvips/ps2pdf route added.
+# * <jobname>.tpt replaces thumbdta.tex (for pdfTeX)
+# <jobname>.tpm (for pdfmark)
+# <jobname>.top replaces thumbopt.tex
+# * Options `useps', `modes' added,
+# `makedef' renamed to `makedata'.
+# 2000/02/28 v2.1:
+# * Environment variable `THUMBPDF' supported.
+# 2000/03/07 v2.2:
+# * Support for Distiller 3 and 4, the streams are uncompressed.
+# * Call of gs is changed in order to show the currently processed
+# page number of the pdf file.
+# * Option --printgscmd creates the command line file `thumbpdf.gs'
+# for the Ghostscript call.
+# 2000/03/22 v2.3:
+# * Bug fix: --useps now works.
+# 2000/04/10 v2.4:
+# * Fix for ActiveState Perl 5.6.0: uc line changed, fork removed.
+# (Thanks to Andreas Buehmann <andreas.buehmann@gmx.de>.)
+# * Version test for thumbpdf.tex added for users that
+# mix versions, sigh.
+# 2000/07/29 v2.5:
+# * `save' trick in call of ghostscript.
+# * Undocumented option --gspages added.
+# 2000/09/27 v2.6
+# 2000/10/27 v2.7:
+# * -dFIXEDMEDIA=0 added in gs call
+# 2001/01/12 v2.8:
+# * Bug fix in dvips mode and active option `level2':
+# pack parameter corrected for little-endian machines.
+# * /Rotate in pdf pages:
+# ghostscript versions around 6.01 have added a hack
+# in /pdfshowpage_setpage, that ignores the /Rotate entry.
+# A patch is added to disable the hack.
+# * Ghostscript uses the MediaBox for calculating the
+# page size. For version 6.50 a patch is added to use
+# the /CropBox instead.
+# 2001/03/29 v2.9:
+# * Option --password added.
+# 2001/04/02 v2.10
+# 2001/04/26 v2.11
+# * Option --antialias added (suggestion of Juergen Bausa).
+# 2002/01/11 v3.0
+# * Syntax of option --antialias changed (see readme.txt).
+# * Support for VTeX's PS mode added.
+# * Greek mode added (see readme.txt).
+# * Signal handlers added for cleanup.
+# 2002/05/26 v3.1
+# * SIG_HUP unkown in Windows.
+# * Bug fix: The signal function for __DIE__ "cleanup" aborts
+# before the error message of "die" is printed.
+# Replaced by "clean" that does not contain "exit 1".
+# * Small bug fix in mode detection and mode "vtex"
+# removed from list. "vtexpdfmark" was detected,
+# "vtex" did not work and perhaps it will be used
+# later for VTeX in PDF mode.
+# 2002/05/26 v3.2
+# * Fix: "MacOS/X: darwin" is now not interpreted as
+# Windows.
+# 2003/03/19 v3.3
+# * Fix for gs 8.00 in mode dvips:
+# THB_DistillerPatch also applied to ghostscript >= 8.00.
+# 2003/06/06 v3.4
+# * Bug fix, two forgotten "pop"s added for Distiller case.
+# 2004/10/24 v3.5
+# * Revert Cygwin detection: is unix (request by Jan Nieuwenhuizen).
+# * LPPL 1.3.
+# 2004/11/19 v3.6
+# * Bug fix for dvips mode and gs < 8.00 (/stackunderflow in pop).
+# 2004/11/19 v3.7:
+# * For easier debugging, the special thumbpdf objects of
+# thumbpdf.pdf are now valid PDF objects (dictionaries).
+# * Remove of extra '\n' before "endstream" that is added
+# by pdfTeX 1.20a.
+# 2005/07/06 v3.8:
+# * Fix because of pdfTeX 1.30.
+#
+
+### program identification
+my $title = "$program $version, $date - $copyright\n";
+
+### error strings
+my $Error = "!!! Error:"; # error prefix
+
+### string constants for Ghostscript run
+# get Ghostscript command name
+my $GS = "gs";
+$GS = "gs386" if $^O =~ /dos/i;
+$GS = "gsos2" if $^O =~ /os2/i;
+$GS = "gswin32c" if $^O =~ /mswin32/i;
+
+# Windows detection (no SIGHUP)
+my $Win = 0;
+$Win = 1 if $^O =~ /mswin32/i;
+
+my $gspages = 1;
+$gspages = 0 if $^O =~ /dos/i;
+
+### variables
+my $jobname = "";
+my $jobfile = "";
+my $pdftexfile = "";
+my $pdfmarkfile = "";
+my $psext = ".ps";
+my $pdfext = ".pdf";
+my $pdftexext = ".tpt";
+my $pdfmarkext = ".tpm";
+my $thumbprefix = "thb";
+my $envvar = "THUMBPDF";
+my $pdffile = "thumbpdf.pdf";
+my $logfile = "thumbpdf.log";
+my $texfile = "thumbpdf";
+my $package = "thumbpdf.sty";
+my $readme = "readme.txt";
+my $gscnffile = "thumbpdf.gs";
+my $gssection = "section I. `Known Problems'";
+my @cleanlist = ();
+my $resolution = 9;
+my $mode_pdftex = 0;
+my $mode_pdfmark = 0;
+my $antialias_default = "4";
+my @arglist = @ARGV;
+my $gskidrunning = 0;
+
+### option variables
+my @bool = ("false", "true");
+$::opt_device = "png16m";
+$::opt_compress = "10";
+$::opt_resolution = "";
+$::opt_modes = "pdftex";
+$::opt_gscmd = "";
+$::opt_level2 = 0;
+$::opt_help = 0;
+$::opt_quiet = 0;
+$::opt_debug = 0;
+$::opt_verbose = 0;
+$::opt_useps = 0;
+$::opt_printgscmd = 0;
+$::opt_gspages = $gspages; # undocumented
+$::opt_makepng = 1;
+$::opt_makepdf = 1;
+$::opt_makedata = 1;
+$::opt_clean = 1;
+$::opt_password = "";
+$::opt_antialias = $antialias_default;
+$::opt_greek = 0;
+
+my $usage = <<"END_OF_USAGE";
+${title}Syntax: \L$program\E [options] <jobname[.pdf|.ps]>
+Function: Support of thumbnails for pdfTeX or dvips/ps2pdf (pdfmark).
+ Thumbnails are generated by Ghostscript and the result is
+ written to data files for package `$package':
+ `<jobname>$pdftexext' (pdfTeX), `<jobname>$pdfmarkext' (pdfmark)
+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)makepng make thumbnails `$thumbprefix*.png' ($bool[$::opt_makepng])
+ --(no)makepdf make `$pdffile' with thumbnails as images ($bool[$::opt_makepdf])
+ --(no)makedata make data file(s) for package `$package' ($bool[$::opt_makedata])
+ --(no)clean clear temp files ($bool[$::opt_clean])
+ --(no)useps `makepng' uses `.ps' instead of `.pdf' file ($bool[$::opt_useps])
+ --(no)level2 `<jobname>.tpm' with ps level 2 features ($bool[$::opt_level2])
+ --(no)greek text in greek style (experimental) ($bool[$::opt_greek])
+ --antialias <num1>[num2] anti-aliasing, 0 = disable, 4 = max ($::opt_antialias)
+ --device|png [png]<dev> Ghostscript device for thumbnails,
+ dev = mono, gray, 16, 256, 16m ($::opt_device)
+ --resolution <res> thumbnail resolution for makepng ($resolution)
+ --compress <n> thumbnail compress level, n = 0..10 ($::opt_compress)
+ --modes <mode>[,mode] mode=pdftex|pdfmark|dvips|ps2pdf|
+ vtexpdfmark|all ($::opt_modes)
+ --password apassword for an encrypted pdf file ($::opt_password)
+END_OF_USAGE
+
+### environment variable THUMBPDF
+if ($ENV{$envvar}) {
+ unshift(@ARGV, split(/\s+/, $ENV{$envvar}));
+}
+
+### process options
+my @OrgArgv = @ARGV;
+use Getopt::Long;
+GetOptions(
+ "help!",
+ "quiet!",
+ "debug!",
+ "verbose!",
+ "device|png=s",
+ "gscmd=s",
+ "level2!",
+ "compress=i",
+ "resolution=f",
+ "modes=s",
+ "useps!",
+ "printgscmd!",
+ "gspages!",
+ "makepng!",
+ "makepdf!",
+ "makedata!",
+ "clean!",
+ "password=s",
+ "antialias=s",
+ "greek!"
+) or die $usage;
+!$::opt_help or die $usage;
+@ARGV < 2 or die "$usage$Error Too many files!\n";
+@ARGV == 1 or die "$usage$Error Missing jobname!\n";
+
+$::opt_device = "png$::opt_device" unless $::opt_device =~ /^png/;
+$::opt_quiet = 0 if $::opt_verbose;
+$::opt_clean = 0 if $::opt_debug or !$::opt_makepdf or !$::opt_makedata;
+
+$::opt_compress = 0 if $::opt_compress < 0;
+$::opt_compress = 10 if $::opt_compress > 10;
+my $J = "^^J";
+$J = "" if $::opt_compress == 10;
+
+$::opt_antialias = $antialias_default if $::opt_antialias eq "";
+$::opt_antialias =~ /^[0124][0124]?$/ or
+ die "$usage$Error Wrong value for option --antialias!\n";
+$::opt_antialias .= $::opt_antialias if length($::opt_antialias) < 2;
+my $AntiAliasText = substr($::opt_antialias, 0, 1);
+my $AntiAliasGraphics = substr($::opt_antialias, 1, 1);
+$AntiAliasText = "1" if $AntiAliasText eq "0";
+$AntiAliasGraphics = "1" if $AntiAliasGraphics eq "0";
+
+$GS = $::opt_gscmd if $::opt_gscmd;
+$gspages = $::opt_gspages;
+
+### get modes
+$::opt_modes = "\L$::opt_modes\E";
+$::opt_modes =~ s/dvips/pdfmark/g;
+$::opt_modes =~ s/ps2pdf/pdfmark/g;
+$::opt_modes =~ s/vtexpdfmark/pdfmark/g;
+$::opt_modes =~ s/vtexpdfmark/pdfmark/g;
+if ($::opt_modes =~ /pdftex/)
+{
+ $mode_pdftex = 1;
+ $::opt_modes =~ s/pdftex//g;
+}
+if ($::opt_modes =~ /pdfmark/)
+{
+ $mode_pdfmark = 1;
+ $::opt_modes =~ s/pdfmark//g;
+}
+if ($::opt_modes =~ /all/)
+{
+ $mode_pdftex = 1;
+ $mode_pdfmark = 1;
+ $::opt_modes =~ s/all//g;
+}
+$::opt_modes =~ s/\s+//g;
+$::opt_modes =~ s/,+/,/g;
+$::opt_modes =~ s/^,//;
+$::opt_modes =~ s/,$//;
+if ($::opt_modes ne "")
+{
+ die "$usage$Error Unknown mode(s): `$::opt_modes'\n";
+}
+if ($::opt_makedata)
+{
+ $mode_pdftex or $mode_pdfmark or
+ die "$usage$Error Missing mode!\n";
+}
+
+### get jobname
+$jobname = $ARGV[0];
+if ($::opt_useps)
+{
+ $jobname =~ s/\.ps$//i;
+ $jobname =~ s/\\/\//g;
+ $jobfile = $jobname . $psext;
+}
+else
+{
+ $jobname =~ s/\.pdf$//i;
+ $jobname =~ s/\\/\//g;
+ $jobfile = $jobname . $pdfext;
+}
+$pdftexfile = $jobname . $pdftexext;
+$pdfmarkfile = $jobname . $pdfmarkext;
+
+print $title unless $::opt_quiet;
+
+print "* jobname: `$jobname'\n" if $::opt_verbose;
+
+if ($::opt_debug) {
+ print <<"END_DEB";
+* OSNAME: $^O
+* PERL_VERSION: $]
+* ARGV: @OrgArgv
+END_DEB
+}
+
+### set signals
+$SIG{__DIE__} = \&clean;
+setsignals(\&cleanup);
+
+my $MaxThumb = 0;
+
+###
+### make thumbnails
+###
+if ($::opt_makepng)
+{
+ print "*** make png files / run Ghostscript ***\n"
+ unless $::opt_quiet or $::opt_printgscmd;
+ if ($::opt_useps)
+ {
+ print "* ps file: $jobfile\n" if $::opt_verbose;
+ }
+ else
+ {
+ print "* pdf file: $jobfile\n" if $::opt_verbose;
+ }
+ print "* Ghostscript command: `$GS'\n" .
+ "* Ghostscript png device: `$::opt_device'\n" if $::opt_verbose;
+
+ if ($::opt_resolution)
+ {
+ $resolution = $::opt_resolution
+ }
+ else
+ {
+ # looking for MediaBox
+
+ my $max_x = 0;
+ my $max_y = 0;
+ {
+ my $MB = $jobfile;
+ open(MB, $MB) or die "$Error Cannot open `$MB'!\n";
+ binmode(MB);
+ my $xy_patt = '[\-\.\d]';
+ while (<MB>)
+ {
+ if (/\/MediaBox\s*\[\s*($xy_patt+)\s+($xy_patt+)\s+($xy_patt+)\s+($xy_patt+)\s*\]/)
+ {
+ my $x = $3 - $1;
+ my $y = $4 - $2;
+ $max_x = $x if $x > $max_x;
+ $max_y = $y if $y > $max_y;
+ }
+ }
+ close(MB);
+ }
+ if ($max_x <= 0 || $max_y <= 0)
+ {
+ print "!!! Warning: MediaBox not found, " .
+ "using default resolution: $resolution DPI\n";
+ }
+ else
+ {
+ print "* Max. Size of MediaBox: $max_x x $max_y\n" if $::opt_verbose;
+
+ my $rx = 106 * 72 / $max_x;
+ my $ry = 106 * 72 / $max_y;
+ $resolution = $rx;
+ $resolution = $ry if $ry < $rx;
+ print "* Resolution: $resolution DPI\n" if $::opt_verbose;
+ }
+ }
+
+# Ghostscript's pdfshowpage_setpage is patched for solving
+# some problems:
+# * gs6.0* includes a hack that ignores the /Rotate entry
+# in the PDF page, if OutputFile is set.
+# gs6.50 does not need a fix and it is not applied,
+# because pdfshowpage_setpage does not contain /OutputFile.
+# * If /CropBox is set, then it should be used instead
+# of the /MediaBox entry. Because the CropBox area should
+# be part of the MediaBox, the MediaBox is overwritten
+# with the CropBox values for generating the thumbnails.
+# The fixes are only applied for versions >= 6.0, because
+# gs5.50 gets a /PageSize problem with this fix.
+#
+ my $SetPageHack = <<'SET_PAGE_HACK';
+currentglobal true setglobal
+false
+/product where {
+ pop
+ product (Ghostscript) search {
+ pop pop pop
+ revision 600 ge {
+ pop true
+ } if
+ }{pop} ifelse
+} if
+{ /pdfdict where {
+ pop
+ pdfdict begin
+ /pdfshowpage_setpage
+ [ pdfdict /pdfshowpage_setpage get
+ { dup type /nametype eq
+ { dup /OutputFile eq
+ { pop /AntiRotationHack
+ }{
+ dup /MediaBox eq revision 650 ge and
+ { /THB.CropHack {
+ 1 index /CropBox pget
+ { 2 index exch /MediaBox exch put
+ } if
+ } def
+ /THB.CropHack cvx
+ } if
+ } ifelse
+ } if
+ } forall
+ ] cvx def
+ end
+ } if
+} if
+setglobal
+SET_PAGE_HACK
+
+ my $Greek = "";
+ $Greek = <<'END_GREEK' if $::opt_greek;
+currentglobal true setglobal
+userdict begin
+ % * Patch for `show'
+ /THB_ORG_show {show} bind def
+ /THB_greekstring
+ /.charboxpath where
+ {
+ pop
+ {
+ currentpoint newpath moveto
+ true .charboxpath closepath fill
+ } bind def
+ }{
+ {
+ {
+ 1 string dup 0 4 -1 roll put
+ dup stringwidth pop exch
+ true charpath flattenpath pathbbox
+ 2 index sub exch 3 index sub exch rectfill
+ 0 rmoveto
+ } forall
+ } bind def
+ } ifelse
+ /show {
+ currentfont /FontType get 1 eq
+ {
+ dup
+ gsave
+ % assuming white background
+ [ currentrgbcolor ]
+ { 1 add 2 div } forall
+ setrgbcolor
+ THB_greekstring
+ grestore
+ stringwidth pop 0 rmoveto
+ }{
+ THB_ORG_show
+ } ifelse
+ } bind def
+
+ % * Patch for the PDF case
+ userdict /GS_PDF_ProcSet known
+ {
+ % GS_PDF_ProcSet is readonly, so it will be copied first
+ GS_PDF_ProcSet length 10 add dict dup
+ GS_PDF_ProcSet {
+ put dup
+ } forall
+ /GS_PDF_ProcSet exch def
+ dup
+ begin
+ % `setshowstate' contains the use of `show', so it has to
+ % be overwritten, because it was defined with `bind'.
+ % The definition is taken from `pdf_ops.ps'.
+ revision 710 lt
+ { % 5.50, 6.51, 7.00, 7.02
+
+/setshowstate
+ { WordSpacing 0 eq TextSpacing 0 eq and
+ { TextRenderingMode 0 eq
+ { { setfillstate show } }
+ { { false charpath textrenderingprocs TextRenderingMode get exec } }
+ ifelse
+ }
+ { TextRenderingMode 0 eq
+ { WordSpacing 0 eq
+ { { setfillstate TextSpacing exch 0 exch ashow } }
+ { TextSpacing 0 eq
+ { { setfillstate WordSpacing exch 0 exch 32 exch widthshow } }
+ { { setfillstate WordSpacing exch TextSpacing exch 0 32 4 2 roll 0 exch awidthshow } }
+ ifelse
+ }
+ ifelse
+ }
+ { { WordSpacing TextSpacing
+ % Implement the combination of t3 and false charpath.
+ % Note that we must use cshow for this, because we
+ % can't parse multi-byte strings any other way.
+ % Stack: string xword xchar
+ { pop pop (x) dup 0 3 index put false charpath
+ % Stack: xword xchar ccode
+ 3 copy 32 eq { add } { exch pop } ifelse 0 rmoveto pop
+ }
+ 4 -1 roll cshow pop pop
+ textrenderingprocs TextRenderingMode get exec
+ }
+ }
+ ifelse
+ }
+ ifelse /Show gput
+ } bdef
+
+ }{ % 7.10
+
+/setshowstate
+ { WordSpacing 0 eq TextSpacing 0 eq and
+ { TextRenderingMode 0 eq
+ { { setfillstate show } }
+ { { false charpath textrenderingprocs TextRenderingMode get exec } }
+ ifelse
+ }
+ { TextRenderingMode 0 eq
+ { WordSpacing 0 eq
+ { { setfillstate TextSpacing 0 Vexch 3 -1 roll ashow } }
+ { TextSpacing 0 eq
+ { { setfillstate WordSpacing 0 Vexch 32 4 -1 roll widthshow } }
+ { { setfillstate WordSpacing 0 Vexch 32
+ TextSpacing 0 Vexch 6 -1 roll awidthshow } }
+ ifelse
+ }
+ ifelse
+ }
+ { { WordSpacing TextSpacing
+ % Implement the combination of t3 and false charpath.
+ % Note that we must use cshow for this, because we
+ % can't parse multi-byte strings any other way.
+ % Stack: string xword xchar
+ { pop pop (x) dup 0 3 index put false charpath
+ % Stack: xword xchar ccode
+ 3 copy 32 eq { add } { exch pop } ifelse 0 Vexch rmoveto pop
+ }
+ 4 -1 roll cshow pop pop
+ textrenderingprocs TextRenderingMode get exec
+ }
+ }
+ ifelse
+ }
+ ifelse /Show gput
+ } bdef
+
+ } ifelse
+ end
+ readonly pop
+ } if
+end
+setglobal
+END_GREEK
+
+ my $SetPassword = "";
+ $SetPassword = "/PDFPassword($::opt_password)def" if $::opt_password;
+
+ my $PSHeader = "save pop $SetPassword $SetPageHack $Greek";
+ $PSHeader =~ s/%\s.*\n/ /g;
+ $PSHeader =~ s/\s+/ /g;
+ $PSHeader =~ s/\s+([\(\/\[\]\{\}])/$1/g;
+ $PSHeader =~ s/([\)\[\]\{\}])\s+/$1/g;
+ $PSHeader =~ s/\s+$//;
+
+ my $AntiAlias = "";
+ $AntiAlias = "\n-dTextAlphaBits=$AntiAliasText\n" .
+ "-dGraphicsAlphaBits=$AntiAliasGraphics"
+ if $::opt_antialias;
+
+ my $gs_cmd = <<"GS_CMD_END";
+$GS$AntiAlias
+-dNOPAUSE
+-dBATCH
+-sDEVICE=$::opt_device
+-r$resolution
+-sOutputFile=$thumbprefix%d.png
+-c "$PSHeader"
+-f $jobfile
+GS_CMD_END
+ # The trick with `save' comes from `ps2pdf':
+ # Doing an initial `save' helps keep fonts from being flushed
+ # between pages.
+
+ if ($::opt_printgscmd)
+ {
+ open(GSCNF, ">$gscnffile") or die "$Error Cannot open `$gscnffile'!\n";
+ $gs_cmd =~ s/^[^\r\n]+[\r\n]+//;
+ print GSCNF $gs_cmd;
+ close(GSCNF);
+ my $options = "@arglist";
+ $options =~ s/\s*--?pr[intgscmd]*\s*/ /i;
+ $options =~ s/^\s+//;
+ $options =~ s/\s+$//;
+ print <<"END_PERL" if $::opt_verbose;
+* Perl interpreter: $^X
+* Perl script: $0
+END_PERL
+ print <<"END_GS";
+1. Run `Ghostscript' manually:
+ ==> $GS \@$gscnffile
+2. Call `thumbpdf' again with the additional option `--nomakepng':
+ ==> thumbpdf --nomakepng $options
+END_GS
+ exit(0);
+ }
+
+ chomp($gs_cmd);
+ $gs_cmd =~ s/\n/ /mg;
+ print "> $gs_cmd\n" if $::opt_verbose;
+
+ if ($::opt_debug)
+ {
+ if ($gspages)
+ {
+ print "* Ghostscript with page numbers\n";
+ }
+ else
+ {
+ print "* Ghostscript without page numbers\n";
+ }
+ }
+
+ setsignals(\&gscleanup);
+ my $capture = "";
+ if ($gspages)
+ {
+ my $newline = 0;
+ open(KID, "$gs_cmd|") or die "$Error Cannot open Ghostscript ($!)!\n";
+ *::GSKID = *KID;
+ $gskidrunning = 1;
+ my $orgbar = $|;
+ $|=1;
+ while (<KID>)
+ {
+ $capture .= $_;
+ if ($::opt_verbose)
+ {
+ print;
+ }
+ else
+ {
+ if (!$::opt_quiet)
+ {
+ print if /^Processing pages/;
+ if (/^Page\s+(\d+)/)
+ {
+ print " " if $newline;
+ $newline = 1;
+ print "[$1]";
+ }
+ }
+ }
+ }
+ $gskidrunning =0;
+ if (!close(KID))
+ {
+ if ($!)
+ {
+ die "$Error Closing Ghostscript ($!)!\n";
+ }
+ else
+ {
+ my $exitvalue = $? >> 8;
+ die "$Error Closing Ghostscript (exit status: $exitvalue)!\n";
+ }
+ }
+ print "\n" if $newline;
+ $| = $orgbar;
+ }
+ else # without pages
+ {
+ $capture = `$gs_cmd`;
+ if (!defined($capture))
+ {
+ die "$Error Cannot execute Ghostscript!\n";
+ }
+ print $capture if $::opt_verbose;
+ }
+
+ if ($capture =~ /Error:\s*(.*)\n/)
+ {
+ die <<"END_DIE";
+$Error `$1' (Ghostscript)!
+See `$readme', $gssection, for further information.
+END_DIE
+ }
+ if ($capture =~ /Unknown device:\s*(.*)\n/)
+ {
+ die "$Error Unknown device `$1' (Ghostscript)!\n";
+ }
+ if ($?)
+ {
+ my $exitvalue = $?;
+ if ($exitvalue > 255)
+ {
+ $exitvalue >>= 8;
+ die "$Error Closing Ghostscript (exit status: $exitvalue)!\n";
+ }
+ die "$Error Closing Ghostscript ($exitvalue)!\n";
+ }
+ if ($capture =~ /Processing pages \d+ through (\d+)./)
+ {
+ $MaxThumb = $1;
+ }
+ print "* max. page: $MaxThumb\n" if $::opt_debug;
+ setsignals(\&cleanup);
+}
+
+###
+### make thumbpdf.pdf file
+###
+if ($::opt_makepdf)
+{
+ print "*** make `$pdffile' / run pdfTeX ***\n" unless $::opt_quiet;
+
+ if ($MaxThumb > 0)
+ {
+ my $i;
+ for ($i=1; $i<=$MaxThumb; $i++)
+ {
+ push(@cleanlist, "$thumbprefix$i.png");
+ }
+ }
+ else
+ {
+ # get max thumb number to speed up the pdfTeX run
+ $MaxThumb = 0;
+ foreach (glob("$thumbprefix*.png"))
+ {
+ next unless /$thumbprefix(\d+).png/;
+ $MaxThumb = $1 if $1 > $MaxThumb;
+ push(@cleanlist, $_);
+ }
+ }
+
+ push(@cleanlist, $logfile);
+ push(@cleanlist, $pdffile);
+
+ my $compress = $::opt_compress;
+ $compress = 9 if $::opt_compress == 10;
+ my $cmd = "pdftex \"" .
+ "\\nonstopmode" .
+ "\\pdfcompresslevel$compress" .
+ "\\def\\thumbjob{$jobname}" .
+ "\\def\\thumbmax{$MaxThumb}" .
+ "\\input $texfile" .
+ "\"";
+ print "> $cmd\n" if $::opt_verbose;
+ my @capture = `$cmd`;
+ if (!defined(@capture))
+ {
+ die "$Error Cannot execute pdfTeX!\n";
+ }
+ if ($::opt_verbose)
+ {
+ print @capture;
+ }
+ else
+ {
+ foreach (@capture)
+ {
+ print if /^!\s/;
+ }
+ }
+ if ($?)
+ {
+ my $exitvalue = $?;
+ if ($exitvalue > 255)
+ {
+ $exitvalue >>= 8;
+ die "$Error Closing pdfTeX (exit status: $exitvalue)!\n";
+ }
+ die "$Error Closing pdfTeX ($exitvalue)!\n";
+ }
+ # test version
+ my $versionfound = 0;
+ foreach (@capture)
+ {
+ if (/File:.*thumbpdf.*(\d\d\d\d\/\d\d\/\d\d)\s+v(\d+\.\d+)/)
+ {
+ $versionfound = 1;
+ if ($1 ne $date or $2 ne $version) {
+ print <<"END_WARN";
+!!! Warning: Version of `thumbpdf.tex' does not match with perl script!
+ Current `thumbpdf.tex': $1 v$2
+ Please install version: $date v$version
+END_WARN
+ }
+ }
+ }
+ print "!!! Warning: Version of `thumbpdf.tex' not found!\n"
+ if !$versionfound;
+
+ $_ = pop(@cleanlist);
+}
+
+###
+### parse thumbpdf.pdf
+###
+
+if ($::opt_makedata)
+{
+ push(@cleanlist, $pdffile);
+
+ print "*** parse `$pdffile' ***\n" unless $::opt_quiet;
+
+### reading file and parse obj structure
+
+ my @objno = (); # obj number
+ my @objdict = (); # boolean, object is dict
+ my @objtext = (); # text of object
+ my @objstream = (); # stream of object if any
+ my $maxobj = 0;
+
+ my @getobjindex = (); # $getobj[obj number] ==> index for $obj...[index]
+
+ # open file
+ my $PDF = $pdffile;
+ open(PDF, $PDF) or die "$Error Cannot open `$PDF'!\n";
+ binmode(PDF);
+ my $lineno = 0;
+
+ # read header
+ $_ = <PDF>; $lineno++;
+ $_ or die "$Error Cannot read header of `$PDF' or file is empty!\n";
+ /^%PDF/ or die "$Error No PDF specification found!\n";
+ print "* pdf header: $_" if ($::opt_debug);
+
+ # read body objects
+ my $count = 0;
+ while (<PDF>)
+ {
+ $lineno++;
+
+ # continue, if comment line (2nd line of PDF output by pdfTeX 1.30)
+ next if /^%/;
+
+ # stop at xref
+ last if /^xref$/;
+
+ # scan first obj line
+ /^(\d+)\s+0\s+obj\s*(<<)?$/ or
+ die "$Error `obj' expected on line $lineno!\n";
+ $objno[$count] = $1;
+ $getobjindex[$1] = $count;
+ $objdict[$count] = ($2); # boolean (if $2 exists)
+ my $stream = 0;
+ print "* obj $objno[$count]" .
+ (($objdict[$count]) ? " (dict)" : "") .
+ "\n" if $::opt_debug;
+
+ # get obj
+ $objtext[$count] = "";
+ while (<PDF>)
+ {
+ $lineno++;
+
+ if ($objdict[$count])
+ {
+ if (/^>>/)
+ {
+ last if /^>>\s+endobj$/; # obj without stream
+
+ # get stream
+ $_ = <PDF>; $lineno++;
+ /^stream$/ or die "$Error `stream' expected on line $lineno!\n";
+
+ print "* stream\n" if $::opt_debug;
+ $objstream[$count] = "";
+ while (<PDF>)
+ {
+ $lineno++;
+
+ if (/(.*)endstream$/)
+ {
+ $objstream[$count] .= $1;
+ last;
+ }
+ $objstream[$count] .= $_;
+ }
+
+ $_ = <PDF>; $lineno++;
+ /^endobj$/ or die "$Error `endobj' expected on line $lineno!\n";
+ last;
+ }
+ }
+ else # no dict
+ {
+ last if /^endobj$/;
+ }
+ $objtext[$count] .= $_;
+ }
+ $count++;
+ }
+ close(PDF);
+ $maxobj = $count;
+ print "* $maxobj objects found.\n" if $::opt_debug;
+
+### get thumbnail page numbers
+ my @thumbpageno = ();
+ my $found = 0;
+ foreach (@objtext)
+ {
+ if (/^<<\/ListThumbs\s+(.+)>>$/)
+ {
+ $_ = $1;
+ chomp;
+ @thumbpageno = split / /; # split(/ /, $_);
+ print "* ListThumbs: @thumbpageno\n" if $::opt_debug;
+ $found = 1;
+ last;
+ }
+ }
+ $found or die "$Error `/ListThumbs' not found!\n";
+ {
+ my $j;
+ for ($j=0; $j<@thumbpageno; $j++)
+ {
+ $thumbpageno[$j] = $1 if $thumbpageno[$j] =~ /^{(.+)}$/;
+ }
+ }
+
+### identify thumb objects
+
+ my @thumbobj = (); # index for @obj... with image stream
+ my @thumblength = (); # stream length values
+ my @thumbrgbobj = (); # index for @obj... with rgb stream
+ my @thumbrgblength = (); # rgb stream length values
+ my $maxthumb = 0;
+
+ $count = 0;
+ my $i;
+ for ($i=0; $i<$maxobj; $i++)
+ {
+ if ($objtext[$i] =~
+ /^\/Type\s+\/XObject\n\/Subtype\s+\/Image\n/m)
+ {
+ $thumbobj[$count] = $i;
+ $_ = $';
+ $objtext[$i] = $_;
+
+ # check width and height
+ /\/Width\s+(\d+)\n\/Height\s+(\d+)/m or
+ die "$Error width/height of thumbnail not found!\n";
+ print "* Size: $1x$2\n" if $::opt_debug;
+ print "==> Width ($1) " .
+ "of thumbnail `$thumbpageno[$count]' " .
+ "is larger than recommended (106).\n"
+ if $1 > 106;
+ print "==> Height ($2) " .
+ "of thumbnail `$thumbpageno[$count]' " .
+ "is larger than recommended (106).\n"
+ if $2 > 106;
+
+ # get stream length
+ if (/\/Length\s+(\d+)\s+([\/\>]|$)/m)
+ {
+ $thumblength[$count] = $1;
+ print "* Length (direct): $1\n" if $::opt_debug;
+ # remove whitespace after length obj
+ $objtext[$i] =~ s/(\/Length\s+\d+)\s+\n/$1\n/;
+ }
+ else # looking for indirect reference
+ {
+ /\/Length\s+(\d+)\s+0\s+R/m or
+ die "$Error `/Length' entry not found!\n";
+ # save obj text for later correction
+ my $objpre = $`;
+ my $objpost = $';
+ # look for length obj
+ $getobjindex[$1] or die "$Error Length obj not found!\n";
+ $objtext[$getobjindex[$1]] =~ /^(\d+)$/m or
+ die "$Error length value not found!\n";
+ $thumblength[$count] = $1;
+ print "* Length (indirect): $1\n" if $::opt_debug;
+ # insert obj length directly:
+ $objtext[$i] = $objpre . "/Length $1" . $objpost;
+ }
+
+ # remove \n from end of stream
+ if ($thumblength[$count] < length($objstream[$i])) {
+ chop($objstream[$i]);
+ }
+
+ # check /Indexed /DeviceRGB
+ if ($objtext[$i] =~
+ /\/ColorSpace\s+\[\/Indexed\s+\/DeviceRGB\s+(\d+)\s+(\d+)\s+0\s+R\]/m)
+ {
+ # correct thumb object text
+ $objtext[$i] =
+ "$`/ColorSpace [/Indexed /DeviceRGB $1 \\the\\pdflastobj\\ 0 R]$'";
+ # get RGB obj number
+ $getobjindex[$2] or die "$Error RGB object not found!\n";
+ $_ = $getobjindex[$2];
+ $thumbrgbobj[$count] = $_;
+ # get stream length
+ if ($objtext[$_] =~ /\/Length\s+(\d+)\s+([\/\>]|$)/m)
+ {
+ $thumbrgblength[$count] = $1;
+ print "* RGB length (direct): $1\n" if $::opt_debug;
+ $objtext[$_] =~ s/(\/Length\s+\d+)\s+\n/$1\n/;
+ }
+ else # looking for indirect reference
+ {
+ $objtext[$_] =~ /\/Length\s+(\d+)\s+0\s+R/m or
+ die "$Error Length entry of rgb object not found\n";
+ # save obj text for later correction
+ my $objrgbpre = $`;
+ my $objrgbpost = $';
+ # get rgb stream length
+ $getobjindex[$1] or die "$Error RGB length object not found!\n";
+ $objtext[$getobjindex[$1]] =~ /^(\d+)$/m or
+ die "$Error length value not found!\n";
+ $thumbrgblength[$count] = $1;
+ print "* RGB length (indirect): $1\n" if $::opt_debug;
+ # insert RGB object length directly:
+ $objtext[$_] = $objrgbpre . "/Length $1" . $objrgbpost;
+ }
+ }
+
+ $count++;
+ }
+ }
+ $maxthumb = $count;
+
+ if ($maxthumb != @thumbpageno)
+ {
+ my $pagecount = @thumbpageno;
+ die "$Error $maxthumb thumbnails found, but there should be $pagecount!\n";
+ }
+ print "* $maxthumb thumbnails found.\n" if $::opt_verbose;
+
+
+###
+### write data files
+###
+
+ my $timestamp;
+ {
+ my ($sec, $min, $hour, $mday, $mon, $year) = localtime();
+ $mon++;
+ $year += 1900;
+ $timestamp = sprintf("%04d/%02d/%02d %02d:%02d:%02d",
+ $year, $mon, $mday, $hour, $min, $sec);
+ }
+ if ($mode_pdftex)
+ {
+ print "*** write `$pdftexfile' (pdfTeX thumbnail data) ***\n"
+ unless $::opt_quiet;
+ my $DTA_PT = $pdftexfile;
+ open(DTA_PT, ">$DTA_PT") or die "$Error Cannot open `$DTA_PT'!\n";
+ binmode(DTA_PT);
+ print DTA_PT <<"END_DTA";
+% File: $DTA_PT
+% Producer: $program $version
+% Mode: pdftex
+% Date: $timestamp
+END_DTA
+ }
+ my $maxpagethumb;
+ my $dictbegin;
+ if ($mode_pdfmark)
+ {
+ print "*** write `$pdfmarkfile' (pdfmark thumbnail data) ***\n"
+ unless $::opt_quiet;
+ my $DTA_PM = $pdfmarkfile;
+ open(DTA_PM, ">$DTA_PM") or die "$Error Cannot open `$DTA_PM'!\n";
+ binmode(DTA_PM);
+
+ # write tex part
+ print DTA_PM <<"END_DTA";
+% \\iffalse
+% File: $DTA_PM
+% Producer: $program $version
+% Mode: pdfmark
+% Date: $timestamp
+% \\fi
+END_DTA
+
+ # looking for max. number of regular thumbnails
+ $maxpagethumb = $maxthumb;
+ for ($i=0; $i<$maxobj; $i++)
+ {
+ if ($objtext[$i] =~ /<<\/MaxThumbNumber\s+(\d+)>>/)
+ {
+ $maxpagethumb = $1;
+ last;
+ }
+ }
+
+ # write TeX part
+ for ($i=$maxpagethumb; $i<$maxthumb; $i++)
+ {
+ print DTA_PM "% \\DefThisThumb{$thumbpageno[$i]}\n";
+ }
+
+ # write PostScript header
+ my $dictstart = <<'END_DICT';
+ 4 dict begin
+ /enddict {
+ counttomark 2 idiv dup dict begin {def} repeat pop
+ currentdict end
+ } bind def
+END_DICT
+ chomp($dictstart);
+ $dictbegin = "[";
+ my $dictend = "enddict";
+ my $filter = "";
+ my $read = "readhexstring";
+ if ($::opt_level2)
+ {
+ $dictstart = " 3 dict begin";
+ $dictbegin = "<<";
+ $dictend = ">>";
+ $filter = " /ASCII85Decode filter";
+ $read = "readstring";
+ }
+
+ print DTA_PM <<"END_DTA";
+% \\endinput
+% TeX part ends here
+
+% PostScript definitions
+END_DTA
+
+ my $PS_Header = <<"END_HEAD";
+%
+% Default definition of pdfmark
+/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse
+%
+% Check the version of Ghostscript. If it is below 6.0,
+% the commands, that produce the thumbnails, are defined
+% to be dummies.
+%
+true
+/product where {
+ pop
+ product (Ghostscript) search {
+ pop pop pop
+ revision 600 lt {
+ (!!! Warning (thumbpdf): Ghostscript 6.0 required for thumbnails!\\n)
+ print pop false
+ } if
+ }{pop} ifelse
+} if
+{
+% Syntax: <thumb object> thisTHB -
+% thisTHB is used globally, so it is defined in the current
+% dictionary (perhaps userdict should explicitly be set).
+ /thisTHB {[ exch /Thumb exch /PAGE pdfmark} bind def
+$dictstart
+% Syntax: <page object> <thumb object> pagethumb -
+ /pagethumb {
+ [ 3 1 roll $dictbegin exch /Thumb exch $dictend /PUT pdfmark
+ } bind def
+% Syntax: <thumb object> <stream length>
+% <mark> <key value pairs> streamobj -
+%
+% Distiller ignores the compression of previously compressed
+% streams and uses its own settings. Therefore for Distiller
+% the streams are uncompressed.
+% Now ghostscript versions greater than 8 behave in the same way
+% as Distiller. Therefore detection for this versions is added.
+% The detection and patch for distiller require features of level 2
+% and the filter /FlateDecode (level 3), that is used by pdfTeX's
+% compression.
+ /THB_DistillerPatch false def
+ /languagelevel where {
+ pop
+ languagelevel 2 ge {
+ product (Distiller) search {pop pop pop true}{pop false} ifelse
+ product (Ghostscript) search {
+ pop pop pop
+ revision 800 ge
+ }{pop false} ifelse
+ or
+ {
+ (FlateDecode) {
+ pop
+% Syntax: <dict> THB_DistillerPatch <dict> false
+% <dict> THB_DistillerPatch <dict> <filter>
+ /THB_DistillerPatch {
+ dup /Filter known {
+ dup dup /Filter get exch /Filter undef
+ }{false} ifelse
+ } bind def
+ } (FlateDecode) /Filter resourceforall
+ } if
+ } if
+ } if
+ /streamobj {
+ $dictend exch
+% Stack: <thumb> <dict> <length>
+ 3 -1 roll dup
+% Stack: <dict> <length> <thumb> <thumb>
+ [ /_objdef 3 -1 roll /type /stream /OBJ pdfmark
+% Stack: <dict> <length> <thumb>
+ dup dup 5 -1 roll
+% Stack: <length> <thumb> <thumb> <thumb> <dict>
+ THB_DistillerPatch
+% Stack: <length> <thumb> <thumb> <thumb> <dict> <filter/false>
+ [ 4 -2 roll /PUT pdfmark
+% Stack: <length> <thumb> <thumb> <filter/false>
+ [ 3 1 roll currentfile${filter}
+% Stack: <length> <thumb> [ <thumb> <filter/false> <file>
+ 6 -1 roll string $read pop
+% Stack: <thumb> [ <thumb> <filter/false> <string>
+ exch dup type /booleantype ne {true} if {filter} if
+% Stack: <thumb> [ <thumb> <file>
+ /PUT pdfmark
+% Stack: <thumb>
+ [ exch /CLOSE pdfmark
+ } bind def
+}{
+% Syntax: <thumb object> thisTHB -
+ /thisTHB {pop} bind def
+ 2 dict begin
+% Syntax: <page object> <thumb object> pagethumb -
+ /pagethumb {pop pop} bind def
+% Syntax: <thumb object> <stream length>
+% <mark> <key value pairs> streamobj -
+ /streamobj {
+ cleartomark exch pop
+ string currentfile${filter}
+ exch $read pop pop
+ } bind def
+} ifelse
+END_HEAD
+ $PS_Header =~ s/%[^\r\n]*[\r\n]+//gm;
+ print DTA_PM $PS_Header;
+ print DTA_PM <<"END_DTA";
+
+% adding thumbnails to pages
+END_DTA
+
+ for ($i=0; $i<$maxpagethumb; $i++)
+ {
+ print DTA_PM <<"END_DTA";
+{Page$thumbpageno[$i]} {THB$thumbpageno[$i]} pagethumb
+END_DTA
+ }
+ print DTA_PM "\n% thumbnail data\n";
+ }
+
+ for ($i=0; $i<$maxthumb; $i++)
+ {
+ # rgb object
+ if ($thumbrgbobj[$i])
+ {
+ # find the same rgb object
+ my $j;
+ for ($j=0; $j<$i; $j++)
+ {
+ next unless $thumbrgbobj[$j];
+ next unless $objtext[$thumbrgbobj[$j]] eq
+ $objtext[$thumbrgbobj[$i]];
+ next unless $objstream[$thumbrgbobj[$j]] eq
+ $objstream[$thumbrgbobj[$i]];
+ last;
+ }
+ if ($j==$i) # not found
+ {
+ if ($mode_pdftex)
+ {
+ {
+ my $rgbstream = pdftexstream($objstream[$thumbrgbobj[$i]]);
+ my $dict = $objtext[$thumbrgbobj[$i]];
+ if ($::opt_compress == 10)
+ {
+ chomp($dict);
+ $dict =~ s/\n([^\/])/^^J\n$1/mg;
+ $dict =~ s/[ ]+\//\//mg;
+ }
+ else
+ {
+ $dict =~ s/\n/^^J\n/mg;
+ }
+ print DTA_PT <<"END_DTA";
+\\immediate\\pdfobj{<<$J
+$dict>>$J
+stream^^J
+$rgbstream
+endstream}
+\\DefRGB{$i}
+END_DTA
+ }
+ }
+ if ($mode_pdfmark)
+ {
+ {
+ my $rgbstream = pdfmarkstream($objstream[$thumbrgbobj[$i]]);
+ my $rgblength = $thumbrgblength[$i];
+ my $dict = $objtext[$thumbrgbobj[$i]];
+ $dict =~ s/\/Length\s+\d+\s*//;
+ $dict =~ s/^\s+//;
+ $dict =~ s/\s+$//;
+ print DTA_PM <<"END_DTA";
+{RGB_$i} $rgblength $dictbegin
+$dict
+streamobj
+$rgbstream
+END_DTA
+ }
+ }
+ }
+ else # $j with same rgb obj
+ {
+ $objtext[$thumbobj[$i]] =~
+ s/\\the\\pdflastobj/\\UseRGB{$j}/;
+ print "* Reuses RGB object $j for $i\n" if $::opt_debug;
+ }
+ }
+
+ # thumb object
+ if ($mode_pdftex)
+ {
+ {
+ my $dict = $objtext[$thumbobj[$i]];
+ if ($::opt_compress == 10)
+ {
+ chomp($dict);
+ $dict =~ s/\n([^\/])/^^J\n$1/mg;
+ $dict =~ s/[ ]+\//\//mg;
+ $dict =~ s/[ ]+\[/\[/mg;
+ }
+ else
+ {
+ $dict =~ s/\n/^^J\n/mg;
+ }
+ my $stream = pdftexstream($objstream[$thumbobj[$i]]);
+ print DTA_PT <<"END_DTA";
+\\immediate\\pdfobj{<<$J
+$dict>>$J
+stream^^J
+$stream
+endstream}
+\\DefThumb{$thumbpageno[$i]}
+END_DTA
+ }
+ }
+ if ($mode_pdfmark)
+ {
+ {
+ my $stream = pdfmarkstream($objstream[$thumbobj[$i]]);
+ my $length = $thumblength[$i];
+ my $dict = $objtext[$thumbobj[$i]];
+ $dict =~ s/\\the\\pdflastobj\\\s*\d+\s*R/{RGB_$i}/;
+ $dict =~ s/\\UseRGB{(\d+)}\\\s*\d+\s*R/{RGB_$1}/;
+ $dict =~ s/\/Length\s+\d+\s*//;
+ $dict =~ s/^\s+//;
+ $dict =~ s/\s+$//;
+ my $thismarker = "";
+ $thismarker = "_", if $i >= $maxpagethumb;
+ print DTA_PM <<"END_DTA";
+{THB$thismarker$thumbpageno[$i]} $length $dictbegin
+$dict
+streamobj
+$stream
+END_DTA
+ }
+ }
+ }
+
+ if ($mode_pdftex)
+ {
+ print DTA_PT "\\endinput\n";
+ close(DTA_PT);
+ }
+ if ($mode_pdfmark)
+ {
+ print DTA_PM <<"END_DTA";
+end
+% end of thumbnail data file
+END_DTA
+ close(DTA_PM);
+ }
+}
+
+sub pdftexstream
+{
+ my $str = "";
+ my $mod = 0;
+ foreach (split(//, $_[0]))
+ {
+ my $num = ord($_);
+ if ($num == 13) { $str .= '\\/'; }
+ elsif ($num < 32) { $str .= '^^' . chr($num + 64); }
+ elsif ($num == 32) { $str .= '\\~'; } # space
+ elsif ($num == 37) { $str .= '\\%'; } # percent
+ elsif ($num == 92) { $str .= '\\\\'; } # backslash
+ elsif ($num == 94) { $str .= '\\+'; } # caret
+ elsif ($num == 123) { $str .= '\\{'; } # curly brace left
+ elsif ($num == 125) { $str .= '\\}'; } # curly brace right
+ else { $str .= $_; }
+ $mod++;
+ if ($mod == 26)
+ {
+ $mod = 0;
+ $str .= "\n";
+ }
+ }
+ chomp $str;
+ return $str;
+}
+
+sub pdfmarkstream
+{
+ my $str;
+ if ($::opt_level2)
+ {
+ my $s = $_[0];
+ my $len = length($s);
+ $str = "";
+ my $i;
+ for ($i=0; $i<$len-4; $i+=4)
+ {
+ $_ = ASCII85Encode(substr($s, $i, 4));
+ s/!!!!!/z/;
+ $str .= $_;
+ }
+ my $r = $len % 4;
+ if ($r)
+ {
+ $_ = substr($s, $i, $r) . "\000\000\000";
+ $_ = ASCII85Encode(substr($_, 0, 4));
+ $str .= substr($_, 0, $r+1);
+ }
+ $str =~ s/(.{60})/$1\n/g;
+ chomp($str);
+ $str .= "~>";
+ }
+ else
+ {
+ $str = uc(unpack('H*', $_[0]));
+ $str =~ s/(.{60})/$1\n/g;
+ chomp($str);
+ }
+ return $str;
+}
+
+sub ASCII85Encode
+{
+ my $val = unpack("N", $_[0]);
+ my @c;
+ $c[4] = $val % 85 + 33;
+ $val = int($val/85);
+ $c[3] = $val % 85 + 33;
+ $val = int($val/85);
+ $c[2] = $val % 85 + 33;
+ $val = int($val/85);
+ $c[1] = $val % 85 + 33;
+ $c[0] = int($val/85) + 33;
+ return pack("C*", @c);
+}
+
+sub setsignals {
+ my $func = $_[0];
+ $SIG{'HUP'} = $func unless $Win;
+ $SIG{'INT'} = $func;
+ $SIG{'QUIT'} = $func;
+ $SIG{'TERM'} = $func;
+}
+
+sub clean {
+ if ($::opt_clean) {
+ print "*** clear temp files ***\n" unless $::opt_quiet;
+ foreach (@cleanlist) {
+ unlink;
+ }
+ }
+}
+
+sub cleanup {
+ print "\n" unless $::opt_quiet;
+ clean();
+ exit 1;
+}
+
+sub gscleanup {
+ print "\n" unless $::opt_quiet;
+ clean();
+ close(::GSKID) if $gskidrunning;
+ foreach (glob("$thumbprefix*.png")) {
+ unlink;
+ }
+ exit 1;
+}
+
+clean();
+
+print "*** ready. ***\n" unless $::opt_quiet;
+
+__END__
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-28 12:06:44 +0000