path: root/Master/tlpkg/etc/test-code-for-papersize-in-perl.pl

#
# TODO TODO TODO
# if no paperconfig line is found in do_simple it adds to the end of the
# file the new line, but this does not work on context because it 
# has an \endinput at the end ... needs to be fixed
#
# output is done to stdout, not the right config file
#
$^W = 1;
use strict;


my %pdftex_papersize = (
  "letter" => [ '8.5 true in', '11 true in' ],
  "a4" => [ '210 true mm', '297 true mm' ],
);

my %xdvi_papersize;
$xdvi_papersize{'us'}='8.5x11';
$xdvi_papersize{'letter'}='8.5x11';
$xdvi_papersize{'usr'}='11x8.5';
$xdvi_papersize{'legal'}='8.5x14';
$xdvi_papersize{'ledger'}='17.0x11.0';
$xdvi_papersize{'tabloid'}= '11.0x17.0';
$xdvi_papersize{'foolscap'}='13.5x17.0';
$xdvi_papersize{'a1'}='59.4x84.0cm';
$xdvi_papersize{'a2'}='42.0x59.4cm';
$xdvi_papersize{'a3'}='29.7x42.0cm';
$xdvi_papersize{'a4'}='21.0x29.7cm';
$xdvi_papersize{'a5'}='14.85x21.0cm';
$xdvi_papersize{'a6'}='10.5x14.85cm';
$xdvi_papersize{'a7'}='7.42x10.5cm';
$xdvi_papersize{'a1r'}='84.0x59.4cm';
$xdvi_papersize{'a2r'}='59.4x42.0cm';
$xdvi_papersize{'a3r'}='42.0x29.7cm';
$xdvi_papersize{'a4r'}='29.7x21.0cm';
$xdvi_papersize{'a5r'}='21.0x14.85cm';
$xdvi_papersize{'a6r'}='14.85x10.5cm';
$xdvi_papersize{'a7r'}='10.5x7.42cm';
$xdvi_papersize{'b1'}='70.6x100.0cm';
$xdvi_papersize{'b2'}='50.0x70.6cm';
$xdvi_papersize{'b3'}='35.3x50.0cm';
$xdvi_papersize{'b4'}='25.0x35.3cm';
$xdvi_papersize{'b5'}='17.6x25.0cm';
$xdvi_papersize{'b6'}='13.5x17.6cm';
$xdvi_papersize{'b7'}='8.8x13.5cm';
$xdvi_papersize{'b1r'}='100.0x70.6cm';
$xdvi_papersize{'b2r'}='70.6x50.0cm';
$xdvi_papersize{'b3r'}='50.0x35.3cm';
$xdvi_papersize{'b4r'}='35.3x25.0cm';
$xdvi_papersize{'b5r'}='25.0x17.6cm';
$xdvi_papersize{'b6r'}='17.6x13.5cm';
$xdvi_papersize{'b7r'}='13.5x8.8cm';
$xdvi_papersize{'c1'}='64.8x91.6cm';
$xdvi_papersize{'c2'}='45.8x64.8cm';
$xdvi_papersize{'c3'}='32.4x45.8cm';
$xdvi_papersize{'c4'}='22.9x32.4cm';
$xdvi_papersize{'c5'}='16.2x22.9cm';
$xdvi_papersize{'c6'}='11.46x16.2cm';
$xdvi_papersize{'c7'}='8.1x11.46cm';
$xdvi_papersize{'c1r'}='91.6x64.8cm';
$xdvi_papersize{'c2r'}='64.8x45.8cm';
$xdvi_papersize{'c3r'}='45.8x32.4cm';
$xdvi_papersize{'c4r'}='32.4x22.9cm';
$xdvi_papersize{'c5r'}='22.9x16.2cm';
$xdvi_papersize{'c6r'}='16.2x11.46cm';
$xdvi_papersize{'c7r'}='11.46x8.1cm';

my %dvipdfm_papersize = ( 'letter' => 1, 'legal' => 1, 'ledger' => 1, 
                          'tabloid' => 1, 'a4' => 1, 'a3' => 1 );

my $texmfsysvar = `kpsewhich -var-value=TEXMFSYSVAR`; 
chomp($texmfsysvar);
my $texmfsysconfig = `kpsewhich -var-value=TEXMFSYSCONFIG`; 
chomp($texmfsysconfig);

