summaryrefslogtreecommitdiff
path: root/Master/texmf/scripts/tetex
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf/scripts/tetex')
-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
5 files changed, 5412 insertions, 0 deletions
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);
+ }
+
+}