texlive[66757] Master/tlpkg/TeXLive/TLPaper.pm: TLPaper: work with

commits+preining at tug.org commits+preining at tug.org
Tue Apr 4 16:00:33 CEST 2023


Revision: 66757
          http://tug.org/svn/texlive?view=revision&revision=66757
Author:   preining
Date:     2023-04-04 16:00:33 +0200 (Tue, 04 Apr 2023)
Log Message:
-----------
TLPaper: work with new context (mkxl and mkiv)

Modified Paths:
--------------
    trunk/Master/tlpkg/TeXLive/TLPaper.pm

Modified: trunk/Master/tlpkg/TeXLive/TLPaper.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLPaper.pm	2023-04-03 23:49:27 UTC (rev 66756)
+++ trunk/Master/tlpkg/TeXLive/TLPaper.pm	2023-04-04 14:00:33 UTC (rev 66757)
@@ -1,6 +1,6 @@
 # $Id$
 # TeXLive::TLPaper.pm - query/modify paper sizes for our various programs
-# Copyright 2008-2021 Norbert Preining
+# Copyright 2008-2023 Norbert Preining
 # This file is licensed under the GNU General Public License version 2
 # or any later version.
 
@@ -83,8 +83,14 @@
   "context"  => {
     sub => \&paper_context,
     default_component => "tex/context/user",
-    default_file      => "cont-sys.tex",
+    default_file      => "cont-sys.mkxl",
     pkg => "context",
+    variant => {
+      sub => \&paper_context,
+      default_component => "tex/context/user",
+      default_file      => "cont-sys.mkiv",
+      pkg => "context",
+    }
   },
   "psutils"  => {
     sub => \&paper_psutils,
@@ -184,6 +190,8 @@
   "letter" => [ '8.5 true in', '11 true in' ],
 );
 
+my %context_papersize = ( "A4" => 1, "letter" => 1, );
+
 my %dvipdfm_papersize = (
   "a3" => 1,
   "a4" => 1,
@@ -284,10 +292,11 @@
 
 sub setup_names {
   my $prog = shift;
+  my $variant = shift || "";
   my $outcomp = $paper_config_path_component{$prog}
-                || $paper{$prog}{'default_component'};
+                || ($variant eq "variant" ? $paper{$prog}{'variant'}{'default_component'} : $paper{$prog}{'default_component'});
   my $filecomp = $paper_config_name{$prog}
-                 || $paper{$prog}{'default_file'};
+                 || ($variant eq "variant" ? $paper{$prog}{'variant'}{'default_file'} : $paper{$prog}{'default_file'});
   return ($outcomp, $filecomp);
 }
 
@@ -672,7 +681,7 @@
 
 

 # context format:
-# /--- cont-sys.{tex,rme}
+# /--- cont-sys.mkxl  and cont-sys.mkiv // formerly {tex,rme}
 # |...
 # |\setuppapersize[letter][letter]
 # |...
@@ -681,57 +690,85 @@
 sub paper_context {
   my $outtree = shift;
   my $newpaper = shift;
-  my ($outcomp, $filecomp) = setup_names("context");
-  my $dftfile = $paper{'context'}{'default_file'};
+  # context mkxl actually expects "A4" in contrast to all previous versions
+  # of context - thanks! But since tlmgr expects to work with a4/letter,
+  # rewrite a4 -> A4 in the actual function.
+  if ($newpaper && $newpaper eq "a4") {
+    $newpaper = "A4";
+  }
+  return (__paper_context($outtree, $newpaper, "context") | __paper_context($outtree, $newpaper, "variant"));
+}
+
+sub __paper_context {
+  my $outtree = shift;
+  my $newpaper = shift;
+  my $what = shift;
+  my $prog = $what;
+  my $prog_long = $what;
+  if ($what eq "variant") {
+    $prog = "context";
+    $prog_long = "context (MkIV)";
+  }
+  my ($outcomp, $filecomp) = setup_names($prog, $what);
+  my $dftfile = ($what eq 'variant' ? $paper{$prog}{'variant'}{'default_file'} : $paper{$prog}{'default_file'});
   my $outfile = "$outtree/$outcomp/$filecomp";
-  my $inp = &find_paper_file("context", "tex", $filecomp, "cont-sys.rme", $dftfile);
+  my $inp = &find_paper_file("context", "tex", $filecomp, $dftfile);
 
-  return($F_ERROR) unless $inp; 
+  # return($F_ERROR) unless $inp;
+  # We don't return error here, since the default configuration file
+  # for context might not have been generated by now cont-sys.mkxl
+  #
 
-  open(FOO, "<$inp") || die "$prg: open($inp) failed: $!";
-  my @lines = <FOO>;
-  close(FOO);
-
+  my @lines;
+  my $endinputidx = -1;
   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;
+  if ($inp) {
+    open(FOO, "<$inp") || die "$prg: open($inp) failed: $!";
+    @lines = <FOO>;
+    close(FOO);
+
+    # 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;
       }
-      $currentpaper = $1;
-      $idxlast = $idx;
-      push @idx, $idx;
-      next;
+      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;
+      }
     }