# we are doing -sys variants
$ENV{"TEXMFVAR"} = $texmfsysvar;
$ENV{"TEXMFCONFIG"} = $texmfsysconfig;

my $what = shift;

if (!$what) {
  print "need an argument\n";
  exit 1;
}

# all subs do_* work the same way
# do_foobar --list
#    list all available sizes with the selected first
# do_foobar
#    informational string which paper has been selected
# doo_foobar <paper>
#    selects the given <paper>

if ($what eq "dvips") {
  do_dvips(@ARGV);
} elsif ($what eq "dvipdfm") {
  do_dvipdfm(@ARGV);
} elsif ($what eq "dvipdfmx") {
  do_dvipdfmx(@ARGV);
} elsif ($what eq "context") {
  do_context(@ARGV);
} elsif ($what eq "pdftex") {
  do_pdftex(@ARGV);
} elsif ($what eq "xdvi") {
  do_xdvi(@ARGV);
} else {
  print "Unknown what $what!\n";
  exit 1;
}
exit 0;

#
# pdftex pdftexconfig.tex format
# /--- pdftexconfig.tex ---
# |...
# |\pdfpagewidth=NNN true <unit>
# |\pdfpageheight=NNN true <unit>
# |...
# \------------------------
#
# Reading is done via --progname=pdftex --format='tex' pdftexconfig.tex
# Writing is done to TEXMFSYSCONFIG/tex/generic/config/pdftexconfig.tex
#
sub do_pdftex {
  my $newpaper = shift;
  my $cf = `kpsewhich --progname=pdftex --format=tex pdftexconfig.tex`;
  chomp($cf);
  print STDERR "file used for pdftex: $cf\n";

  open(FOO, "<$cf") or die("cannot open file: $!");
  my @lines = <FOO>;
  close(FOO);

  my ($cpw, $cph);
  my ($cpwidx, $cphidx);
  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*(.+)\s*$/) {
      $cpw = $1;
      $cpwidx = $idx;
      next;
    }
    if ($l =~ m/^\s*\\pdfpageheight\s*=?\s*(.+)\s*$/) {
      $cph = $1;
      $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") {
      print "$currentpaper\n";
      for my $p (keys %pdftex_papersize) {
        print "$p\n" unless ($p eq $currentpaper);
      }
    } else {
      my $found = 0;
      for my $p (keys %pdftex_papersize) {
        if ($p eq $newpaper) {
          $found = 1;
          last;
        }
      }
      if ($found) {
        my $newwline = 
          '\pdfpagewidth=' . ${$pdftex_papersize{$newpaper}}[0] . "\n";
        my $newhline = 
          '\pdfpageheight=' . ${$pdftex_papersize{$newpaper}}[1] . "\n";
        if (defined($cpwidx)) {
          $lines[$cpwidx] = $newwline;
        } else {
          if (defined($endinputidx)) {
            $lines[$endinputidx] = $newwline . $lines[$endinputidx];
          } else {
            $lines[$#lines] = $newwline;
          }
        }
        if (defined($cphidx)) {
          $lines[$cphidx] = $newhline;
        } else {
          if (defined($endinputidx)) {
            $lines[$endinputidx] = $newhline . $lines[$endinputidx];
          } else {
            $lines[$#lines] = $newwline;
          }
        }
        for (@lines) { print; }
      } else {
        warn "Not a valid paper size for pdftex: $newpaper\n";
      }
    }
  } else {
    # just print the current value
    print "current pdftex paper size: $currentpaper\n";
  }
}

###############################################
#
# 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 do_dvips {
  my $newpaper = shift;
  my $configps = `kpsewhich --progname=dvips --format='dvips config' config.ps`;
  chomp($configps);
  print "file used: $configps\n";

  open(FOO, "<$configps") or die("cannot open file: $!");
  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;
    }
  }

  #for my $p (@papersizes) {
  #  print "papersize $p from idx $startidx{$p} to $endidx{$p}\n";
  #}

  if (defined($newpaper)) {
    if ($newpaper eq "--list") {
      for my $p (@papersizes) {
        print "$p\n"; # first is already the selected one
      }
    } 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];
        }
        # output should go to $texmfsysconfig/dvips/config/config.ps TODO TODO
        for (@newlines) { print; }
      } else {
        warn "Not a valid paper size for dvips: $newpaper\n";
      }
    }
  } else {
    # just print the current value
    print "current dvips paper size: $papersizes[0]\n";
  }
}

