diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /systems/texlive/tlnet/tlpkg/TeXLive/TLPaper.pm |
Initial commit
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/TeXLive/TLPaper.pm')
-rw-r--r-- | systems/texlive/tlnet/tlpkg/TeXLive/TLPaper.pm | 972 |
1 files changed, 972 insertions, 0 deletions
diff --git a/systems/texlive/tlnet/tlpkg/TeXLive/TLPaper.pm b/systems/texlive/tlnet/tlpkg/TeXLive/TLPaper.pm new file mode 100644 index 0000000000..09bb0c021f --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/TeXLive/TLPaper.pm @@ -0,0 +1,972 @@ +# $Id: TLPaper.pm 45795 2017-11-14 08:49:25Z preining $ +# TeXLive::TLPaper.pm - query/modify paper sizes for our various programs +# Copyright 2008-2017 Norbert Preining +# This file is licensed under the GNU General Public License version 2 +# or any later version. + +package TeXLive::TLPaper; + +my $svnrev = '$Revision: 45795 $'; +my $_modulerevision; +if ($svnrev =~ m/: ([0-9]+) /) { + $_modulerevision = $1; +} else { + $_modulerevision = "unknown"; +} +sub module_revision { + return $_modulerevision; +} + +BEGIN { + use Exporter (); + use vars qw( @ISA @EXPORT_OK @EXPORT ); + @ISA = qw(Exporter); + @EXPORT_OK = qw( + %paper_config_path_component + %paper_config_name + ); + @EXPORT = @EXPORT_OK; +} + +my $prg = ($::prg ? $::prg : TeXLive::TLUtils::basename($0)); + +=pod + +=head1 NAME + +C<TeXLive::TLPaper> -- TeX Live paper size setting module + +=head1 SYNOPSIS + + use TeXLive::TLPaper; + +=head1 DESCRIPTION + +=over 4 + +=cut + +use TeXLive::TLUtils qw(:DEFAULT dirname merge_into mkdirhier); +use TeXLive::TLConfig; + + +# +# paper data +# +our %paper = ( + "xdvi" => { + sub => \&paper_xdvi, + default_component => "xdvi", + default_file => "XDvi", + pkg => "xdvi", + }, + "pdftex" => { + sub => \&paper_pdftex, + default_component => "tex/generic/config", + default_file => "pdftexconfig.tex", + pkg => "pdftex", + }, + "dvips" => { + sub => \&paper_dvips, + default_component => "dvips/config", + default_file => "config.ps", + pkg => "dvips", + }, + "dvipdfmx" => { + sub => \&paper_dvipdfmx, + default_component => "dvipdfmx", + default_file => "dvipdfmx.cfg", + pkg => "dvipdfmx", + }, + "context" => { + sub => \&paper_context, + default_component => "tex/context/user", + default_file => "cont-sys.tex", + pkg => "context", + }, + "psutils" => { + sub => \&paper_psutils, + default_component => "psutils", + default_file => "paper.cfg", + pkg => "psutils", + }, +); + +# Output is done to the components in this hash. +# If a value is undefined, we take the one from %default_... +# +our %paper_config_path_component; +our %paper_config_name; + + +my %xdvi_papersize = ( + a0 => '841x1189mm', + a1 => '594x841mm', + a2 => '420x594mm', + a3 => '297x420mm', + a4 => '210x297mm', + a5 => '148x210mm', + a6 => '105x148mm', + a7 => '74x105mm', + a8 => '52x74mm', + a9 => '37x52mm', + a10 => '26x37mm', + a0r => '1189x841mm', + a1r => '841x594mm', + a2r => '594x420mm', + a3r => '420x297mm', + a4r => '297x210mm', + a5r => '210x148mm', + a6r => '148x105mm', + a7r => '105x74mm', + a8r => '74x52mm', + a9r => '52x37mm', + a10r => '37x26mm', + b0 => '1000x1414mm', + b1 => '707x1000mm', + b2 => '500x707mm', + b3 => '353x500mm', + b4 => '250x353mm', + b5 => '176x250mm', + b6 => '125x176mm', + b7 => '88x125mm', + b8 => '62x88mm', + b9 => '44x62mm', + b10 => '31x44mm', + b0r => '1414x1000mm', + b1r => '1000x707mm', + b2r => '707x500mm', + b3r => '500x353mm', + b4r => '353x250mm', + b5r => '250x176mm', + b6r => '176x125mm', + b7r => '125x88mm', + b8r => '88x62mm', + b9r => '62x44mm', + b10r => '44x31mm', + c0 => '917x1297mm', + c1 => '648x917mm', + c2 => '458x648mm', + c3 => '324x458mm', + c4 => '229x324mm', + c5 => '162x229mm', + c6 => '114x162mm', + c7 => '81x114mm', + c8 => '57x81mm', + c9 => '40x57mm', + c10 => '28x40mm', + c0r => '1297x917mm', + c1r => '917x648mm', + c2r => '648x458mm', + c3r => '458x324mm', + c4r => '324x229mm', + c5r => '229x162mm', + c6r => '162x114mm', + c7r => '114x81mm', + c8r => '81x57mm', + c9r => '57x40mm', + c10r => '40x28mm', + us => '8.5x11', + letter => '8.5x11', + ledger => '17x11', + tabloid => '11x17', + usr => '11x8.5', + legal => '8.5x14', + legalr => '14x8.5', + foolscap => '13.5x17.0', + foolscapr => '17.0x13.5', +); + +my %pdftex_papersize = ( + "a4" => [ '210 true mm', '297 true mm' ], + "letter" => [ '8.5 true in', '11 true in' ], +); + +my %dvipdfm_papersize = ( + "a3" => 1, + "a4" => 1, + "ledger" => 1, + "legal" => 1, + "letter" => 1, + "tabloid" => 1, +); + +my %psutils_papersize = ( "a4" => 1, "letter" => 1, ); + + + + +=item C<get_paper_list($prog)> + +Returns the list of supported paper sizes with the first entry being +the currently selected one. + +=cut + +sub get_paper_list { + my $prog = shift; + return ( &{$paper{$prog}{'sub'}} ( "/dummy", "--returnlist" ) ); +} + +=item C<get_paper($prog)> + +Returns the currently selected paper size for program C<$prog>. + +=cut + +sub get_paper { + my $pps = get_paper_list(shift); + return $pps->[0]; +} + +=item C<do_paper($prog,$texmfsysconfig,@args)> + +Call the paper subroutine for C<$prog>, passing args. + +Returns a reference to a list of papers if called with C<--returnlist>, +otherwise one of the standard flags (see TeXLive::TLConfig). + +=cut + +sub do_paper { + my ($prog,$texmfsysconfig,@args) = @_; + if (exists $paper{$prog}{'sub'}) { + my $sub = $paper{$prog}{'sub'}; + return(&$sub($texmfsysconfig, @args)); + } else { + tlwarn("$prg: unknown paper program $prog ($texmfsysconfig,@args)\n"); + return($F_ERROR); + } + return ($F_OK); # not reached +} + + +=item C<paper_all($texmfsysconfig, $newpaper)> + +Pass all C<@args> to each paper subroutine in turn, thus setting the +paper size for all supported programs. Returns the bit-mapped return +values of the single subroutine returns. + +=cut + +sub paper_all { + my $ret = $F_OK; + for my $p (sort keys %paper) { + $ret |= &{$paper{$p}{'sub'}} (@_); + } + return($ret); +} + + +# return the config file to look in by running kpsewhich with the +# specified PROGNAME, FORMAT, and @FILENAMES. If no result, give a +# warning and return the empty string. +# +sub find_paper_file { + my ($progname, $format, @filenames) = @_; + my $ret = ""; + + my $cmd; + for my $filename (@filenames) { + $cmd = qq!kpsewhich --progname=$progname --format="$format" $filename!; + chomp($ret = `$cmd`); + if ($ret) { + debug("paper file for $progname ($format) $filename: $ret\n"); + last; + } + } + + debug("$prg: found no paper file for $progname (from $cmd)\n") if ! $ret; + return $ret; +} + +sub setup_names { + my $prog = shift; + my $outcomp = $paper_config_path_component{$prog} + || $paper{$prog}{'default_component'}; + my $filecomp = $paper_config_name{$prog} + || $paper{$prog}{'default_file'}; + return ($outcomp, $filecomp); +} + + +# xdvi format: +# /--- XDvi --- +# |... +# |*paper: <NAME> +# |... +# \------------ +# +# Reading is done via --progname=xdvi --format='other text files' XDvi +# Writing is done to TEXMFSYSCONFIG/xdvi/XDvi +# +sub paper_xdvi { + my $outtree = shift; + my $newpaper = shift; + + my ($outcomp, $filecomp) = setup_names("xdvi"); + my $dftfile = $paper{'xdvi'}{'default_file'}; + my $outfile = "$outtree/$outcomp/$filecomp"; + my $inp = &find_paper_file("xdvi", "other text files", $filecomp, $dftfile); + + return($F_ERROR) unless $inp; + + + my @sizes = keys %xdvi_papersize; + return &paper_do_simple($inp, "xdvi", '^\*paper: ', '^\*paper:\s+(\w+)\s*$', + sub { + my ($ll,$np) = @_; + $ll =~ s/^\*paper:\s+(\w+)\s*$/\*paper: $np\n/; + return($ll); + }, $outfile, \@sizes, '(undefined)', '*paper: a4', $newpaper); +} + + +# pdftex pdftexconfig.dat format +# /--- pdftexconfig.tex --- +# |... +# |\pdfpageheight = 297 true mm +# |\pdfpagewidth = 210 true mm +# |... +# \------------------------ +# +# Reading is done via --progname=pdftex --format='tex' pdftexconfig.tex +# Writing is done to TEXMFSYSCONFIG/tex/generic/config/pdftexconfig.tex +# +sub paper_pdftex { + my $outtree = shift; + my $newpaper = shift; + my ($outcomp, $filecomp) = setup_names("pdftex"); + my $dftfile = $paper{'pdftex'}{'default_file'}; + my $outfile = "$outtree/$outcomp/$filecomp"; + my $inp = &find_paper_file("pdftex", "tex", $filecomp, $dftfile); + + return($F_ERROR) unless $inp; + + open(FOO, "<$inp") || die "$prg: open($inp) failed: $!"; + my @lines = <FOO>; + close(FOO); + + my @cpwidx; + my @cphidx; + my ($cpw, $cph); + my $endinputidx; + # read the lines and the last pdfpageswidth/height wins + for my $idx (0..$#lines) { + my $l = $lines[$idx]; + if ($l =~ m/^\s*\\pdfpagewidth\s*=\s*([0-9.,]+\s*true\s*[^\s]*)/) { + if (defined($cpw) && $cpw ne $1) { + tl_warn("TLPaper: inconsistent paper sizes in $inp for page width! Please fix that.\n"); + return $F_ERROR; + } + $cpw = $1; + push @cpwidx, $idx; + next; + } + if ($l =~ m/^\s*\\pdfpageheight\s*=\s*([0-9.,]+\s*true\s*[^\s]*)/) { + if (defined($cph) && $cph ne $1) { + tl_warn("TLPaper: inconsistent paper sizes in $inp for page height! Please fix that.\n"); + return $F_ERROR; + } + $cph = $1; + push @cphidx, $idx; + next; + } + if ($l =~ m/^\s*\\endinput\s*/) { + $endinputidx = $idx; + next; + } + } + # trying to find the right papersize + # + my $currentpaper; + if (defined($cpw) && defined($cph)) { + for my $pname (keys %pdftex_papersize) { + my ($w, $h) = @{$pdftex_papersize{$pname}}; + if (($w eq $cpw) && ($h eq $cph)) { + $currentpaper = $pname; + last; + } + } + } else { + $currentpaper = "(undefined)"; + } + $currentpaper || ($currentpaper = "$cpw x $cph"); + if (defined($newpaper)) { + if ($newpaper eq "--list") { + info("$currentpaper\n"); + for my $p (keys %pdftex_papersize) { + info("$p\n") unless ($p eq $currentpaper); + } + } elsif ($newpaper eq "--json") { + my @ret = (); + push @ret, "$currentpaper"; + for my $p (keys %pdftex_papersize) { + push @ret, $p unless ($p eq $currentpaper); + } + my %foo; + $foo{'program'} = "pdftex"; + $foo{'file'} = $inp; + $foo{'options'} = \@ret; + return \%foo; + } elsif ($newpaper eq "--returnlist") { + my @ret = (); + push @ret, "$currentpaper"; + for my $p (keys %pdftex_papersize) { + push @ret, $p unless ($p eq $currentpaper); + } + return \@ret; + } else { + my $found = 0; + for my $p (keys %pdftex_papersize) { + if ($p eq $newpaper) { + $found = 1; + last; + } + } + if ($found) { + my $newwidth = ${$pdftex_papersize{$newpaper}}[0]; + my $newheight = ${$pdftex_papersize{$newpaper}}[1]; + if (@cpwidx) { + for my $idx (@cpwidx) { + ddebug("TLPaper: before line: $lines[$idx]"); + ddebug("TLPaper: replacement: $newwidth\n"); + $lines[$idx] =~ s/^\s*\\pdfpagewidth\s*=\s*[0-9.,]+\s*true\s*[^\s]*/\\pdfpagewidth = $newwidth/; + ddebug("TLPaper: after line : $lines[$idx]"); + } + } else { + my $addlines = "\\pdfpagewidth = $newwidth\n"; + if (defined($endinputidx)) { + $lines[$endinputidx] = $addlines . $lines[$endinputidx]; + } else { + $lines[$#lines] = $addlines; + } + } + if (@cphidx) { + for my $idx (@cphidx) { + ddebug("TLPaper: before line: $lines[$idx]"); + ddebug("TLPaper: replacement: $newheight\n"); + $lines[$idx] =~ s/^\s*\\pdfpageheight\s*=\s*[0-9.,]+\s*true\s*[^\s]*/\\pdfpageheight = $newheight/; + ddebug("TLPaper: after line : $lines[$idx]"); + } + } else { + my $addlines = "\\pdfpageheight = $newheight"; + if (defined($endinputidx)) { + $lines[$endinputidx] = $addlines . $lines[$endinputidx]; + } else { + $lines[$#lines] = $addlines; + } + } + info("$prg: setting paper size for pdftex to $newpaper: $outfile\n"); + mkdirhier(dirname($outfile)); + # if we create the outfile we have to call mktexlsr + TeXLive::TLUtils::announce_execute_actions("files-changed") + unless (-r $outfile); + if (!open(TMP, ">$outfile")) { + tlwarn("$prg: Cannot write to $outfile: $!\n"); + tlwarn("Not setting paper size for pdftex.\n"); + return($F_ERROR); + } + for (@lines) { print TMP; } + close(TMP) || warn "$prg: close(>$outfile) failed: $!"; + TeXLive::TLUtils::announce_execute_actions("regenerate-formats"); + # TODO should we return the value of announce_execute action? + return($F_OK); + } else { + tlwarn("$prg: Not a valid paper size for pdftex: $newpaper\n"); + return($F_WARNING); + } + } + } else { + info("Current pdftex paper size (from $inp): $currentpaper\n"); + } + return($F_OK); +} + + +# dvips config.ps format: +# /--- config.ps --- +# |... +# |stuff not related to paper sizes +# |... +# | <empty line> +# |% some comments +# |% more comments +# |@ <NAME> <WIDTH> <HEIGHT> +# |@+ ...definition line +# |@+ ...definition line +# |... more definition lines +# |@+ %%EndPaperSize +# | +# |@ <NAME> <WIDTH> <HEIGHT> +# |... +# \------------ +# +# the first paper definition is the default +# selecting paper is done like with texconfig which used ed to move the +# selected part between @ $selected_paper .... @ /-1 (the line before the +# next @ line) to the line before the first @ line. +# (what a tricky ed invocation te created there, impressive!!!) +# +# Reading is done via --progname=dvips --format='dvips config' config.ps +# Writing is done to TEXMFSYSCONFIG/dvips/config/config.ps +# +sub paper_dvips { + my $outtree = shift; + my $newpaper = shift; + + my ($outcomp, $filecomp) = setup_names("dvips"); + my $dftfile = $paper{'dvips'}{'default_file'}; + my $outfile = "$outtree/$outcomp/$filecomp"; + my $inp = &find_paper_file("dvips", "dvips config", $filecomp, $dftfile); + + return($F_ERROR) unless $inp; + + open(FOO, "<$inp") || die "$prg: open($inp) failed: $!"; + my @lines = <FOO>; + close(FOO); + + my @papersizes; + my $firstpaperidx; + my %startidx; + my %endidx; + my $in_block = ""; + my $idx = 0; + for my $idx (0 .. $#lines) { + if ($lines[$idx] =~ m/^@ (\w+)/) { + $startidx{$1} = $idx; + $firstpaperidx || ($firstpaperidx = $idx-1); + $in_block = $1; + push @papersizes, $1; + next; + } + # empty lines or comments stop a block + if ($in_block) { + if ($lines[$idx] =~ m/^\s*(%.*)?\s*$/) { + $endidx{$in_block} = $idx-1; + $in_block = ""; + } + next; + } + } + + if (defined($newpaper)) { + if ($newpaper eq "--list") { + for my $p (@papersizes) { + info("$p\n"); # first is already the selected one + } + } elsif ($newpaper eq "--json") { + my %foo; + $foo{'program'} = "dvips"; + $foo{'file'} = $inp; + $foo{'options'} = \@papersizes; + return \%foo; + } elsif ($newpaper eq "--returnlist") { + return(\@papersizes); + } else { + my $found = 0; + for my $p (@papersizes) { + if ($p eq $newpaper) { + $found = 1; + last; + } + } + if ($found) { + my @newlines; + for my $idx (0..$#lines) { + if ($idx < $firstpaperidx) { + push @newlines, $lines[$idx]; + next; + } + if ($idx == $firstpaperidx) { + # insert the selected paper definition + push @newlines, @lines[$startidx{$newpaper}..$endidx{$newpaper}]; + push @newlines, $lines[$idx]; + next; + } + if ($idx >= $startidx{$newpaper} && $idx <= $endidx{$newpaper}) { + next; + } + push @newlines, $lines[$idx]; + } + info("$prg: setting paper size for dvips to $newpaper: $outfile\n"); + mkdirhier(dirname($outfile)); + # if we create the outfile we have to call mktexlsr + TeXLive::TLUtils::announce_execute_actions("files-changed") + unless (-r $outfile); + if (!open(TMP, ">$outfile")) { + tlwarn("$prg: Cannot write to $outfile: $!\n"); + tlwarn("Not setting paper size for dvips.\n"); + return ($F_ERROR); + } + for (@newlines) { print TMP; } + close(TMP) || warn "$prg: close(>$outfile) failed: $!"; + } else { + tlwarn("$prg: Not a valid paper size for dvips: $newpaper\n"); + return($F_WARNING); + } + } + } else { + info("Current dvips paper size (from $inp): $papersizes[0]\n"); + } + return($F_OK); +} + + +# dvipdfm(x) format: +# /--- dvipdfm/config, dvipdfmx/dvipdfmx.cfg --- +# |... +# |p <NAME> +# |... +# \------------ +# +# Reading is done +# for dvipdfm via --progname=dvipdfm --format='other text files' config +# for dvipdfmx via --progname=dvipdfmx --format='other text files' dvipdfmx.cfg +# Writing is done to TEXMFSYSCONFIG/dvipdfm/config/config +# and /dvipdfmx/dvipdfmx.cfg +# +# +sub do_dvipdfm_and_x { + my ($inp,$prog,$outtree,$paplist,$newpaper) = @_; + + my ($outcomp, $filecomp) = setup_names($prog); + my $outfile = "$outtree/$outcomp/$filecomp"; + + return &paper_do_simple($inp, $prog, '^p\s+', '^p\s+(\w+)\s*$', + sub { + my ($ll,$np) = @_; + $ll =~ s/^p\s+(\w+)\s*$/p $np\n/; + return($ll); + }, $outfile, $paplist, '(undefined)', 'p a4', $newpaper); +} + +sub paper_dvipdfm { + my $outtree = shift; + my $newpaper = shift; + + my ($outcomp, $filecomp) = setup_names("dvipdfm"); + my $dftfile = $paper{'dvipdfm'}{'default_file'}; + my $inp = &find_paper_file("dvipdfm", "other text files", $filecomp, $dftfile); + return ($F_ERROR) unless $inp; + + my @sizes = keys %dvipdfm_papersize; + return &do_dvipdfm_and_x($inp, "dvipdfm", $outtree, \@sizes, $newpaper); +} + +sub paper_dvipdfmx { + my $outtree = shift; + my $newpaper = shift; + + my ($outcomp, $filecomp) = setup_names("dvipdfmx"); + my $dftfile = $paper{'dvipdfmx'}{'default_file'}; + + my $inp = &find_paper_file("dvipdfmx", "other text files", $filecomp, $dftfile); + return ($F_ERROR) unless $inp; + + my @sizes = keys %dvipdfm_papersize; + return &do_dvipdfm_and_x($inp, "dvipdfmx", $outtree, \@sizes, $newpaper); +} + + +# context format: +# /--- cont-sys.{tex,rme} +# |... +# |\setuppapersize[letter][letter] +# |... +# \------------ +# +sub paper_context { + my $outtree = shift; + my $newpaper = shift; + my ($outcomp, $filecomp) = setup_names("context"); + my $dftfile = $paper{'context'}{'default_file'}; + my $outfile = "$outtree/$outcomp/$filecomp"; + my $inp = &find_paper_file("context", "tex", $filecomp, "cont-sys.rme", $dftfile); + + return($F_ERROR) unless $inp; + + open(FOO, "<$inp") || die "$prg: open($inp) failed: $!"; + my @lines = <FOO>; + close(FOO); + + my @idx; + my $idxlast; + my $endinputidx = -1; + my $currentpaper; + # read the lines and the last setuppapersize before the endinput wins + for my $idx (0..$#lines) { + my $l = $lines[$idx]; + if ($l =~ m/^[^%]*\\endinput/) { + $endinputidx = $idx; + last; + } + if ($l =~ m/^\s*\\setuppapersize\s*\[([^][]*)\].*$/) { + if (defined($currentpaper) && $currentpaper ne $1) { + tl_warn("TLPaper: inconsistent paper sizes in $inp! Please fix that.\n"); + return $F_ERROR; + } + $currentpaper = $1; + $idxlast = $idx; + push @idx, $idx; + next; + } + } + # if we haven't found a paper line, assume a4 + $currentpaper || ($currentpaper = "a4"); + # trying to find the right papersize + # + if (defined($newpaper)) { + if ($newpaper eq "--list") { + info("$currentpaper\n"); + for my $p (keys %pdftex_papersize) { + info("$p\n") unless ($p eq $currentpaper); + } + } elsif ($newpaper eq "--json") { + my @ret = (); + push @ret, "$currentpaper"; + for my $p (keys %pdftex_papersize) { + push @ret, $p unless ($p eq $currentpaper); + } + my %foo; + $foo{'program'} = "context"; + $foo{'file'} = $inp; + $foo{'options'} = \@ret; + return \%foo; + } elsif ($newpaper eq "--returnlist") { + my @ret = (); + push @ret, "$currentpaper"; + for my $p (keys %pdftex_papersize) { + push @ret, $p unless ($p eq $currentpaper); + } + return \@ret; + } else { + my $found = 0; + for my $p (keys %pdftex_papersize) { + if ($p eq $newpaper) { + $found = 1; + last; + } + } + if ($found) { + if (@idx) { + for my $idx (@idx) { + ddebug("TLPaper: before line: $lines[$idx]"); + ddebug("TLPaper: replacement: $newpaper\n"); + $lines[$idx] =~ s/setuppapersize\s*\[([^][]*)\]\[([^][]*)\]/setuppapersize[$newpaper][$newpaper]/; + ddebug("TLPaper: after line : $lines[$idx]"); + } + } else { + my $addlines = "\\setuppapersize[$newpaper][$newpaper]\n"; + if (defined($endinputidx)) { + $lines[$endinputidx] = $addlines . $lines[$endinputidx]; + } else { + $lines[$#lines] = $addlines; + } + } + info("$prg: setting paper size for context to $newpaper: $outfile\n"); + mkdirhier(dirname($outfile)); + # if we create the outfile we have to call mktexlsr + TeXLive::TLUtils::announce_execute_actions("files-changed") + unless (-r $outfile); + if (!open(TMP, ">$outfile")) { + tlwarn("$prg: Cannot write to $outfile: $!\n"); + tlwarn("Not setting paper size for context.\n"); + return($F_ERROR); + } + for (@lines) { print TMP; } + close(TMP) || warn "$prg: close(>$outfile) failed: $!"; + TeXLive::TLUtils::announce_execute_actions("regenerate-formats"); + # TODO should we return the value of announce_execute action? + return($F_OK); + } else { + tlwarn("$prg: Not a valid paper size for context: $newpaper\n"); + return($F_WARNING); + } + } + } else { + info("Current context paper size (from $inp): $currentpaper\n"); + } + return($F_OK); +} + +sub paper_context_old { + my $outtree = shift; + my $newpaper = shift; + + my ($outcomp, $filecomp) = setup_names("context"); + my $dftfile = $paper{'context'}{'default_file'}; + my $outfile = "$outtree/$outcomp/$filecomp"; + my $inp = &find_paper_file("context", "tex", $filecomp, "cont-sys.rme", $dftfile); + return ($F_ERROR) unless $inp; + + my @sizes = keys %pdftex_papersize; + # take care here, the \\\\ are necessary in some places and not in + # some others because there is no intermediate evaluation + return &paper_do_simple($inp, "context", '^\s*%?\s*\\\\setuppapersize\s*', + '^\s*%?\s*\\\\setuppapersize\s*\[([^][]*)\].*$', + sub { + my ($ll,$np) = @_; + if ($ll =~ m/^\s*%?\s*\\setuppapersize\s*/) { + return("\\setuppapersize[$np][$np]\n"); + } else { + return($ll); + } + }, + $outfile, \@sizes, 'a4', '\setuppapersize[a4][a4]', $newpaper); +} + + +# psutils +# config file "psutils/paper.cfg" only contains two words: +# p <papersize> +# +sub paper_psutils { + my $outtree = shift; + my $newpaper = shift; + + my ($outcomp, $filecomp) = setup_names("psutils"); + my $dftfile = $paper{'psutils'}{'default_file'}; + my $outfile = "$outtree/$outcomp/$filecomp"; + my $inp = &find_paper_file("psutils", "other text files", $filecomp, $dftfile); + + return ($F_ERROR) unless $inp; + + + my @sizes = keys %psutils_papersize; + return &paper_do_simple($inp, "psutils", '^\s*p', '^\s*p\s+(\w+)\s*$', + sub { + my ($ll,$np) = @_; + $ll =~ s/^\s*p\s+(\w+)\s*$/p $np\n/; + return($ll); + }, + $outfile, \@sizes, '(undefined)', 'p a4', $newpaper); +} + + +# paper_do_simple does the work for single line config files +# (xdvi, dvipdfm, ...) +# arguments: +# $inp, $prog, $firstre, $secondre, $bl, $outp, $paplist, $newpaper +# with +# $inp .. input file location +# $prog .. program name +# $firstre .. re that searches for paper lines +# $secondre .. re that extracts the paper from a paper line +# $bl .. block/sub taking two args, one paper line and the new paper, and +# returns the line with the paper configured, only lines mathing +# $firstre are shipped over to $bl +# $outp .. location of the output file +# $paplist .. ref to an array with the list of admissible paper sizes +# $defaultpaper .. default papersize (arbitrary string) if the $firstre is +# not found in the config file +# $defaultline .. the line to be added at the bottom of the file if +# no line has been found +# $newpaper .. --list, new paper, or undef +sub paper_do_simple { + my ($inp, $prog, $firstre, $secondre, $bl, $outp, $paplist, $defaultpaper, $defaultline, $newpaper) = @_; + + debug("file used for $prog: $inp\n"); + + open(FOO, "<$inp") or die("cannot open file $inp: $!"); + my @lines = <FOO>; + close(FOO); + + my $currentpaper; + my @paperlines = grep (m/$firstre/,@lines); + if (!@paperlines) { + $currentpaper = $defaultpaper; + } else { + if ($#paperlines > 0) { + warn "Strange, more than one paper definition, using the first one in\n$inp\n"; + } + $currentpaper = $paperlines[0]; + chomp($currentpaper); + $currentpaper =~ s/$secondre/$1/; + } + + # change value + if (defined($newpaper)) { + if ($newpaper eq "--list") { + info("$currentpaper\n"); + for my $p (@$paplist) { + info("$p\n") unless ($p eq $currentpaper); + } + } elsif ($newpaper eq "--json") { + my @ret = (); + push @ret, "$currentpaper"; + for my $p (@$paplist) { + push @ret, $p unless ($p eq $currentpaper); + } + my %foo; + $foo{'program'} = $prog; + $foo{'file'} = $inp; + $foo{'options'} = \@ret; + return \%foo; + } elsif ($newpaper eq "--returnlist") { + my @ret = (); + push @ret, $currentpaper; + for my $p (@$paplist) { + push @ret, $p unless ($p eq $currentpaper); + } + return(\@ret); + } else { + my $found = 0; + for my $p (@$paplist) { + if ($p eq $newpaper) { + $found = 1; + last; + } + } + if ($found) { + my @newlines; + my $foundcfg = 0; + for my $l (@lines) { + if ($l =~ m/$firstre/) { + push @newlines, &$bl($l, $newpaper); + $foundcfg = 1; + } else { + push @newlines, $l; + } + } + # what to do if no default line found??? + if (!$foundcfg) { + push @newlines, &$bl($defaultline, $newpaper); + } + info("$prg: setting paper size for $prog to $newpaper: $outp\n"); + mkdirhier(dirname($outp)); + # if we create the outfile we have to call mktexlsr + TeXLive::TLUtils::announce_execute_actions("files-changed") + unless (-r $outp); + if (!open(TMP, ">$outp")) { + tlwarn("$prg: Cannot write to $outp: $!\n"); + tlwarn("Not setting paper size for $prog.\n"); + return ($F_ERROR); + } + for (@newlines) { print TMP; } + close(TMP) || warn "$prg: close(>$outp) failed: $!"; + TeXLive::TLUtils::announce_execute_actions("regenerate-formats") + if ($prog eq "context"); + return($F_OK); + } else { + tlwarn("$prg: Not a valid paper size for $prog: $newpaper\n"); + return($F_WARNING); + } + } + } else { + # return the current value + info("Current $prog paper size (from $inp): $currentpaper\n"); + } + return($F_OK); +} + +=back +=cut +1; + +### Local Variables: +### perl-indent-level: 2 +### tab-width: 2 +### indent-tabs-mode: nil +### End: +# vim:set tabstop=2 expandtab: # |