+  } else {
+    @lines = []
+    # TODO ???
   }
   # if we haven't found a paper line, assume a4
-  $currentpaper || ($currentpaper = "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) {
+      for my $p (keys %context_papersize) {
         info("$p\n") unless ($p eq $currentpaper);
       }
     } elsif ($newpaper eq "--json") {
       my @ret = ();
       push @ret, "$currentpaper";
-      for my $p (keys %pdftex_papersize) {
+      for my $p (keys %context_papersize) {
         push @ret, $p unless ($p eq $currentpaper);
       }
       my %foo;
-      $foo{'program'} = "context";
+      $foo{'program'} = $prog;
       $foo{'file'} = $inp;
       $foo{'options'} = \@ret;
       return \%foo;
@@ -738,13 +775,13 @@
     } elsif ($newpaper eq "--returnlist") {
       my @ret = ();
       push @ret, "$currentpaper";
-      for my $p (keys %pdftex_papersize) {
+      for my $p (keys %context_papersize) {
         push @ret, $p unless ($p eq $currentpaper);
       }
       return \@ret;
     } else {
       my $found = 0;
-      for my $p (keys %pdftex_papersize) {
+      for my $p (keys %context_papersize) {
         if ($p eq $newpaper) {
           $found = 1;
           last;
@@ -760,13 +797,13 @@
           }
         } else {
           my $addlines = "\\setuppapersize[$newpaper][$newpaper]\n";
-          if (defined($endinputidx)) {
+          if ($endinputidx > -1) {
             $lines[$endinputidx] = $addlines . $lines[$endinputidx];
           } else {
             $lines[$#lines] = $addlines;
           }
         }
-        info("$prg: setting paper size for context to $newpaper: $outfile\n");
+        info("$prg: setting paper size for $prog_long to $newpaper: $outfile\n");
         mkdirhier(dirname($outfile));
         # if we create the outfile we have to call mktexlsr
         TeXLive::TLUtils::announce_execute_actions("files-changed")
@@ -773,7 +810,7 @@
           unless (-r $outfile);
         if (!open(TMP, ">$outfile")) {
           tlwarn("$prg: Cannot write to $outfile: $!\n");
-          tlwarn("Not setting paper size for context.\n");
+          tlwarn("Not setting paper size for $prog_long.\n");
           return($F_ERROR);
         }
         for (@lines) { print TMP; }
@@ -782,12 +819,12 @@
         # 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");
+        tlwarn("$prg: Not a valid paper size for $prog_long: $newpaper\n");
         return($F_WARNING);
       }
     }
   } else {
-    info("Current context paper size (from $inp): $currentpaper\n");
+    info("Current $prog_long paper size (from $inp): $currentpaper\n");
   }
   return($F_OK);
 }



More information about the tex-live-commits mailing list.