#
# context format:
# /--- cont-sys.{tex,rme}
# |...
# |\setuppapersize[letter][letter]
# |...
# \------------
# 
# Reading is done first via kpsewhich -prog=tex -format=tex cont-sys.tex
# if that fails via  -prog=tex -format='other text files' cont-sys.rme
#
# Writing is done to TEXMFSYSCONFIG/tex/context/user/cont-sys.tex
#
sub do_context {
  my $newpaper = shift;
  # TODO TODO 
  # we should check whether context is installed at all!!!!
  my $inp = `kpsewhich --progname=tex --format=tex cont-sys.tex`;
  chomp($inp);
  if (!$inp) {
    # we didn't get anything, so retry with .rme
    $inp = `kpsewhich --progname=tex --format='other text files' cont-sys.rme`;
    chomp($inp);
  }
  my @bla = keys %pdftex_papersize;
  do_simple($inp, "context", '^\s*\\setuppapersize\s*', 
            '^\s*\\setuppapersize\s*\[([^][]*)\]',
            sub {
              my ($ll,$np) = @_;
                if ($ll =~ m/^\s*\\setuppapersize\s*/) {
                return("\\setuppapersize[$np][$np]\n");
              } else {
                return($ll);
              }
            }, "tex/context/user/cont-sys.rme", \@bla, 
            'a4', '\setuppapersize[a4][a4]', $newpaper);
}


#
# xdvi format:
# /--- XDvi ---
# |...
# |*paper: <NAME>
# |...
# \------------
#
# Reading is done via --progname=xdvi --format='other text files' XDvi
# Writing is done to TEXMFSYSCONFIG/xdvi/XDvi
#
sub do_xdvi {
  my $newpaper = shift;
  my $xdvi = `kpsewhich --progname=xdvi --format='other text files' XDvi`;
  chomp($xdvi);
  my @bla = keys %xdvi_papersize;
  do_simple($xdvi, "xdvi", '^\*paper: ', '^\*paper:\s+(\w+)\s*$',
            sub {
              my ($ll,$np) = @_;
              $ll =~ s/^\*paper:\s+(\w+)\s*$/\*paper: $np\n/;
              return($ll);
            }, "xdvi/XDvi", \@bla, 
            '(not defined)', '*paper: a4', $newpaper);
}


#
# 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, $outp, $paplist, $newpaper) = @_;
  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);
            }, $outp, $paplist, '(not defined)', 'p a4', $newpaper);
}

sub do_dvipdfm {
  my $newpaper = shift;
  my $inp = `kpsewhich --progname=dvipdfm --format='other text files' config`;
  chomp($inp);
  my @bla = keys %dvipdfm_papersize;
  do_dvipdfm_and_x($inp, "dvipdfm", "dvipdfm/config/config", \@bla, $newpaper);
}
sub do_dvipdfmx {
  my $newpaper = shift;
  my $inp = `kpsewhich --progname=dvipdfmx --format='other text files' dvipdfmx.cfg`;
  chomp($inp);
  my @bla = keys %dvipdfm_papersize;
  do_dvipdfm_and_x($inp, "dvipdfmx", "dvipdfmx/dvipdfmx.cfg", \@bla, $newpaper);
}



#
# do_simple does the work for single line config files
# (xdvi, dvipdfm, dvipdfmx)
# 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 do_simple {
  my ($inp, $prog, $firstre, $secondre, $bl, $outp, $paplist, $defaultpaper, $defaultline, $newpaper) = @_;

  print STDERR "file used for $prog: $inp\n";

  open(FOO, "<$inp") or die("cannot open file: $!");
  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 definiton, using the first one!\n";
    }
    $currentpaper = $paperlines[0];
    chomp($currentpaper);
    $currentpaper =~ s/$secondre/$1/;
  }

  # change value
  if (defined($newpaper)) {
    if ($newpaper eq "--list") {
      print "$currentpaper\n";
      for my $p (@$paplist) {
        print "$p\n" unless ($p eq $currentpaper);
      }
    } 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);
        }
        # should save to $outf
        for (@newlines) { print; }
      } else {
        warn "Not a valid paper size for $prog: $newpaper\n";
      }
    }
  } else {
    # just return the current value
    print "Current paper setting for $prog: $currentpaper\n";
  }
}


### Local Variables:
### perl-indent-level: 2
### tab-width: 2
### indent-tabs-mode: nil
### End:
# vim:set tabstop=2 expandtab: #