"Fossies" - the Fresh Open Source Software Archive 
Member "install-tl-20231204/tlpkg/TeXLive/TLPaper.pm" (8 Apr 2023, 28167 Bytes) of package /linux/misc/install-tl-unx.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
1 # $Id: TLPaper.pm 66798 2023-04-08 00:15:21Z preining $
2 # TeXLive::TLPaper.pm - query/modify paper sizes for our various programs
3 # Copyright 2008-2023 Norbert Preining
4 # This file is licensed under the GNU General Public License version 2
5 # or any later version.
6
7 use strict; use warnings;
8
9 package TeXLive::TLPaper;
10
11 my $svnrev = '$Revision: 66798 $';
12 my $_modulerevision;
13 if ($svnrev =~ m/: ([0-9]+) /) {
14 $_modulerevision = $1;
15 } else {
16 $_modulerevision = "unknown";
17 }
18 sub module_revision {
19 return $_modulerevision;
20 }
21
22 BEGIN {
23 use Exporter ();
24 use vars qw( @ISA @EXPORT_OK @EXPORT );
25 @ISA = qw(Exporter);
26 @EXPORT_OK = qw(
27 %paper_config_path_component
28 %paper_config_name
29 );
30 @EXPORT = @EXPORT_OK;
31 }
32
33 my $prg = ($::prg ? $::prg : TeXLive::TLUtils::basename($0));
34
35 =pod
36
37 =head1 NAME
38
39 C<TeXLive::TLPaper> -- TeX Live paper size module
40
41 =head1 SYNOPSIS
42
43 use TeXLive::TLPaper;
44
45 =head1 DESCRIPTION
46
47 =over 4
48
49 =cut
50
51 use TeXLive::TLUtils qw(:DEFAULT dirname merge_into mkdirhier);
52 use TeXLive::TLConfig;
53
54
55 #
56 # paper data
57 #
58 our %paper = (
59 "xdvi" => {
60 sub => \&paper_xdvi,
61 default_component => "xdvi",
62 default_file => "XDvi",
63 pkg => "xdvi",
64 },
65 "pdftex" => {
66 sub => \&paper_pdftex,
67 default_component => "tex/generic/tex-ini-files",
68 default_file => "pdftexconfig.tex",
69 pkg => "pdftex",
70 },
71 "dvips" => {
72 sub => \&paper_dvips,
73 default_component => "dvips/config",
74 default_file => "config.ps",
75 pkg => "dvips",
76 },
77 "dvipdfmx" => {
78 sub => \&paper_dvipdfmx,
79 default_component => "dvipdfmx",
80 default_file => "dvipdfmx.cfg",
81 pkg => "dvipdfmx",
82 },
83 "context" => {
84 sub => \&paper_context,
85 default_component => "tex/context/user",
86 default_file => "context-papersize.tex",
87 pkg => "context",
88 },
89 "psutils" => {
90 sub => \&paper_psutils,
91 default_component => "psutils",
92 default_file => "paper.cfg",
93 pkg => "psutils",
94 },
95 );
96
97 # Output is done to the components in this hash.
98 # If a value is undefined, we take the one from %default_...
99 #
100 our %paper_config_path_component;
101 our %paper_config_name;
102
103
104 my %xdvi_papersize = (
105 a0 => '841x1189mm',
106 a1 => '594x841mm',
107 a2 => '420x594mm',
108 a3 => '297x420mm',
109 a4 => '210x297mm',
110 a5 => '148x210mm',
111 a6 => '105x148mm',
112 a7 => '74x105mm',
113 a8 => '52x74mm',
114 a9 => '37x52mm',
115 a10 => '26x37mm',
116 a0r => '1189x841mm',
117 a1r => '841x594mm',
118 a2r => '594x420mm',
119 a3r => '420x297mm',
120 a4r => '297x210mm',
121 a5r => '210x148mm',
122 a6r => '148x105mm',
123 a7r => '105x74mm',
124 a8r => '74x52mm',
125 a9r => '52x37mm',
126 a10r => '37x26mm',
127 b0 => '1000x1414mm',
128 b1 => '707x1000mm',
129 b2 => '500x707mm',
130 b3 => '353x500mm',
131 b4 => '250x353mm',
132 b5 => '176x250mm',
133 b6 => '125x176mm',
134 b7 => '88x125mm',
135 b8 => '62x88mm',
136 b9 => '44x62mm',
137 b10 => '31x44mm',
138 b0r => '1414x1000mm',
139 b1r => '1000x707mm',
140 b2r => '707x500mm',
141 b3r => '500x353mm',
142 b4r => '353x250mm',
143 b5r => '250x176mm',
144 b6r => '176x125mm',
145 b7r => '125x88mm',
146 b8r => '88x62mm',
147 b9r => '62x44mm',
148 b10r => '44x31mm',
149 c0 => '917x1297mm',
150 c1 => '648x917mm',
151 c2 => '458x648mm',
152 c3 => '324x458mm',
153 c4 => '229x324mm',
154 c5 => '162x229mm',
155 c6 => '114x162mm',
156 c7 => '81x114mm',
157 c8 => '57x81mm',
158 c9 => '40x57mm',
159 c10 => '28x40mm',
160 c0r => '1297x917mm',
161 c1r => '917x648mm',
162 c2r => '648x458mm',
163 c3r => '458x324mm',
164 c4r => '324x229mm',
165 c5r => '229x162mm',
166 c6r => '162x114mm',
167 c7r => '114x81mm',
168 c8r => '81x57mm',
169 c9r => '57x40mm',
170 c10r => '40x28mm',
171 us => '8.5x11',
172 letter => '8.5x11',
173 ledger => '17x11',
174 tabloid => '11x17',
175 usr => '11x8.5',
176 legal => '8.5x14',
177 legalr => '14x8.5',
178 foolscap => '13.5x17.0',
179 foolscapr => '17.0x13.5',
180 );
181
182 my %pdftex_papersize = (
183 "a4" => [ '210 true mm', '297 true mm' ],
184 "letter" => [ '8.5 true in', '11 true in' ],
185 );
186
187 my %context_papersize = ( "A4" => 1, "letter" => 1, );
188
189 my %dvipdfm_papersize = (
190 "a3" => 1,
191 "a4" => 1,
192 "ledger" => 1,
193 "legal" => 1,
194 "letter" => 1,
195 "tabloid" => 1,
196 );
197
198 my %psutils_papersize = ( "a4" => 1, "letter" => 1, );
199
200
201
202
203 =item C<get_paper_list($prog)>
204
205 Returns the list of supported paper sizes with the first entry being
206 the currently selected one.
207
208 =cut
209
210 sub get_paper_list {
211 my $prog = shift;
212 return ( &{$paper{$prog}{'sub'}} ( "/dummy", "--returnlist" ) );
213 }
214
215 =item C<get_paper($prog)>
216
217 Returns the currently selected paper size for program C<$prog>.
218
219 =cut
220
221 sub get_paper {
222 my $pps = get_paper_list(shift);
223 return $pps->[0];
224 }
225
226 =item C<do_paper($prog,$texmfsysconfig,@args)>
227
228 Call the paper subroutine for C<$prog>, passing args.
229
230 Returns a reference to a list of papers if called with C<--returnlist>,
231 otherwise one of the standard flags (see TeXLive::TLConfig).
232
233 =cut
234
235 sub do_paper {
236 my ($prog,$texmfsysconfig,@args) = @_;
237 if (exists $paper{$prog}{'sub'}) {
238 my $sub = $paper{$prog}{'sub'};
239 return(&$sub($texmfsysconfig, @args));
240 } else {
241 tlwarn("$prg: unknown paper program $prog ($texmfsysconfig,@args)\n");
242 return($F_ERROR);
243 }
244 return ($F_OK); # not reached
245 }
246
247
248 =item C<paper_all($texmfsysconfig, $newpaper)>
249
250 Pass all C<@args> to each paper subroutine in turn, thus setting the
251 paper size for all supported programs. Returns the bit-mapped return
252 values of the single subroutine returns.
253
254 =cut
255
256 sub paper_all {
257 my $ret = $F_OK;
258 for my $p (sort keys %paper) {
259 $ret |= &{$paper{$p}{'sub'}} (@_);
260 }
261 return($ret);
262 }
263
264
265 # return the config file to look in by running kpsewhich with the
266 # specified PROGNAME, FORMAT, and @FILENAMES. If no result, give a
267 # warning and return the empty string.
268 #
269 sub find_paper_file {
270 my ($progname, $format, @filenames) = @_;
271 my $ret = "";
272
273 my $cmd;
274 for my $filename (@filenames) {
275 $cmd = qq!kpsewhich --progname=$progname --format="$format" $filename!;
276 chomp($ret = `$cmd`);
277 if ($ret) {
278 debug("paper file for $progname ($format) $filename: $ret\n");
279 last;
280 }
281 }
282
283 debug("$prg: found no paper file for $progname (from $cmd)\n") if ! $ret;
284 return $ret;
285 }
286
287 sub setup_names {
288 my $prog = shift;
289 my $outcomp = $paper_config_path_component{$prog}
290 || $paper{$prog}{'default_component'};
291 my $filecomp = $paper_config_name{$prog}
292 || $paper{$prog}{'default_file'};
293 return ($outcomp, $filecomp);
294 }
295
296
297 # xdvi format:
298 # /--- XDvi ---
299 # |...
300 # |*paper: <NAME>
301 # |...
302 # \------------
303 #
304 # Reading is done via --progname=xdvi --format='other text files' XDvi
305 # Writing is done to TEXMFSYSCONFIG/xdvi/XDvi
306 #
307 sub paper_xdvi {
308 my $outtree = shift;
309 my $newpaper = shift;
310
311 my ($outcomp, $filecomp) = setup_names("xdvi");
312 my $dftfile = $paper{'xdvi'}{'default_file'};
313 my $outfile = "$outtree/$outcomp/$filecomp";
314 my $inp = &find_paper_file("xdvi", "other text files", $filecomp, $dftfile);
315
316 return($F_ERROR) unless $inp;
317
318
319 my @sizes = keys %xdvi_papersize;
320 return &paper_do_simple($inp, "xdvi", '^\*paper: ', '^\*paper:\s+(\w+)\s*$',
321 sub {
322 my ($ll,$np) = @_;
323 $ll =~ s/^\*paper:\s+(\w+)\s*$/\*paper: $np\n/;
324 return($ll);
325 }, $outfile, \@sizes, '(undefined)', '*paper: a4', $newpaper);
326 }
327
328
329 # pdftex pdftexconfig.dat format
330 # /--- pdftexconfig.tex ---
331 # |...
332 # |\pdfpageheight = 297 true mm
333 # |\pdfpagewidth = 210 true mm
334 # |...
335 # \------------------------
336 #
337 # Reading is done via --progname=pdftex --format='tex' pdftexconfig.tex
338 # Writing is done to TEXMFSYSCONFIG/tex/generic/config/pdftexconfig.tex
339 #
340 sub paper_pdftex {
341 my $outtree = shift;
342 my $newpaper = shift;
343 my ($outcomp, $filecomp) = setup_names("pdftex");
344 my $dftfile = $paper{'pdftex'}{'default_file'};
345 my $outfile = "$outtree/$outcomp/$filecomp";
346 my $inp = &find_paper_file("pdftex", "tex", $filecomp, $dftfile);
347
348 return($F_ERROR) unless $inp;
349
350 open(FOO, "<$inp") || die "$prg: open($inp) failed: $!";
351 my @lines = <FOO>;
352 close(FOO);
353
354 my @cpwidx;
355 my @cphidx;
356 my ($cpw, $cph);
357 my $endinputidx;
358 # read the lines and the last pdfpageswidth/height wins
359 for my $idx (0..$#lines) {
360 my $l = $lines[$idx];
361 if ($l =~ m/^\s*\\pdfpagewidth\s*=\s*([0-9.,]+\s*true\s*[^\s]*)/) {
362 if (defined($cpw) && $cpw ne $1) {
363 tl_warn("TLPaper: inconsistent paper sizes in $inp for page width! Please fix that.\n");
364 return $F_ERROR;
365 }
366 $cpw = $1;
367 push @cpwidx, $idx;
368 next;
369 }
370 if ($l =~ m/^\s*\\pdfpageheight\s*=\s*([0-9.,]+\s*true\s*[^\s]*)/) {
371 if (defined($cph) && $cph ne $1) {
372 tl_warn("TLPaper: inconsistent paper sizes in $inp for page height! Please fix that.\n");
373 return $F_ERROR;
374 }
375 $cph = $1;
376 push @cphidx, $idx;
377 next;
378 }
379 if ($l =~ m/^\s*\\endinput\s*/) {
380 $endinputidx = $idx;
381 next;
382 }
383 }
384 # trying to find the right papersize
385 #
386 my $currentpaper;
387 if (defined($cpw) && defined($cph)) {
388 for my $pname (keys %pdftex_papersize) {
389 my ($w, $h) = @{$pdftex_papersize{$pname}};
390 if (($w eq $cpw) && ($h eq $cph)) {
391 $currentpaper = $pname;
392 last;
393 }
394 }
395 } else {
396 $currentpaper = "(undefined)";
397 }
398 $currentpaper || ($currentpaper = "$cpw x $cph");
399 if (defined($newpaper)) {
400 if ($newpaper eq "--list") {
401 info("$currentpaper\n");
402 for my $p (keys %pdftex_papersize) {
403 info("$p\n") unless ($p eq $currentpaper);
404 }
405 } elsif ($newpaper eq "--json") {
406 my @ret = ();
407 push @ret, "$currentpaper";
408 for my $p (keys %pdftex_papersize) {
409 push @ret, $p unless ($p eq $currentpaper);
410 }
411 my %foo;
412 $foo{'program'} = "pdftex";
413 $foo{'file'} = $inp;
414 $foo{'options'} = \@ret;
415 return \%foo;
416 } elsif ($newpaper eq "--returnlist") {
417 my @ret = ();
418 push @ret, "$currentpaper";
419 for my $p (keys %pdftex_papersize) {
420 push @ret, $p unless ($p eq $currentpaper);
421 }
422 return \@ret;
423 } else {
424 my $found = 0;
425 for my $p (keys %pdftex_papersize) {
426 if ($p eq $newpaper) {
427 $found = 1;
428 last;
429 }
430 }
431 if ($found) {
432 my $newwidth = ${$pdftex_papersize{$newpaper}}[0];
433 my $newheight = ${$pdftex_papersize{$newpaper}}[1];
434 if (@cpwidx) {
435 for my $idx (@cpwidx) {
436 ddebug("TLPaper: before line: $lines[$idx]");
437 ddebug("TLPaper: replacement: $newwidth\n");
438 $lines[$idx] =~ s/^\s*\\pdfpagewidth\s*=\s*[0-9.,]+\s*true\s*[^\s]*/\\pdfpagewidth = $newwidth/;
439 ddebug("TLPaper: after line : $lines[$idx]");
440 }
441 } else {
442 my $addlines = "\\pdfpagewidth = $newwidth\n";
443 if (defined($endinputidx)) {
444 $lines[$endinputidx] = $addlines . $lines[$endinputidx];
445 } else {
446 $lines[$#lines] = $addlines;
447 }
448 }
449 if (@cphidx) {
450 for my $idx (@cphidx) {
451 ddebug("TLPaper: before line: $lines[$idx]");
452 ddebug("TLPaper: replacement: $newheight\n");
453 $lines[$idx] =~ s/^\s*\\pdfpageheight\s*=\s*[0-9.,]+\s*true\s*[^\s]*/\\pdfpageheight = $newheight/;
454 ddebug("TLPaper: after line : $lines[$idx]");
455 }
456 } else {
457 my $addlines = "\\pdfpageheight = $newheight";
458 if (defined($endinputidx)) {
459 $lines[$endinputidx] = $addlines . $lines[$endinputidx];
460 } else {
461 $lines[$#lines] = $addlines;
462 }
463 }
464 info("$prg: setting paper size for pdftex to $newpaper: $outfile\n");
465 mkdirhier(dirname($outfile));
466 # if we create the outfile we have to call mktexlsr
467 TeXLive::TLUtils::announce_execute_actions("files-changed")
468 unless (-r $outfile);
469 if (!open(TMP, ">$outfile")) {
470 tlwarn("$prg: Cannot write to $outfile: $!\n");
471 tlwarn("Not setting paper size for pdftex.\n");
472 return($F_ERROR);
473 }
474 for (@lines) { print TMP; }
475 close(TMP) || warn "$prg: close(>$outfile) failed: $!";
476 TeXLive::TLUtils::announce_execute_actions("regenerate-formats");
477 # TODO should we return the value of announce_execute action?
478 return($F_OK);
479 } else {
480 tlwarn("$prg: Not a valid paper size for pdftex: $newpaper\n");
481 return($F_WARNING);
482 }
483 }
484 } else {
485 info("Current pdftex paper size (from $inp): $currentpaper\n");
486 }
487 return($F_OK);
488 }
489
490
491 # dvips config.ps format:
492 # /--- config.ps ---
493 # |...
494 # |stuff not related to paper sizes
495 # |...
496 # | <empty line>
497 # |% some comments
498 # |% more comments
499 # |@ <NAME> <WIDTH> <HEIGHT>
500 # |@+ ...definition line
501 # |@+ ...definition line
502 # |... more definition lines
503 # |@+ %%EndPaperSize
504 # |
505 # |@ <NAME> <WIDTH> <HEIGHT>
506 # |...
507 # \------------
508 #
509 # the first paper definition is the default
510 # selecting paper is done like with texconfig which used ed to move the
511 # selected part between @ $selected_paper .... @ /-1 (the line before the
512 # next @ line) to the line before the first @ line.
513 # (what a tricky ed invocation te created there, impressive!!!)
514 #
515 # Reading is done via --progname=dvips --format='dvips config' config.ps
516 # Writing is done to TEXMFSYSCONFIG/dvips/config/config.ps
517 #
518 sub paper_dvips {
519 my $outtree = shift;
520 my $newpaper = shift;
521
522 my ($outcomp, $filecomp) = setup_names("dvips");
523 my $dftfile = $paper{'dvips'}{'default_file'};
524 my $outfile = "$outtree/$outcomp/$filecomp";
525 my $inp = &find_paper_file("dvips", "dvips config", $filecomp, $dftfile);
526
527 return($F_ERROR) unless $inp;
528
529 open(FOO, "<$inp") || die "$prg: open($inp) failed: $!";
530 my @lines = <FOO>;
531 close(FOO);
532
533 my @papersizes;
534 my $firstpaperidx;
535 my %startidx;
536 my %endidx;
537 my $in_block = "";
538 my $idx = 0;
539 for my $idx (0 .. $#lines) {
540 if ($lines[$idx] =~ m/^@ (\w+)/) {
541 $startidx{$1} = $idx;
542 $firstpaperidx || ($firstpaperidx = $idx-1);
543 $in_block = $1;
544 push @papersizes, $1;
545 next;
546 }
547 # empty lines or comments stop a block
548 if ($in_block) {
549 if ($lines[$idx] =~ m/^\s*(%.*)?\s*$/) {
550 $endidx{$in_block} = $idx-1;
551 $in_block = "";
552 }
553 next;
554 }
555 }
556
557 if (defined($newpaper)) {
558 if ($newpaper eq "--list") {
559 for my $p (@papersizes) {
560 info("$p\n"); # first is already the selected one
561 }
562 } elsif ($newpaper eq "--json") {
563 my %foo;
564 $foo{'program'} = "dvips";
565 $foo{'file'} = $inp;
566 $foo{'options'} = \@papersizes;
567 return \%foo;
568 } elsif ($newpaper eq "--returnlist") {
569 return(\@papersizes);
570 } else {
571 my $found = 0;
572 for my $p (@papersizes) {
573 if ($p eq $newpaper) {
574 $found = 1;
575 last;
576 }
577 }
578 if ($found) {
579 my @newlines;
580 for my $idx (0..$#lines) {
581 if ($idx < $firstpaperidx) {
582 push @newlines, $lines[$idx];
583 next;
584 }
585 if ($idx == $firstpaperidx) {
586 # insert the selected paper definition
587 push @newlines, @lines[$startidx{$newpaper}..$endidx{$newpaper}];
588 push @newlines, $lines[$idx];
589 next;
590 }
591 if ($idx >= $startidx{$newpaper} && $idx <= $endidx{$newpaper}) {
592 next;
593 }
594 push @newlines, $lines[$idx];
595 }
596 info("$prg: setting paper size for dvips to $newpaper: $outfile\n");
597 mkdirhier(dirname($outfile));
598 # if we create the outfile we have to call mktexlsr
599 TeXLive::TLUtils::announce_execute_actions("files-changed")
600 unless (-r $outfile);
601 if (!open(TMP, ">$outfile")) {
602 tlwarn("$prg: Cannot write to $outfile: $!\n");
603 tlwarn("Not setting paper size for dvips.\n");
604 return ($F_ERROR);
605 }
606 for (@newlines) { print TMP; }
607 close(TMP) || warn "$prg: close(>$outfile) failed: $!";
608 } else {
609 tlwarn("$prg: Not a valid paper size for dvips: $newpaper\n");
610 return($F_WARNING);
611 }
612 }
613 } else {
614 info("Current dvips paper size (from $inp): $papersizes[0]\n");
615 }
616 return($F_OK);
617 }
618
619
620 # dvipdfm(x) format:
621 # /--- dvipdfm/config, dvipdfmx/dvipdfmx.cfg ---
622 # |...
623 # |p <NAME>
624 # |...
625 # \------------
626 #
627 # Reading is done
628 # for dvipdfm via --progname=dvipdfm --format='other text files' config
629 # for dvipdfmx via --progname=dvipdfmx --format='other text files' dvipdfmx.cfg
630 # Writing is done to TEXMFSYSCONFIG/dvipdfm/config/config
631 # and /dvipdfmx/dvipdfmx.cfg
632 #
633 #
634 sub do_dvipdfm_and_x {
635 my ($inp,$prog,$outtree,$paplist,$newpaper) = @_;
636
637 my ($outcomp, $filecomp) = setup_names($prog);
638 my $outfile = "$outtree/$outcomp/$filecomp";
639
640 return &paper_do_simple($inp, $prog, '^p\s+', '^p\s+(\w+)\s*$',
641 sub {
642 my ($ll,$np) = @_;
643 $ll =~ s/^p\s+(\w+)\s*$/p $np\n/;
644 return($ll);
645 }, $outfile, $paplist, '(undefined)', 'p a4', $newpaper);
646 }
647
648 sub paper_dvipdfm {
649 my $outtree = shift;
650 my $newpaper = shift;
651
652 my ($outcomp, $filecomp) = setup_names("dvipdfm");
653 my $dftfile = $paper{'dvipdfm'}{'default_file'};
654 my $inp = &find_paper_file("dvipdfm", "other text files", $filecomp, $dftfile);
655 return ($F_ERROR) unless $inp;
656
657 my @sizes = keys %dvipdfm_papersize;
658 return &do_dvipdfm_and_x($inp, "dvipdfm", $outtree, \@sizes, $newpaper);
659 }
660
661 sub paper_dvipdfmx {
662 my $outtree = shift;
663 my $newpaper = shift;
664
665 my ($outcomp, $filecomp) = setup_names("dvipdfmx");
666 my $dftfile = $paper{'dvipdfmx'}{'default_file'};
667
668 my $inp = &find_paper_file("dvipdfmx", "other text files", $filecomp, $dftfile);
669 return ($F_ERROR) unless $inp;
670
671 my @sizes = keys %dvipdfm_papersize;
672 return &do_dvipdfm_and_x($inp, "dvipdfmx", $outtree, \@sizes, $newpaper);
673 }
674
675
676 # context format:
677 # /--- context-papersize.tex // formerly cont-sys.{tex,rme}
678 # |...
679 # |\setuppapersize[letter][letter]
680 # |...
681 # \------------
682 #
683 sub paper_context {
684 my $outtree = shift;
685 my $newpaper = shift;
686 # context mkxl actually expects "A4" in contrast to all previous versions
687 # of context - thanks! But since tlmgr expects to work with a4/letter,
688 # rewrite a4 -> A4 in the actual function.
689 if ($newpaper && $newpaper eq "a4") {
690 $newpaper = "A4";
691 }
692 my ($outcomp, $filecomp) = setup_names('context');
693 my $dftfile = $paper{'context'}{'default_file'};
694 my $outfile = "$outtree/$outcomp/$filecomp";
695 my $inp = &find_paper_file("context", "tex", $filecomp, $dftfile);
696
697 # return($F_ERROR) unless $inp;
698 # We don't return error here, since the default configuration file
699 # for context might not have been generated by now cont-sys.mkxl
700 #
701
702 my @lines;
703 my $endinputidx = -1;
704 my @idx;
705 my $idxlast;
706 my $currentpaper;
707 if ($inp) {
708 open(FOO, "<$inp") || die "$prg: open($inp) failed: $!";
709 @lines = <FOO>;
710 close(FOO);
711
712 # read the lines and the last setuppapersize before the endinput wins
713 for my $idx (0..$#lines) {
714 my $l = $lines[$idx];
715 if ($l =~ m/^[^%]*\\endinput/) {
716 $endinputidx = $idx;
717 last;
718 }
719 if ($l =~ m/^\s*\\setuppapersize\s*\[([^][]*)\].*$/) {
720 if (defined($currentpaper) && $currentpaper ne $1) {
721 tl_warn("TLPaper: inconsistent paper sizes in $inp! Please fix that.\n");
722 return $F_ERROR;
723 }
724 $currentpaper = $1;
725 $idxlast = $idx;
726 push @idx, $idx;
727 next;
728 }
729 }
730 } else {
731 @lines = []
732 }
733 # if we haven't found a paper line, assume a4
734 $currentpaper || ($currentpaper = "A4");
735 # trying to find the right papersize
736 #
737 if (defined($newpaper)) {
738 if ($newpaper eq "--list") {
739 info("$currentpaper\n");
740 for my $p (keys %context_papersize) {
741 info("$p\n") unless ($p eq $currentpaper);
742 }
743 } elsif ($newpaper eq "--json") {
744 my @ret = ();
745 push @ret, "$currentpaper";
746 for my $p (keys %context_papersize) {
747 push @ret, $p unless ($p eq $currentpaper);
748 }
749 my %foo;
750 $foo{'program'} = 'context';
751 $foo{'file'} = $inp;
752 $foo{'options'} = \@ret;
753 return \%foo;
754 } elsif ($newpaper eq "--returnlist") {
755 my @ret = ();
756 push @ret, "$currentpaper";
757 for my $p (keys %context_papersize) {
758 push @ret, $p unless ($p eq $currentpaper);
759 }
760 return \@ret;
761 } else {
762 my $found = 0;
763 for my $p (keys %context_papersize) {
764 if ($p eq $newpaper) {
765 $found = 1;
766 last;
767 }
768 }
769 if ($found) {
770 if (@idx) {
771 for my $idx (@idx) {
772 ddebug("TLPaper: before line: $lines[$idx]");
773 ddebug("TLPaper: replacement: $newpaper\n");
774 $lines[$idx] =~ s/setuppapersize\s*\[([^][]*)\]\[([^][]*)\]/setuppapersize[$newpaper][$newpaper]/;
775 ddebug("TLPaper: after line : $lines[$idx]");
776 }
777 } else {
778 my $addlines = "\\setuppapersize[$newpaper][$newpaper]\n";
779 if ($endinputidx > -1) {
780 $lines[$endinputidx] = $addlines . $lines[$endinputidx];
781 } else {
782 $lines[$#lines] = $addlines;
783 }
784 }
785 info("$prg: setting paper size for context to $newpaper: $outfile\n");
786 mkdirhier(dirname($outfile));
787 # if we create the outfile we have to call mktexlsr
788 TeXLive::TLUtils::announce_execute_actions("files-changed")
789 unless (-r $outfile);
790 if (!open(TMP, ">$outfile")) {
791 tlwarn("$prg: Cannot write to $outfile: $!\n");
792 tlwarn("Not setting paper size for context.\n");
793 return($F_ERROR);
794 }
795 for (@lines) { print TMP; }
796 close(TMP) || warn "$prg: close(>$outfile) failed: $!";
797 TeXLive::TLUtils::announce_execute_actions("regenerate-formats");
798 # TODO should we return the value of announce_execute action?
799 return($F_OK);
800 } else {
801 tlwarn("$prg: Not a valid paper size for context: $newpaper\n");
802 return($F_WARNING);
803 }
804 }
805 } else {
806 info("Current context paper size (from $inp): $currentpaper\n");
807 }
808 return($F_OK);
809 }
810
811 sub paper_context_old {
812 my $outtree = shift;
813 my $newpaper = shift;
814
815 my ($outcomp, $filecomp) = setup_names("context");
816 my $dftfile = $paper{'context'}{'default_file'};
817 my $outfile = "$outtree/$outcomp/$filecomp";
818 my $inp = &find_paper_file("context", "tex", $filecomp, "cont-sys.rme", $dftfile);
819 return ($F_ERROR) unless $inp;
820
821 my @sizes = keys %pdftex_papersize;
822 # take care here, the \\\\ are necessary in some places and not in
823 # some others because there is no intermediate evaluation
824 return &paper_do_simple($inp, "context", '^\s*%?\s*\\\\setuppapersize\s*',
825 '^\s*%?\s*\\\\setuppapersize\s*\[([^][]*)\].*$',
826 sub {
827 my ($ll,$np) = @_;
828 if ($ll =~ m/^\s*%?\s*\\setuppapersize\s*/) {
829 return("\\setuppapersize[$np][$np]\n");
830 } else {
831 return($ll);
832 }
833 },
834 $outfile, \@sizes, 'a4', '\setuppapersize[a4][a4]', $newpaper);
835 }
836
837
838 # psutils
839 # config file "psutils/paper.cfg" only contains two words:
840 # p <papersize>
841 #
842 sub paper_psutils {
843 my $outtree = shift;
844 my $newpaper = shift;
845
846 my ($outcomp, $filecomp) = setup_names("psutils");
847 my $dftfile = $paper{'psutils'}{'default_file'};
848 my $outfile = "$outtree/$outcomp/$filecomp";
849 my $inp = &find_paper_file("psutils", "other text files", $filecomp, $dftfile);
850
851 return ($F_ERROR) unless $inp;
852
853
854 my @sizes = keys %psutils_papersize;
855 return &paper_do_simple($inp, "psutils", '^\s*p', '^\s*p\s+(\w+)\s*$',
856 sub {
857 my ($ll,$np) = @_;
858 $ll =~ s/^\s*p\s+(\w+)\s*$/p $np\n/;
859 return($ll);
860 },
861 $outfile, \@sizes, '(undefined)', 'p a4', $newpaper);
862 }
863
864
865 # paper_do_simple does the work for single line config files
866 # (xdvi, dvipdfm, ...)
867 # arguments:
868 # $inp, $prog, $firstre, $secondre, $bl, $outp, $paplist, $newpaper
869 # with
870 # $inp .. input file location
871 # $prog .. program name
872 # $firstre .. re that searches for paper lines
873 # $secondre .. re that extracts the paper from a paper line
874 # $bl .. block/sub taking two args, one paper line and the new paper, and
875 # returns the line with the paper configured, only lines mathing
876 # $firstre are shipped over to $bl
877 # $outp .. location of the output file
878 # $paplist .. ref to an array with the list of admissible paper sizes
879 # $defaultpaper .. default papersize (arbitrary string) if the $firstre is
880 # not found in the config file
881 # $defaultline .. the line to be added at the bottom of the file if
882 # no line has been found
883 # $newpaper .. --list, new paper, or undef
884 sub paper_do_simple {
885 my ($inp, $prog, $firstre, $secondre, $bl, $outp, $paplist, $defaultpaper, $defaultline, $newpaper) = @_;
886
887 debug("file used for $prog: $inp\n");
888
889 open(FOO, "<$inp") or die("cannot open file $inp: $!");
890 my @lines = <FOO>;
891 close(FOO);
892
893 my $currentpaper;
894 my @paperlines = grep (m/$firstre/,@lines);
895 if (!@paperlines) {
896 $currentpaper = $defaultpaper;
897 } else {
898 if ($#paperlines > 0) {
899 warn "Strange, more than one paper definition, using the first one in\n$inp\n";
900 }
901 $currentpaper = $paperlines[0];
902 chomp($currentpaper);
903 $currentpaper =~ s/$secondre/$1/;
904 }
905
906 # change value
907 if (defined($newpaper)) {
908 if ($newpaper eq "--list") {
909 info("$currentpaper\n");
910 for my $p (@$paplist) {
911 info("$p\n") unless ($p eq $currentpaper);
912 }
913 } elsif ($newpaper eq "--json") {
914 my @ret = ();
915 push @ret, "$currentpaper";
916 for my $p (@$paplist) {
917 push @ret, $p unless ($p eq $currentpaper);
918 }
919 my %foo;
920 $foo{'program'} = $prog;
921 $foo{'file'} = $inp;
922 $foo{'options'} = \@ret;
923 return \%foo;
924 } elsif ($newpaper eq "--returnlist") {
925 my @ret = ();
926 push @ret, $currentpaper;
927 for my $p (@$paplist) {
928 push @ret, $p unless ($p eq $currentpaper);
929 }
930 return(\@ret);
931 } else {
932 my $found = 0;
933 for my $p (@$paplist) {
934 if ($p eq $newpaper) {
935 $found = 1;
936 last;
937 }
938 }
939 if ($found) {
940 my @newlines;
941 my $foundcfg = 0;
942 for my $l (@lines) {
943 if ($l =~ m/$firstre/) {
944 push @newlines, &$bl($l, $newpaper);
945 $foundcfg = 1;
946 } else {
947 push @newlines, $l;
948 }
949 }
950 # what to do if no default line found???
951 if (!$foundcfg) {
952 push @newlines, &$bl($defaultline, $newpaper);
953 }
954 info("$prg: setting paper size for $prog to $newpaper: $outp\n");
955 mkdirhier(dirname($outp));
956 # if we create the outfile we have to call mktexlsr
957 TeXLive::TLUtils::announce_execute_actions("files-changed")
958 unless (-r $outp);
959 if (!open(TMP, ">$outp")) {
960 tlwarn("$prg: Cannot write to $outp: $!\n");
961 tlwarn("Not setting paper size for $prog.\n");
962 return ($F_ERROR);
963 }
964 for (@newlines) { print TMP; }
965 close(TMP) || warn "$prg: close(>$outp) failed: $!";
966 TeXLive::TLUtils::announce_execute_actions("regenerate-formats")
967 if ($prog eq "context");
968 return($F_OK);
969 } else {
970 tlwarn("$prg: Not a valid paper size for $prog: $newpaper\n");
971 return($F_WARNING);
972 }
973 }
974 } else {
975 # return the current value
976 info("Current $prog paper size (from $inp): $currentpaper\n");
977 }
978 return($F_OK);
979 }
980
981 =back
982 =cut
983 1;
984
985 ### Local Variables:
986 ### perl-indent-level: 2
987 ### tab-width: 2
988 ### indent-tabs-mode: nil
989 ### End:
990 # vim:set tabstop=2 expandtab: #