diff options
author | Karl Berry <karl@freefriends.org> | 2006-01-02 23:53:39 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2006-01-02 23:53:39 +0000 |
commit | 582c6b537a86231f69a815b07d1471f5d54f8e23 (patch) | |
tree | f24ee06e06979fe5c828d6f93ce0f98de835e823 /Master/texmf/scripts/tetex | |
parent | 676af4363c3a6cb4c3b1012f295507574b277187 (diff) |
trunk/Master/texmf/scripts
git-svn-id: svn://tug.org/texlive/trunk@33 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf/scripts/tetex')
-rw-r--r-- | Master/texmf/scripts/tetex/e2pall.pl | 87 | ||||
-rw-r--r-- | Master/texmf/scripts/tetex/epstopdf.pl | 309 | ||||
-rw-r--r-- | Master/texmf/scripts/tetex/texdoctk.pl | 1790 | ||||
-rw-r--r-- | Master/texmf/scripts/tetex/texi2html.pl | 2125 | ||||
-rw-r--r-- | Master/texmf/scripts/tetex/updmap.pl | 1101 |
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", " ", + "-", "­", # 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; + ✓ + 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'} = "•"; + $things_map{'copyright'} = "©"; + $things_map{'dots'} = "…"; + $things_map{'equiv'} = "≡"; + $things_map{'expansion'} = "→"; + $things_map{'point'} = "∗"; + $things_map{'result'} = "⇒"; +} + +# +# 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> $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"; + ©File("$dvipsoutputdir/$src", "$dvipsoutputdir/psfonts.map"); + + if ($pdftexDownloadBase14) { + $src = "pdftex_dl14.map"; + } else { + $src = "pdftex_ndl14.map"; + } + unlink "$pdftexoutputdir/pdftex.map"; + ©File("$pdftexoutputdir/$src", "$pdftexoutputdir/pdftex.map"); + + if ($dvipdfmDownloadBase14) { + $src = "dvipdfm_dl14.map"; + } else { + $src = "dvipdfm_ndl14.map"; + } + unlink "$dvipdfmoutputdir/dvipdfm.map"; + ©File("$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"; + ©File("$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/; + ©File($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); + } + +} |