fix TLPaper for context with endinput

git-svn-id: svn://tug.org/texlive/trunk@39129 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 108 insertions, 9 deletions

diff --git a/Master/tlpkg/TeXLive/TLPaper.pm b/Master/tlpkg/TeXLive/TLPaper.pm
index b4b3e431d40..56a359fa75d 100644
--- a/Master/tlpkg/TeXLive/TLPaper.pm
+++ b/Master/tlpkg/TeXLive/TLPaper.pm
@@ -1,17 +1,13 @@
-# $Id$
+# $Id: TLPaper.pm 39006 2015-12-03 18:53:45Z karl $
 # TeXLive::TLPaper.pm - query/modify paper sizes for our various programs
 # Copyright 2008-2015 Norbert Preining
 # This file is licensed under the GNU General Public License version 2
 # or any later version.
 #
-# TODO TODO TODO
-# if no paperconfig line is found in paper_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
 
 package TeXLive::TLPaper;
 
-my $svnrev = '$Revision$';
+my $svnrev = '$Revision: 39006 $';
 my $_modulerevision;
 if ($svnrev =~ m/: ([0-9]+) /) {
   $_modulerevision = $1;
@@ -645,6 +641,109 @@ sub paper_dvipdfmx {
 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 "$0: 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 "--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("$0: setting paper size for context to $newpaper.\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("$0: Cannot write to $outfile: $!\n");
+          tlwarn("Not setting paper size for context.\n");
+          return($F_ERROR);
+        }
+        for (@lines) { print TMP; }
+        close(TMP) || warn "$0: 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("$0: 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'};
@@ -655,11 +754,11 @@ sub paper_context {
   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*\\\\setuppapersize\s*', 
-            '^\s*\\\\setuppapersize\s*\[([^][]*)\].*$',
+  return &paper_do_simple($inp, "context", '^\s*%?\s*\\\\setuppapersize\s*', 
+            '^\s*%?\s*\\\\setuppapersize\s*\[([^][]*)\].*$',
             sub {
               my ($ll,$np) = @_;
-              if ($ll =~ m/^\s*\\setuppapersize\s*/) {
+              if ($ll =~ m/^\s*%?\s*\\setuppapersize\s*/) {
                 return("\\setuppapersize[$np][$np]\n");
               } else {
                 return($ll);