File Coverage

lib/Text/Frundis/Processing.pm
Criterion Covered Total %
statement 1784 1927 92.5
branch 1052 1304 80.6
condition 249 343 72.5
subroutine 146 149 97.9
pod 0 133 0.0
total 3231 3856 83.7


", ", \n",
line stmt bran cond sub pod time code
1             #!/usr/bin/env perl
2             # Copyright (c) 2014, 2015 Yon
3             #
4             # Permission to use, copy, modify, and distribute this software for any
5             # purpose with or without fee is hereby granted, provided that the above
6             # copyright notice and this permission notice appear in all copies.
7             #
8             # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9             # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10             # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11             # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12             # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13             # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14             # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15             #
16             # Main Processing
17             #
18             package Text::Frundis::Processing;
19              
20 3     3   11 use utf8;
  3         4  
  3         10  
21 3     3   73 use v5.12;
  3         6  
22 3     3   7 use strict;
  3         4  
  3         44  
23 3     3   9 use warnings;
  3         2  
  3         75  
24 3     3   9 use open qw(:std :utf8);
  3         3  
  3         10  
25              
26 3     3   231 use Carp;
  3         3  
  3         134  
27 3     3   1345 use Encode;
  3         21923  
  3         174  
28 3     3   748 use File::Spec::Functions;
  3         1138  
  3         178  
29 3     3   788 use File::Copy;
  3         4786  
  3         117  
30 3     3   11 use File::Basename;
  3         8  
  3         141  
31 3     3   1610 use URI;
  3         8856  
  3         86  
32 3     3   791 use Text::Frundis::Object qw(@Arg);
  3         5  
  3         302  
33 3     3   707 use Text::Frundis::PerlEval;
  3         5  
  3         42598  
34              
35             # Global Constants and Variables [[[
36             our @Arg;
37              
38             my %Opts;
39             my @FrundisINC;
40             my %FileParse;
41              
42             # Regexes
43             my %Rx;
44              
45             # Phase
46             my $Process = 0; # whether in Processing Phase.
47              
48             # State information
49             my %Count; # counters
50             my %Flag; # state flags
51             my %Filters; # filters for "Bf -t"
52             my %Macro; # user defined macros with `.#de' macro
53             my %BfMacro; # "Bf" macro state
54             my %DeMacro; # "#de" macro state
55             my %UserMacroCall; # user macro call state
56             my %Scope; # scope state information
57             my %State; # miscellaneous state information
58              
59             # Permissions
60             my @Phrasing = qw(Bm Em Sm Bf Ef Ft Lk Sx Im);
61             my @ProcessDirectives = ("#fl", "#if", "#;", "#de", "#.", "#dv");
62             my %AllowedInBl = map { $_ => 1 } qw(Bl It El If Ta), @Phrasing,
63             @ProcessDirectives;
64             my %HtmlPhrasing = map { $_ => 1 }
65             qw(a abbr area audio b bdi bdo br button canvas cite code data datalist del
66             dfn em embed i iframe img input ins kbd keygen label link map mark math
67             meta meter noscript object output progress q ruby s samp script select
68             small span strong sub sup svg template textarea time u var video wbr text);
69             my %HtmlContainingFlow = map { $_ => 1 }
70             qw(article blockquote div header figure footer main pre section);
71              
72             # "pre" is an exception in that it can be useful as a "Bd", but can contain
73             # only phrasing elements
74              
75             my %AllowedParam;
76             my %AllowedFlag;
77              
78             # Macro handlers
79             my %BuiltinMacroHandler = (
80             Bd => \&handle_Bd_macro,
81             Bf => \&handle_Bf_macro,
82             Bl => \&handle_Bl_macro,
83             Bd => \&handle_Bd_macro,
84             Bm => \&handle_Bm_macro,
85             Pt => \&handle_header_macro,
86             Ch => \&handle_header_macro,
87             Sh => \&handle_header_macro,
88             Ss => \&handle_header_macro,
89             P => \&handle_P_macro,
90             D => \&handle_P_macro,
91             Ed => \&handle_Ed_macro,
92             Ef => \&handle_Ef_macro,
93             El => \&handle_El_macro,
94             Em => \&handle_Em_macro,
95             Ft => \&handle_Ft_macro,
96             If => \&handle_If_macro,
97             Im => \&handle_Im_macro,
98             It => \&handle_It_macro,
99             Lk => \&handle_Lk_macro,
100             Sm => \&handle_Sm_macro,
101             Sx => \&handle_Sx_macro,
102             Ta => \&handle_Ta_macro,
103             Tc => \&handle_Tc_macro,
104             X => \&handle_X_macro,
105             '#de' => \&handle_de_macro,
106             '#dv' => \&handle_dv_macro,
107             '#fl' => \&handle_fl_macro,
108             '#.' => \&handle_end_macro,
109             '#;' => \&handle_if_end_macro,
110             '#if' => \&handle_if_macro,
111             );
112              
113             my %BlockEnd = (
114             '#de' => '#.',
115             '#if' => '#;',
116             Bd => 'Ed',
117             Bl => 'El',
118             Bm => 'Em',
119             );
120              
121             # Information collecting variables
122             my %loXstack;
123             my %InfosFlag;
124             my %ID; # label/id in Sm and Bd
125             my %Param; # Global Parameters
126             my @Image; # For collecting image names to copy images in epub dir
127             my %Xmtag;
128             my %Xdtag;
129              
130             # Input/output variables
131             my $FH; # global main source filehandle
132             our $File; # current input file
133             my $SourceText; # main source text
134              
135             my %Lang_mini = ( # [[[
136             af => "afrikaans",
137             bg => "bulgarian",
138             br => "breton",
139             ca => "catalan",
140             cs => "czech",
141             cy => "welsh",
142             da => "danish",
143             de => "german",
144             el => "greek",
145             en => "english",
146             eo => "esperanto",
147             es => "spanish",
148             et => "estonian",
149             eu => "basque",
150             fi => "finnish",
151             fr => "french",
152             ga => "irish",
153             gd => "scottish",
154             gl => "galician",
155             he => "hebrew",
156             hr => "croatian",
157             hu => "magyar",
158             ia => "interlingua",
159             is => "icelandic",
160             it => "italian",
161             la => "latin",
162             nl => "dutch",
163             no => "norsk",
164             pl => "polish",
165             pt => "portuges",
166             ro => "romanian",
167             ru => "russian",
168             se => "samin",
169             sk => "slovak",
170             sl => "slovene",
171             sr => "serbian",
172             sv => "swedish",
173             tr => "turkish",
174             uk => "ukrainian",
175             ); # ]]]
176              
177             my %Lang_babel = %Lang_mini;
178             $Lang_babel{de} = "ngerman";
179             $Lang_babel{fr} = "frenchb";
180              
181             # some traductions of "Index"
182             my %IndexTraductions = (
183             de => "Index",
184             en => "Index",
185             eo => "Indekso",
186             es => "Índice",
187             fr => "Index",
188             );
189              
190             # Escapes [[[
191              
192             my %Latex_escapes = (
193             '{' => '\{',
194             '}' => '\}',
195             '[' => '[',
196             ']' => ']',
197             '%' => '\%',
198             '&' => '\&',
199             '$' => '\$',
200             '#' => '\#',
201             '_' => '\_',
202             '^' => '\^{}',
203             "\\" => '\textbackslash{}',
204             '~' => '\~{}',
205             "\x{a0}" => '~',
206             );
207              
208             my %Xhtml_escapes = (
209             '&' => '&',
210             '<' => '<',
211             '>' => '>',
212             '"' => '"',
213             "'" => ''',
214             );
215              
216             my %Frundis_escapes = (
217             '\e' => "\\",
218             '\&' => '',
219             '\~' => "\x{a0}",
220             );
221              
222             # ]]]
223              
224             # Frundis main object (for exposed api, mainly)
225             my $Self;
226              
227             # ]]]
228              
229             # Collecting and Processing [[[
230              
231             sub init_global_variables {
232              
233             diag_fatal("invalid format argument:$Opts{target_format}")
234 60 50   60 0 302 unless $Opts{target_format} =~ /^(?:latex|xhtml|epub)$/;
235              
236 60 100       135 if ($Opts{target_format} eq "xhtml") {
237             $Opts{standalone} = 1
238 30 100       64 unless $Opts{all_in_one_file}; # Always do -s unless -a is specified
239             }
240              
241             %Rx = (
242 60         1060 xhtml_or_epub => qr{\b(?:xhtml|epub)\b},
243             format => qr{\b$Opts{target_format}\b},
244             valid_format => qr{^(?:epub|latex|xhtml)(?:,(?:epub|latex|xhtml))*$},
245             );
246              
247 60         124 %AllowedParam = map { $_ => 1 }
  1200         1394  
248             qw(dmark document-author document-date document-title encoding
249             epub-cover epub-css epub-metadata epub-subject epub-uuid epub-version
250             lang latex-preamble nbsp title-page xhtml-bottom xhtml-css
251             xhtml-index xhtml-top xhtml5);
252 60         138 %AllowedFlag = map { $_ => 1 } qw(ns fr-nbsp-auto);
  120         181  
253              
254             $Self = Text::Frundis::Object->new(
255             {
256             allowed_params => \%AllowedParam,
257             allowed_flags => \%AllowedFlag,
258             ID => \%ID,
259             file => \$File,
260             filters => \%Filters,
261             flags => \%Flag,
262             format => $Opts{target_format}, # it doesn't change
263 60         748 loX => {},
264             loXstack => \%loXstack,
265             macros => \%Macro,
266             params => \%Param,
267             process => \$Process,
268             state => \%State,
269             vars => {},
270             ivars => {},
271             }
272             );
273              
274 60         1080 %FileParse = ();
275              
276 60 50       151 if ($ENV{FRUNDISLIB}) {
277 0 0       0 if ($^O eq "MSWin32") {
278 0         0 @FrundisINC = split /;/, $ENV{FRUNDISLIB};
279             }
280             else {
281 0         0 @FrundisINC = split /:/, $ENV{FRUNDISLIB};
282             }
283             }
284             }
285              
286             sub process_frundis_source {
287 60     60 0 56 my ($opts) = @_;
288 60         325 %Opts = %$opts;
289              
290 60         822 open(my $stdout_copy, '>&', select);
291 60         397 open(my $stderr_copy, '>&', STDERR);
292 60         83 local *STDOUT;
293 60         70 local *STDERR;
294 60 50       276 open(STDOUT, '>&', $stdout_copy) or die diag_fatal("redirecting stdout:$!");
295 60 50       243 open(STDERR, '>&', $stderr_copy) or die diag_fatal("redirecting stderr:$!");
296              
297 60 100       121 if ($Opts{input_file}) {
    50          
298              
299             diag_warning("useless use of 'input_string' parameter")
300 59 50       101 if $Opts{input_string};
301              
302             # read from a file
303 59         66 $File = $Opts{input_file};
304 59 50       1324 open($FH, '< :bytes', $File) or diag_fatal("$File:$!");
305             {
306 59         56 local $/;
  59         161  
307 59         762 $SourceText = <$FH>;
308 59         357 close $FH;
309             }
310             }
311             elsif ($Opts{input_string}) {
312 1         2 $File = "string";
313 1         4 $SourceText = Encode::encode_utf8($Opts{input_string});
314             }
315             else {
316             # read from stdin
317 0         0 $File = "stdin";
318             {
319 0         0 local $/;
  0         0  
320 0         0 binmode STDIN, ":bytes";
321 0         0 $SourceText = ;
322 0         0 binmode STDIN, ":encoding(utf-8)";
323             }
324             }
325              
326 60         114 init_global_variables();
327              
328             # FIRST PASS : Collecting Phase
329 60         101 init_state();
330 60         93 init_infos();
331 60 50   2   440 open($FH, '<', \$SourceText) or diag_fatal($!);
  2         14  
  2         2  
  2         13  
332              
333             # For testing purposes, redirect stderr to output file if requested
334 60 50 66     1862 if (
      66        
335             $Opts{redirect_stderr}
336             and ( $Opts{all_in_one_file} && $Opts{target_format} eq "xhtml"
337             or $Opts{target_format} eq "latex")
338             )
339             {
340 48 50       2157 open(STDERR, '>', $Opts{output_file}) or diag_fatal($!);
341             }
342 60         131 $FileParse{$File} = parse_file($FH);
343 60         107 close $FH;
344 60         111 collect_source_infos($FileParse{$File});
345              
346             # SECOND PASS : Processing Phase
347 60         84 init_state();
348 60 100       162 if ($Opts{target_format} eq "latex") {
    100          
    50          
349 27 50       191 open($FH, '<', \$SourceText) or diag_fatal($!);
350 27 100       57 if (defined $Opts{output_file}) {
351 26         34 redirect_stds();
352             }
353              
354 27 100       53 if ($Opts{standalone}) {
355 2         7 latex_document_begin($FH);
356 2         4 process_whole_source();
357 2         5 latex_document_end();
358             }
359             else {
360 25         41 process_whole_source();
361             }
362             }
363             elsif ($Opts{target_format} eq "xhtml") {
364 30 50       216 open($FH, '<', \$SourceText) or diag_fatal($!);
365 30 100 33     110 if (defined $Opts{output_file} and $Opts{all_in_one_file}) {
    50          
366 27         40 redirect_stds();
367             }
368             elsif (defined $Opts{output_file}) {
369 3 50       26 unless (-d $Opts{output_file}) {
370 3 50       150 mkdir $Opts{output_file} or diag_fatal("$Opts{output_file}:$!");
371             }
372 3 50       150 open(STDOUT, '>', catfile($Opts{output_file}, "index.html"))
373             or diag_fatal("$Opts{output_file}:$!");
374             }
375              
376 30 100       54 if ($Opts{standalone}) {
377 6   50     14 my $title = $Param{'document-title'} // "";
378 6         12 xhtml_document_header($title);
379 6         13 xhtml_titlepage();
380 6 100       12 unless ($Opts{all_in_one_file}) {
381 3 50       6 if ($Param{'xhtml-index'} eq "full") {
    0          
382 3         6 xhtml_toc("xhtml");
383             }
384             elsif ($Param{'xhtml-index'} eq "summary") {
385 0         0 xhtml_toc("xhtml", { summary => 1 });
386             }
387             }
388 6         9 process_whole_source();
389 6 100       11 if ($State{_xhtml_navigation_text}) {
390              
391             # bottom navigation bar in last file
392 3         7 print $State{_xhtml_navigation_text};
393             }
394 6         9 xhtml_document_footer();
395             }
396             else {
397 24         33 process_whole_source();
398             }
399             }
400             elsif ($Opts{target_format} eq "epub") {
401 3 50       36 unless (-d $Opts{output_file}) {
402 3 50       161 mkdir $Opts{output_file} or diag_fatal("$Opts{output_file}:$!");
403             }
404 3         18 my $EPUB = catdir($Opts{output_file}, "EPUB");
405 3 50       35 unless (-d $EPUB) {
406 3 50       82 mkdir $EPUB or diag_fatal("$EPUB:$!");
407             }
408 3         10 my $META_INF = catdir($Opts{output_file}, "META-INF");
409 3 50       28 unless (-d $META_INF) {
410 3 50       81 mkdir $META_INF
411             or diag_fatal("$META_INF:$!");
412             }
413 3         12 epub_gen();
414 3 50       23 open($FH, '<', \$SourceText) or diag_fatal($!);
415 3         14 my $index_xhtml = catfile($EPUB, "index.xhtml");
416 3 50       122 open(STDOUT, '>', $index_xhtml)
417             or diag_fatal("$index_xhtml:$!");
418 3   50     10 my $title = $Param{'document-title'} // "";
419 3         7 xhtml_document_header($title);
420 3         7 xhtml_titlepage();
421 3         6 process_whole_source();
422 3         5 xhtml_document_footer();
423             }
424              
425             }
426              
427             sub redirect_stds { # [[[
428 53 100   53 0 84 my $mode = $Opts{redirect_stderr} ? '>>' : '>';
429             open(STDOUT, $mode, $Opts{output_file})
430 53 50       1258 or diag_fatal("$Opts{output_file}:$!");
431 53 100       108 if ($Opts{redirect_stderr}) {
432 48 50       640 open(STDERR, '>&', STDOUT) or diag_fatal($!);
433             }
434             } # ]]]
435              
436             # ]]]
437              
438             ################################################################################
439             # Main program source process functions
440              
441             sub collect_source_infos { # [[[
442 112     112 0 89 my $parse = shift;
443              
444 112         89 $Process = 0;
445              
446 112         165 BLOCK: foreach my $block (@$parse) {
447              
448 2142 100 100     6140 if ($Scope{de} and not(@$block == 3 and $block->[0] eq "#.")) {
    100 100        
      100        
      100        
449 72 100       104 unless ($DeMacro{ignore}) {
450 59         39 push @{ $Macro{ $DeMacro{name} }{parse} }, $block;
  59         100  
451             }
452 72         84 next BLOCK;
453             }
454             elsif ($Count{if_ignore}
455             and not(@$block == 3 and $block->[0] =~ /^(?:#;|#if)$/))
456             {
457 12         15 next BLOCK;
458             }
459              
460 2058 100       2486 next unless @$block == 3;
461              
462 1635         1339 $State{macro} = $block->[0];
463 1635         1184 $State{lnum} = $block->[2];
464 1635         975 @Arg = map { interpolate_vars($_) } @{ $block->[1] };
  2806         2384  
  1635         1831  
465              
466 1635         1721 collect_macro_infos();
467             }
468             } # ]]]
469              
470             sub collect_macro_infos { # [[[
471 1636     1636 0 1274 my $macro = $State{macro};
472 1636 100       3156 if ($Macro{$macro}) { handle_user_macro(); }
  90 100       115  
473             elsif (exists $BuiltinMacroHandler{$macro}) {
474 1542         1958 $BuiltinMacroHandler{$macro}->();
475             }
476             } # ]]]
477              
478             sub process_whole_source { # [[[
479 60     60 0 106 process_source($FileParse{$File});
480 60         69 $State{macro} = "End Of File";
481 60         92 close_unclosed_blocks("Bm");
482 60         69 close_unclosed_blocks("Bl");
483 60         65 close_unclosed_blocks("Bd");
484 60         59 test_for_unclosed_block("#if");
485 60         72 test_for_unclosed_format_block();
486 60         84 test_for_unclosed_de();
487 60 100 66     108 $State{wanted_space} = 1 if $State{text} and $State{wants_space};
488 60         78 close_eventual_final_paragraph();
489             diag_warning(
490             "ns flag set to 1 at end of file, perhaps you forgot a '.#fl ns 0'")
491 60 100       1723 if $Flag{ns};
492             } # ]]]
493              
494             sub parse_file { # [[[
495 69     69 0 69 my $fh = shift;
496              
497 69         64 my $text = ""; # to collect consecutives lines of text
498 69         51 my $text_lnum = 0; # text position
499 69         62 my @parse;
500              
501 69         541 LINE: while (<$fh>) {
502 2477         2244 $State{lnum} = $.;
503 2477 100       4113 diag_warning("trailing space") if /\h$/;
504 2477         2288 s/\\".*//; # comments
505 2477 100       3535 next LINE if /^\.\s*$/; # comment line
506              
507 2435 100       3727 if (/^\.\s*(.*)/) {
508 1621         1659 my $macro_line = $1;
509              
510 1621         1105 chomp $macro_line;
511 1621         2185 while ($macro_line =~ m{\\$}) {
512              
513             # prolonged line
514 5         19 $macro_line =~ s/\\$/ /;
515 5         11 $macro_line .= <$fh>;
516 5         10 chomp $macro_line;
517             }
518              
519 1621         1574 my ($macro, $args) = parse_macro_line($macro_line);
520              
521 1621 50       1952 unless (defined $macro) {
522 0         0 diag_error(
523             "a macro line should start by the name of a valid macro");
524 0         0 next LINE;
525             }
526              
527 1621 100       1798 if ($text) {
528 445         539 push @parse, [ $text, $text_lnum ];
529 445         335 $text = "";
530 445         292 $text_lnum = 0;
531             }
532              
533 1621         4469 push @parse, [ $macro, $args, $State{lnum} ];
534             }
535             else {
536 814         785 $text .= $_;
537 814 100       1252 unless ($text_lnum) {
538 457         813 $text_lnum = $State{lnum};
539             }
540             }
541             }
542              
543 69 100       98 if ($text) {
544 12         16 push @parse, [ $text, $text_lnum ];
545             }
546              
547             # A block is [ $text, $lnum ] or [ $macro, $args, $lnum ].
548 69         157 return \@parse;
549             } # ]]]
550              
551             sub process_source { # [[[
552 112     112 0 98 my $parse = shift;
553              
554 112         242 $Process = 1;
555              
556 112         141 BLOCK: foreach my $block (@$parse) {
557              
558 2142 100 100     7173 if ($Scope{de} and not(@$block == 3 and $block->[0] eq "#.")) {
    100 100        
      100        
      100        
559 72 100       105 unless ($DeMacro{ignore}) {
560 59         39 push @{ $Macro{ $DeMacro{name} }{parse} }, $block;
  59         97  
561             }
562 72         93 next BLOCK;
563             }
564             elsif ($Count{if_ignore}
565             and not(@$block == 3 and $block->[0] =~ /^(?:#;|#if)$/))
566             {
567 12         13 next BLOCK;
568             }
569              
570 2058 100       2164 if (@$block == 3) {
571 1635         1585 $State{macro} = $block->[0];
572 1635         1264 $State{lnum} = $block->[2];
573 1635         1021 @Arg = map { interpolate_vars($_) } @{ $block->[1] };
  2806         2626  
  1635         2024  
574 1635 100       2442 $State{wanted_space} = $State{text} ? $State{wants_space} : 0;
575 1635         1521 process_macro();
576             }
577             else {
578 423 100       603 unless ($Flag{_ignore_text}) {
579 411         380 $State{lnum} = $block->[1];
580 411 100       421 if ($Flag{_verbatim}) {
581             $State{text} .=
582 14         25 escape_verbatim(interpolate_vars($block->[0]));
583             }
584             else {
585 397         496 $State{text} .= escape_text(interpolate_vars($block->[0]));
586             }
587             }
588             }
589             }
590              
591 112         133 return;
592             } # ]]]
593              
594             sub process_macro { # [[[
595 1646     1646 0 1268 my $macro = $State{macro};
596 1646 100 100     3303 if ((not $Macro{$macro}) and test_if_not_allowed_macro($macro)) {
597 5         8 return;
598             }
599 1641 100       2781 if ($Macro{$macro}) { handle_user_macro(); }
  90 100       115  
600             elsif (exists $BuiltinMacroHandler{$macro}) {
601 1547         2109 $BuiltinMacroHandler{$macro}->();
602             }
603             else {
604 4         13 diag_error(
605             "undefined macro `.$macro' (at least for '$Opts{target_format}' output format)"
606             );
607             }
608             } # ]]]
609              
610             ################################################################################
611             # Macro specific functions, in alphabetic order (almost).
612              
613             sub handle_Bd_macro { # [[[
614 64     64 0 130 my %opts = parse_options({ t => "s", id => "s" });
615              
616 64   50     183 $opts{id} //= "";
617 64   100     121 $opts{t} //= "";
618              
619 64         81 $opts{id} = escape_text($opts{id});
620 64 100       84 unless ($Process) {
621 30 50       38 $ID{ $opts{id} } = xhtml_gen_href("", $opts{id}) if $opts{id};
622 30         48 return;
623             }
624 34 50       55 if ($opts{id} =~ /\s/) {
625 0         0 diag_error("id identifier should not contain spaces");
626             }
627              
628 34 100       51 if (@Arg) {
629 2         3 diag_error("`.Bd' macro has useless arguments");
630             }
631              
632 34         51 close_unclosed_blocks("Bm");
633 34         37 close_unclosed_blocks("Bl");
634              
635 34 100       63 my $last = $opts{t} ? $Xdtag{ $opts{t} }{cmd} : 0;
636              
637 34 50 66     26 if (@{ $Scope{Bd} } and $Scope{Bd}->[0]->{t} eq "literal") {
  34         80  
638 0         0 diag_error(
639             "display block of type '$Scope{Bd}->[0]->{t}' cannot contain nested blocks"
640             );
641 0         0 return;
642             }
643             else {
644 34         38 close_eventual_final_paragraph($last);
645             }
646              
647 34         55 scope_stack_push("Bd", $opts{t}, $opts{id});
648              
649 34 100       49 if ($opts{t} eq "literal") {
650 8         12 $Flag{_fr_nbsp_auto} = $Flag{'fr-nbsp-auto'};
651 8         9 $Flag{'fr-nbsp-auto'} = 0;
652 8 100       43 if ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
    50          
653 4         10 print enclose_begin("pre", { id => $opts{id} }), "\n";
654             }
655             elsif ($Opts{target_format} eq "latex") {
656 4         11 print enclose_begin("verbatim", { env => 1, id => $opts{id} }),
657             "\n";
658 4         8 $Flag{_verbatim} = 1;
659             }
660             }
661             else {
662 26 100       102 if ($opts{t}) {
    100          
663             diag_error("`.Bd' invocation: unknown tag")
664 8 50       15 unless defined $Xdtag{ $opts{t} };
665 8         9 my $cmd = $Xdtag{ $opts{t} }{cmd};
666 8 100       18 if ($cmd) {
    100          
667             print enclose_begin(
668             $cmd,
669             { class => $opts{t}, env => 1, id => $opts{id} }
670 6         13 ),
671             "\n";
672             }
673             elsif ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
674             print enclose_begin(
675             "div",
676             { class => $opts{t}, id => $opts{id} }
677 1         4 ),
678             "\n";
679             }
680             }
681             elsif ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
682 11         31 print enclose_begin("div", { id => $opts{id} }), "\n";
683             }
684             }
685 34 50       62 if ($opts{id}) {
686 0 0       0 print "\\hypertarget{$opts{id}}{}\n" if $Opts{target_format} eq "latex";
687             }
688              
689 34         33 $State{wants_space} = 0;
690 34         111 $Scope{paragraph} = 0;
691             } # ]]]
692              
693             sub handle_Bf_macro { # [[[
694 50 100   50 0 87 return unless $Process;
695              
696 25         102 my %opts = parse_options(
697             {
698             f => "s",
699             ns => "b",
700             filter => "s",
701             t => "s",
702             }
703             );
704 25   100     91 $Scope{format} = $opts{f} // "";
705 25         30 $BfMacro{begin_lnum} = $State{lnum};
706             $BfMacro{begin_file} =
707 25 100       63 $UserMacroCall{depth} > 0 ? $UserMacroCall{file} : $File;
708 25 100       42 $BfMacro{in_macro} = $UserMacroCall{depth} > 0 ? 1 : 0;
709 25         25 $Flag{_verbatim} = 1;
710 25 100       40 if (defined $opts{filter}) {
711 2         9 $opts{filter} = escape_verbatim($opts{filter});
712             }
713 25         23 $BfMacro{filter} = $opts{filter};
714 25         26 $BfMacro{filter_tag} = $opts{t};
715              
716 25 100 66     52 unless (defined $opts{f} or $opts{t}) {
717 2         4 diag_error(
718             "`.Bf' macro:you should specify a -f option or -t option at least");
719 2         2 $Flag{_ignore_text} = 1;
720 2         4 return;
721             }
722 23 100       30 if ($opts{t}) {
723 2 50       6 unless (defined $Filters{ $opts{t} }) {
724 0         0 diag_error("undefined filter tag '$opts{t}' in `.Bf' invocation");
725 0         0 $Flag{_ignore_text} = 1;
726 0         0 return;
727             }
728 2 50       4 if (defined $BfMacro{filter}) {
729 0         0 diag_error("-t and -filter should not be used simultaneously");
730             }
731 2         5 $BfMacro{filter} = $Filters{ $opts{t} }{shell};
732             }
733              
734 23 100 100     212 if (defined $opts{f} and $opts{f} !~ /$Rx{format}/) {
    100          
735 10         18 $Flag{_ignore_text} = 1;
736             }
737             elsif ($State{text}) {
738 5         17 phrasing_macro_begin($opts{ns});
739             }
740              
741 23         50 $State{wants_space} = 0;
742             } # ]]]
743              
744             sub handle_Bl_macro { # [[[
745 152 100   152 0 182 if ($Process) {
746 76         100 handle_Bl_macro_process();
747             }
748             else {
749 76         87 handle_Bl_macro_infos();
750             }
751             } # ]]]
752              
753             sub handle_Bl_macro_infos { # [[[
754 76     76 0 154 my %opts = parse_options(
755             {
756             t => "s",
757             columns => "s",
758             }
759             );
760              
761 76 100 100     407 if (defined $opts{t} and $opts{t} eq "verse") {
    100 100        
762 4         5 $InfosFlag{use_verse} = 1;
763 4         8 my $title = escape_text(args_to_text(\@Arg));
764 4 50       8 return unless $title;
765 4         5 $Count{poem}++;
766             loX_entry_infos(
767             {
768             title => $title,
769             count => $Count{poem},
770 4         13 class => "lop",
771             href_prefix => "poem",
772             }
773             );
774             }
775             elsif (defined $opts{t} and $opts{t} eq "table") {
776              
777             # Self->{lot}
778 34         55 my $title = escape_text(args_to_text(\@Arg));
779 34 100       70 return unless $title;
780 26         24 $Count{table}++;
781             loX_entry_infos(
782             {
783             title => $title,
784             count => $Count{table},
785 26         77 class => "lot",
786             href_prefix => "tbl",
787             }
788             );
789             }
790             } # ]]]
791              
792             sub handle_Bl_macro_process { # [[[
793 76 50   76 0 107 return unless $Process;
794 76         96 close_unclosed_blocks("Bm");
795              
796 76         193 my %opts = parse_options(
797             {
798             t => "s",
799             columns => "s",
800             }
801             );
802              
803 76   100     199 $opts{t} //= "item";
804              
805 76 50       231 unless ($opts{t} =~ /^(?:item|enum|desc|verse|table)$/) {
806 0         0 diag_error("invalid `-t' argument to `.Bl' macro: $opts{t}");
807 0         0 return;
808             }
809              
810 76 100       46 if (@{ $Scope{Bl} }) {
  76         117  
811 6 50       16 if ($Scope{Bl}->[0]->{t} !~ /^(?:item|enum)$/) {
812 0         0 diag_error(
813             "`.Bl' macro of type '$Scope{Bl}->[0]->{t}' cannot be nested");
814 0         0 return;
815             }
816 6 100       11 if ($State{text}) {
817 2         5 give_wanted_space();
818 2         2 flush_normal_text();
819             }
820             }
821             else {
822 70         87 close_eventual_final_paragraph(1);
823             }
824              
825 76         139 scope_stack_push("Bl", $opts{t});
826              
827 76 100       233 if ($opts{t} eq "verse") {
    100          
    100          
    100          
    50          
828 4         7 handle_Bl_verse_macro_process();
829             }
830             elsif ($opts{t} eq "desc") {
831 6         14 print enclose_begin($Param{_list_desc}, { env => 1 }), "\n";
832             }
833             elsif ($opts{t} eq "item") {
834 26         49 print enclose_begin($Param{_list_item}, { env => 1 }), "\n";
835             }
836             elsif ($opts{t} eq "enum") {
837 6         13 print enclose_begin($Param{_list_enum}, { env => 1 }), "\n";
838             }
839             elsif ($opts{t} eq "table") {
840 34         56 handle_Bl_table_macro_process($opts{columns});
841             }
842              
843 76         83 $State{wants_space} = 0;
844 76         151 $Scope{item} = 0;
845             } # ]]]
846              
847             sub handle_Bl_table_macro_process { # [[[
848 34     34 0 36 my $columns = shift;
849 34 100       49 if (@Arg) {
850 26         24 $Count{table}++;
851 26         37 $State{_table_title} = escape_text(args_to_text(\@Arg));
852 26 100       37 if ($Opts{target_format} eq "latex") {
853 8         11 print "\\begin{table}[htbp]\n";
854             }
855             else {
856 18         41 print qq{
\n};
857             }
858             }
859 34         67 print enclose_begin($Param{_list_table}, { env => 1 });
860 34 100       69 if ($Opts{target_format} eq "latex") {
861 12 100       18 unless (defined $columns) {
862 1         3 diag_error("-columns option is required for LaTeX");
863 1         3 $columns = "2";
864             }
865 12 100       43 if ($columns =~ /^\d+$/) {
866 8         24 print "{", "l" x $columns, "}";
867             }
868             else {
869 4         6 print "{", $columns, "}";
870             }
871             }
872 34         35 print "\n";
873 34         39 $State{under_table_scope} = 1;
874             } # ]]]
875              
876             sub handle_Bl_verse_macro_process { # [[[
877 4     4 0 3 my $title;
878 4 50       8 if (@Arg) {
879 4         7 $title = escape_text(args_to_text(\@Arg));
880             }
881 4 100       16 if ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
882 2         4 print qq{
\n};
883             }
884 4 50       8 if (defined $title) {
885 4         5 $Count{poem}++;
886             print enclose_begin(
887             $Param{_poemtitle},
888 4         13 { id => "poem$Count{poem}" }
889             );
890 4         8 print $title;
891 4         6 print enclose_end($Param{_poemtitle}), "\n";
892 4 100       11 print "\\label{poem:$Count{poem}}\n" if $Opts{target_format} eq "latex";
893             }
894 4 100       8 if ($Opts{target_format} eq "latex") {
895 2         3 print enclose_begin($Param{_verse}, { env => 1 }), "\n";
896             }
897             } # ]]]
898              
899             sub handle_Bm_macro { # [[[
900 76     76 0 189 my %opts = parse_options(
901             {
902             t => "s",
903             ns => "b",
904             id => "s",
905             }
906             );
907 76   100     220 $opts{id} //= "";
908 76         95 $opts{id} = escape_text($opts{id});
909 76 100       117 unless ($Process) {
910 34 100       55 $ID{ $opts{id} } = xhtml_gen_href("", $opts{id}) if $opts{id};
911 34         53 return;
912             }
913 42 50       62 if ($opts{id} =~ /\s/) {
914 0         0 diag_error("id identifier should not contain spaces");
915             }
916              
917 42         80 phrasing_macro_begin($opts{ns});
918 42         50 $State{wants_space} = 0;
919              
920 42 50 66     95 if (defined $opts{t} and not defined $Xmtag{ $opts{t} }) {
921 0         0 diag_error("in `.Bm' macro invalid tag argument to `-t' option");
922 0         0 $opts{t} = undef;
923             }
924              
925 42         72 scope_stack_push("Bm", $opts{t}, $opts{id});
926              
927 42         41 my $begin;
928 42 100       62 if (defined $opts{t}) {
929              
930             $begin = enclose_begin(
931             $Xmtag{ $opts{t} }{cmd},
932             { class => $opts{t}, id => $opts{id} }
933 10         32 );
934 10 100       26 if (defined $Xmtag{ $opts{t} }{begin}) {
935 2         4 $begin .= $Xmtag{ $opts{t} }{begin};
936             }
937             }
938 42   66     108 $begin //= enclose_begin($Xmtag{_default}{cmd}, { id => $opts{id} });
939 42 100       73 if ($opts{id}) {
940 2 100       5 if ($Opts{target_format} eq "latex") {
941 1         4 $begin = "\\hypertarget{$opts{id}}{" . $begin;
942             }
943             }
944 42         50 print $begin;
945              
946 42 100       98 if (@Arg) {
947 10 100       14 if (!$State{inline}) {
948 2         3 diag_error("useless arguments to `.Bm' macro");
949             }
950             else {
951 8         10 print escape_text(args_to_text(\@Arg));
952             }
953             }
954             } # ]]]
955              
956             sub handle_Ed_macro { # [[[
957 64 100   64 0 92 return unless $Process;
958 36 100       21 unless (@{ $Scope{Bd} }) {
  36         65  
959 2         4 diag_error("unexpected `.Ed' macro without corresponding `.Bd'");
960 2         4 return;
961             }
962 34         39 my $st = pop @{ $Scope{Bd} };
  34         41  
963              
964 34 100       51 if ($st->{t} eq "literal") {
965 8 100       17 if ($State{text}) {
966 6         10 print $State{text};
967 6         6 $State{text} = "";
968             }
969 8 100       42 if ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
    50          
970 4         8 print enclose_end("pre"), "\n";
971             }
972             elsif ($Opts{target_format} eq "latex") {
973 4         9 print enclose_end("verbatim", { env => 1 }), "\n";
974 4         8 $Flag{_verbatim} = 0;
975             }
976 8   50     14 $Flag{'fr-nbsp-auto'} = $Flag{_fr_nbsp_auto} // 1;
977             }
978             else {
979 26         32 close_eventual_final_paragraph(1);
980              
981 26 100       126 if ($st->{t}) {
    100          
    50          
982 8         9 my $cmd = $Xdtag{ $st->{t} }{cmd};
983 8 100       17 if ($cmd) {
    100          
    50          
984 6         13 print enclose_end($cmd, { env => 1 }), "\n";
985             }
986             elsif ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
987 1         3 print enclose_end("div"), "\n";
988             }
989             elsif ($Opts{target_format} eq "latex") {
990 1         1 print "\n";
991             }
992             }
993             elsif ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
994 11         19 print enclose_end("div"), "\n";
995             }
996             elsif ($Opts{target_format} eq "latex") {
997 7         9 print "\n";
998             }
999             }
1000 34         83 $State{wants_space} = 0;
1001             } # ]]]
1002              
1003             sub handle_Ef_macro { # [[[
1004 58 100   58 0 85 return unless $Process;
1005 29 100       51 unless (defined $Scope{format}) {
1006 2         5 diag_error("unexpected `.Ef' without corresponding `.Bf' invocation");
1007 2         3 return;
1008             }
1009 27 100 100     157 if (!$Scope{format} or $Scope{format} =~ /$Rx{format}/) {
1010 17 100 66     58 if ($BfMacro{filter}) {
    100          
1011 1         5 print_filter($BfMacro{filter}, $State{text});
1012             }
1013             elsif ($BfMacro{filter_tag}
1014             and defined $Filters{ $BfMacro{filter_tag} }{code})
1015             {
1016 2         3 $Flag{_perl} = 1;
1017 2         23 $Filters{ $BfMacro{filter_tag} }{code}->($Self);
1018 2         7 $Flag{_perl} = 0;
1019             }
1020             else {
1021 14         19 print $State{text};
1022             }
1023 17         207 $State{text} = "";
1024             }
1025              
1026 27         25 $State{wants_space} = 0;
1027 27         32 $Scope{format} = "";
1028 27         24 $Flag{_verbatim} = 0;
1029 27         45 $Flag{_ignore_text} = 0;
1030             } # ]]]
1031              
1032             sub handle_El_macro { # [[[
1033 156 100   156 0 249 return unless $Process;
1034 78 100       52 unless (@{ $Scope{Bl} }) {
  78         123  
1035 2         4 diag_error("unexpected `.El' macro without corresponding `.Bl'");
1036 2         3 return;
1037             }
1038 76         56 my $st = pop @{ $Scope{Bl} };
  76         88  
1039              
1040 76 100       116 unless ($Scope{item}) {
1041 10 50 66     47 if ($st->{t} eq "desc") {
    100          
    50          
1042 0         0 diag_error(
1043             "unexpected `.El' macro without previous `.It' in 'desc' list");
1044 0         0 print $Param{_desc_value_begin};
1045             }
1046             elsif ($st->{t} eq "enum" or $st->{t} eq "item") {
1047 2         4 diag_error("unexpected `.El' macro without previous `.It'");
1048 2         3 print $Param{_item_begin};
1049             }
1050             elsif ($State{text}) {
1051 0         0 diag_error(
1052             "`.El' invocation:unexpected accumulated text outside item scope"
1053             );
1054             }
1055             }
1056              
1057 76 100       233 if ($st->{t} eq "verse") {
    100          
    100          
    100          
    50          
1058 4         5 handle_paragraph_end();
1059 4 100       7 if ($Opts{target_format} eq "latex") {
1060 2         5 print enclose_end($Param{_verse}, { env => 1 }), "\n";
1061             }
1062 4 100       25 print qq{\n} if $Opts{target_format} =~ /$Rx{xhtml_or_epub}/;
1063             }
1064             elsif ($st->{t} eq "desc") {
1065 6         8 chomp $State{text};
1066 6         9 give_wanted_space();
1067 6         7 $State{text} .= $Param{_desc_value_end};
1068 6         9 flush_normal_text();
1069 6         19 print enclose_end($Param{_list_desc}, { env => 1 }), "\n";
1070             }
1071             elsif ($st->{t} eq "enum") {
1072 6         6 chomp $State{text};
1073 6         8 give_wanted_space();
1074 6         8 flush_normal_text();
1075 6         6 print $Param{_item_end};
1076 6         10 print enclose_end($Param{_list_enum}, { env => 1 }), "\n";
1077             }
1078             elsif ($st->{t} eq "item") {
1079 26         27 chomp $State{text};
1080 26         27 give_wanted_space();
1081 26         30 flush_normal_text();
1082 26         27 print $Param{_item_end};
1083 26         55 print enclose_end($Param{_list_item}, { env => 1 }), "\n";
1084             }
1085             elsif ($st->{t} eq "table") {
1086 34         45 handle_El_table_macro();
1087             }
1088             else {
1089 0         0 diag_fatal("internal error:handle_El_macro");
1090             }
1091              
1092 76 100       70 $Scope{item} = @{ $Scope{Bl} } ? 1 : 0;
  76         115  
1093 76         156 $State{wants_space} = 0;
1094             } # ]]]
1095              
1096             sub handle_El_table_macro { # [[[
1097 34     34 0 30 chomp $State{text};
1098 34         38 give_wanted_space();
1099 34         35 flush_normal_text();
1100 34 100       46 if ($Scope{item}) {
1101 26         27 print $Param{_table_cell_end};
1102 26         30 print $Param{_table_row_end};
1103             }
1104 34         70 print enclose_end($Param{_list_table}, { env => 1 }), "\n";
1105 34 100       68 if (defined $State{_table_title}) {
1106 26 100       40 if ($Opts{target_format} eq "latex") {
1107 8         17 print "\\caption\{$State{_table_title}\}\n";
1108 8         11 print "\\label\{tbl:$Count{table}\}\n";
1109 8         10 print "\\end{table}\n";
1110             }
1111             else {
1112 18         32 print qq{

$State{_table_title}

\n};
1113 18         21 print "\n";
1114             }
1115 26         23 $State{_table_title} = undef;
1116             }
1117 34         35 $State{under_table_scope} = 0;
1118             } # ]]]
1119              
1120             sub handle_Em_macro { # [[[
1121 74 100   74 0 108 return unless $Process;
1122 44 100       30 unless (@{ $Scope{Bm} }) {
  44         67  
1123 2         5 diag_error("unexpected `.Em' macro without corresponding `.Bm'");
1124 2         4 return;
1125             }
1126 42         51 phrasing_macro_end();
1127              
1128 42         27 my $st = pop @{ $Scope{Bm} };
  42         49  
1129              
1130 42         40 my $end = "";
1131 42 100       58 if (defined $st->{t}) {
1132 10 100       21 if (defined $Xmtag{ $st->{t} }{end}) {
1133 2         4 $end .= $Xmtag{ $st->{t} }{end};
1134             }
1135 10         17 $end .= enclose_end($Xmtag{ $st->{t} }{cmd});
1136             }
1137 42   66     79 $end ||= enclose_end($Xmtag{_default}{cmd});
1138              
1139 42         51 print $end;
1140 42 100       69 if (@Arg) {
1141 18         17 my $close_delim = shift @Arg;
1142 18         23 print escape_text($close_delim);
1143             }
1144 42 100 100     74 if ($st->{id} and $Opts{target_format} eq "latex") {
1145 1         2 print "}";
1146             }
1147              
1148 42 100       114 if (@Arg) {
1149 8 100       12 if (!$State{inline}) {
1150 2         3 diag_error("useless args in macro `.Em'");
1151             }
1152             else {
1153 6 50       12 my $sep = $Flag{ns} ? "" : " ";
1154 6         8 print $sep, escape_text(args_to_text(\@Arg));
1155             }
1156             }
1157             } # ]]]
1158              
1159             sub handle_Ft_macro { # [[[
1160 46 100   46 0 83 return unless $Process;
1161 23         77 my %opts = parse_options(
1162             {
1163             f => "s",
1164             ns => "b",
1165             filter => "s",
1166             }
1167             );
1168              
1169 23 100       53 unless (defined $opts{f}) {
1170 2         4 diag_error("`.Ft' macro invocation: you should specify a -f option");
1171 2         4 return;
1172             }
1173              
1174 21 100 100     17 if (@{ $Scope{Bl} } and not $Scope{item}) {
  21         61  
1175 2         4 diag_error("`.Ft' macro invocation in `.Bl' list outside `.It' scope");
1176 2         5 return;
1177             }
1178              
1179 19 100       123 if ($opts{f} =~ /$Rx{format}/) {
1180 10 100       23 if ($State{text}) {
1181 6         13 phrasing_macro_begin($opts{ns});
1182             }
1183 10 100       22 if (defined $opts{filter}) {
1184             print_filter(
1185 3         16 escape_verbatim($opts{filter}),
1186             escape_verbatim(args_to_text(\@Arg))
1187             );
1188             }
1189             else {
1190 7         17 print escape_verbatim(args_to_text(\@Arg));
1191             }
1192             }
1193 19         490 $State{wants_space} = 0;
1194             } # ]]]
1195              
1196             sub handle_If_macro { # [[[
1197 46     46 0 196 my %opts = parse_options(
1198             {
1199             f => "s",
1200             'as-is' => "b",
1201             filter => "s",
1202             t => "s",
1203             }
1204             );
1205 46 100 100     152 if (defined $opts{f} and $opts{f} !~ /$Rx{format}/) {
1206 2         4 return;
1207             }
1208 44 100       70 unless (@Arg) {
1209 4 100       7 diag_error("The `.If' macro expects a path argument")
1210             if $Process;
1211 4         9 return;
1212             }
1213              
1214 40 100       54 if ($opts{'as-is'}) {
1215 12 100       28 return unless $Process;
1216 6         15 my $file = escape_verbatim(shift @Arg);
1217 6         12 chomp $State{text};
1218 6 100 66     22 print "\n" if $State{wants_space} and not $Flag{ns}; # XXX
1219 6         9 flush_normal_text();
1220 6 100       13 if (defined $opts{filter}) {
    100          
1221 2         7 my $text = slurp_file($file);
1222 2         6 print_filter(escape_verbatim($opts{filter}), $text);
1223             }
1224             elsif (defined $opts{t}) {
1225 2 50       6 unless (defined $Filters{ $opts{t} }) {
1226 0         0 diag_error("`If' invocation:undefined tag '$opts{t}'");
1227 0         0 return;
1228             }
1229 2         4 $State{text} = slurp_file($file);
1230 2 50       7 if (defined $Filters{ $opts{t} }{code}) {
    0          
1231 2         40 $Filters{ $opts{t} }{code}->($Self);
1232             }
1233             elsif (defined $Filters{ $opts{t} }{shell}) {
1234             print_filter(
1235             escape_verbatim($Filters{ $opts{t} }{shell}),
1236             $State{text}
1237 0         0 );
1238             }
1239 2         7 $State{text} = "";
1240             }
1241             else {
1242 2         4 print_file($file);
1243             }
1244             }
1245             else {
1246 28         45 my $file = escape_verbatim(shift @Arg);
1247 28 100       105 if ($file =~ /::/) {
    50          
1248 4 50       8 if ($file =~ /\./) {
1249 0         0 diag_error(
1250             "`.If' invocation:path specified with :: notation should not contain periods:'$file'"
1251             );
1252 0         0 return;
1253             }
1254 4         32 $file = catfile(split /::/, $file);
1255 4         7 $file .= ".frundis";
1256             }
1257             elsif ($file !~ m{[/\.]}) {
1258 0 0       0 $file .= ".frundis" unless -f $file;
1259             }
1260 28 50       323 unless (-f $file) {
1261 0         0 $file = search_inc_file($file);
1262             }
1263 28 100       65 unless ($FileParse{$file}) {
1264 9 50       192 open(my $fh, '<', $file) or diag_fatal("$file:$!");
1265 9         17 $FileParse{$file} = parse_file($fh);
1266 9         60 close $fh;
1267             }
1268 28         33 local $File = $file;
1269 28 100       37 if ($Process) {
1270 14         35 process_source($FileParse{$File});
1271             }
1272             else {
1273 14         37 collect_source_infos($FileParse{$File});
1274             }
1275             }
1276             } # ]]]
1277              
1278             sub handle_Im_macro { # [[[
1279 54 100   54 0 68 if ($Process) {
1280 27         41 handle_Im_macro_process();
1281             }
1282             else {
1283 27         40 handle_Im_macro_infos();
1284             }
1285             } # ]]]
1286              
1287             sub handle_Im_macro_infos { # [[[
1288 27     27 0 29 $InfosFlag{use_graphicx} = 1;
1289 27         74 my %opts = parse_options(
1290             {
1291             ns => "b",
1292             link => "s",
1293             }
1294             );
1295 27 50       55 if (@Arg) {
1296 27         36 my $image = escape_verbatim($Arg[0]);
1297 27         33 push @Image, $image;
1298             }
1299 27 100       65 if (@Arg >= 2) {
1300 8         10 my $caption = escape_text($Arg[1]);
1301 8         8 $Count{fig}++;
1302             loX_entry_infos(
1303             {
1304             title => $caption,
1305             count => $Count{fig},
1306 8         34 class => "lof",
1307             href_prefix => "fig",
1308             }
1309             );
1310             }
1311             } # ]]]
1312              
1313             sub handle_Im_macro_process { # [[[
1314 27 100   27 0 59 my $close_delim = @Arg > 1 ? get_close_delim() : "";
1315 27         72 my %opts = parse_options(
1316             {
1317             ns => "b",
1318             link => "s",
1319             }
1320             );
1321 27 100       62 if (@Arg == 1) {
    50          
1322 19         40 handle_Im_inline_macro_process($close_delim, %opts);
1323             }
1324             elsif (@Arg >= 2) {
1325 8         11 handle_Im_figure_macro_process(%opts);
1326             }
1327             } # ]]]
1328              
1329             sub handle_Im_figure_macro_process { # [[[
1330 8     8 0 7 my %opts = @_;
1331 8         9 $Count{fig}++;
1332 8         7 my $image = $Arg[0];
1333 8         12 my $label = escape_text($Arg[1]);
1334 8 100       16 if (@Arg > 2) {
1335 2         3 diag_error("too many arguments in `.Im' macro");
1336             }
1337 8 100 66     37 if ($image =~ /[{}]/ or $label =~ /[{}]/) {
1338 2         4 diag_error(
1339             q{in `.Im' macro, path argument and label should not contain the characters `{', or `}'}
1340             );
1341 2         5 return;
1342             }
1343 6         10 close_unclosed_blocks("Bm");
1344 6         8 close_unclosed_blocks("Bl");
1345              
1346 6         7 close_eventual_final_paragraph();
1347              
1348 6 100       23 if ($Opts{target_format} eq "latex") {
    50          
1349 3         4 $image = escape_verbatim($image);
1350 3         5 $image = escape_latex_percent($image);
1351 3         5 print "\\begin{center}\n";
1352 3         3 print "\\begin{figure}[htbp]\n";
1353 3         16 print "\\includegraphics{$image}\n";
1354 3         7 print "\\caption{$label}\n";
1355 3         8 print "\\label\{fig:$Count{fig}\}\n";
1356 3         3 print "\\end{figure}\n";
1357 3         7 print "\\end{center}\n";
1358             }
1359             elsif ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
1360 3         9 print qq{
\n};
1361 3 50       5 if ($Opts{target_format} eq "epub") {
1362 0         0 $image =~ s|.*/||;
1363 0         0 $image = escape($image);
1364 0         0 my $u = URI->new($image);
1365 0         0 $u = escape_xhtml_text($u);
1366 0         0 $image = escape_xhtml_text($image);
1367 0         0 my $path = catfile('images', $u);
1368 0         0 print qq| $image\n|;
1369             }
1370             else {
1371 3         4 $image = escape($image);
1372 3         9 my $u = URI->new($image);
1373 3         118 $u = escape_xhtml_text($u);
1374 3         5 $image = escape_xhtml_text($image);
1375 3 50       20 if (defined $opts{link}) {
1376 0         0 my $link = URI->new(escape($opts{link}));
1377 0         0 $link = escape_xhtml_text($link);
1378 0         0 print qq| $image\n|;
1379             }
1380             else {
1381 3         8 print qq| $image\n|;
1382             }
1383             }
1384 3         17 print qq|

$label

\n|;
1385 3         8 print "\n";
1386             }
1387              
1388             } # ]]]
1389              
1390             sub handle_Im_inline_macro_process { # [[[
1391 19     19 0 23 my ($close_delim, %opts) = @_;
1392              
1393 19         21 my $image = $Arg[0];
1394 19 100       50 if ($image =~ /[\{\}]/) {
1395 2         6 diag_error(
1396             q{in `.Im' macro, path argument should not contain the characters `{', or `}'}
1397             );
1398 2         6 return;
1399             }
1400 17         41 phrasing_macro_begin($opts{ns});
1401 17 100       65 if ($Opts{target_format} eq "latex") {
    100          
    50          
1402 6         17 $image = escape_latex_percent(escape_verbatim($image));
1403 6         30 print "\\includegraphics{$image}$close_delim";
1404             }
1405             elsif ($Opts{target_format} eq "epub") {
1406 2         11 $image =~ s|.*/||;
1407 2         6 $image = escape($image);
1408 2         13 my $u = URI->new($image);
1409 2         3515 $u = escape_xhtml_text($u);
1410 2         4 $image = escape_xhtml_text($image);
1411 2         7 my $path = catfile('images', $u);
1412 2         27 print qq|$image$close_delim|;
1413             }
1414             elsif ($Opts{target_format} eq "xhtml") {
1415 9         14 $image = escape($image);
1416 9         44 my $u = URI->new($image);
1417 9         322 $u = escape_xhtml_text($u);
1418 9         15 $image = escape_xhtml_text($image);
1419 9 100       19 if (defined $opts{link}) {
1420 1         3 my $link = URI->new(escape($opts{link}));
1421 1         40 $link = escape_xhtml_text($link);
1422 1         3 print
1423             qq|$image$close_delim|;
1424             }
1425             else {
1426 8         18 print qq|$image$close_delim|;
1427             }
1428             }
1429             } # ]]]
1430              
1431             sub handle_It_macro { # [[[
1432 254 100   254 0 367 return unless $Process;
1433              
1434 127 100       79 unless (@{ $Scope{Bl} }) {
  127         319  
1435 2         4 diag_error("unexpected `.It' macro outside a `.Bl' macro scope");
1436 2         3 return;
1437             }
1438 125         153 close_unclosed_blocks("Bm");
1439              
1440 125         116 my $st = $Scope{Bl}->[0];
1441              
1442 125 100       361 if ($st->{t} eq "desc") {
    100          
    100          
    50          
1443 8         11 handle_It_desc_macro();
1444             }
1445             elsif ($st->{t} =~ /^(?:item|enum)$/) {
1446 60         64 handle_It_itemenum_macro();
1447             }
1448             elsif ($st->{t} eq "table") {
1449 45         56 handle_It_table_macro();
1450             }
1451             elsif ($st->{t} eq "verse") {
1452 12         13 handle_It_verse_macro();
1453             }
1454              
1455 125         115 $State{wants_space} = 0;
1456 125         158 $Scope{item} = 1; # following text belongs to an item
1457             } # ]]]
1458              
1459             sub handle_It_desc_macro { # [[[
1460 8 100   8 0 12 if ($Scope{item}) {
1461 2         3 end_any_previous_item();
1462 2         2 print $Param{_desc_value_end};
1463             }
1464 8 50       19 unless (@Arg) {
1465 0         0 diag_warning("description item of `.It' without name");
1466             }
1467 8         9 my $name = process_inline_macros();
1468             print $Param{_desc_name_begin}, $name,
1469 8         121 $Param{_desc_name_end}, $Param{_desc_value_begin};
1470             } # ]]]
1471              
1472             sub handle_It_itemenum_macro { # [[[
1473 60 100   60 0 88 if ($Scope{item}) {
1474 30         34 end_any_previous_item();
1475 30         36 print $Param{_item_end};
1476             }
1477 60         61 print $Param{_item_begin};
1478 60 100       83 if (@Arg) {
1479 18 50       25 my $space = $Flag{ns} ? "" : "\n";
1480 18         30 print escape_text(args_to_text(\@Arg)), $space;
1481             }
1482             } # ]]]
1483              
1484             sub handle_It_table_macro { # [[[
1485 45 100   45 0 66 if ($Scope{item}) {
1486 19         26 end_any_previous_item();
1487 19         21 print $Param{_table_cell_end};
1488 19         17 print $Param{_table_row_end};
1489             }
1490 45         51 print $Param{_table_row_begin};
1491 45 100       80 unless ($Opts{target_format} eq "latex") {
1492 30         29 print $Param{_table_cell_begin};
1493             }
1494 45 100       65 if (@Arg) {
1495 39 50       51 my $space = $Flag{ns} ? "" : "\n";
1496 39         54 print escape_text(args_to_text(\@Arg)), $space;
1497             }
1498             } # ]]]
1499              
1500             sub handle_It_verse_macro { # [[[
1501 12 100   12 0 22 if (not $Scope{paragraph}) {
    50          
1502 6         6 print $Param{_paragraph_begin};
1503 6         6 $Scope{paragraph} = 1;
1504             }
1505             elsif ($Scope{item}) {
1506 6         6 give_wanted_space();
1507 6         7 flush_normal_text();
1508 6         7 print $Param{_line_break};
1509             }
1510 12 100       16 if (@Arg) {
1511 8         15 print escape_text(args_to_text(\@Arg));
1512             }
1513             } # ]]]
1514              
1515             sub handle_Lk_macro { # [[[
1516 52 100   52 0 90 return unless $Process;
1517 26         33 my $close_delim = get_close_delim();
1518 26         68 my %opts = parse_options(
1519             {
1520             ns => "b",
1521             }
1522             );
1523 26 100       48 unless (@Arg) {
1524 2         3 diag_error("`.Lk' macro requires arguments");
1525 2         5 return;
1526             }
1527              
1528 24         54 phrasing_macro_begin($opts{ns});
1529              
1530 24 50 66     68 if ($Param{lang} eq "fr" and $close_delim =~ /^(?:!|:|\?|;)$/) {
1531 0         0 $close_delim .= $Param{'nbsp'} . $close_delim;
1532             }
1533              
1534 24 100       58 if (@Arg >= 2) {
    50          
1535 6 100       18 if (@Arg > 2) {
1536 2         4 diag_error("too many arguments in `.Lk' macro");
1537             }
1538 6         10 my ($url, $label) = @Arg;
1539 6         9 $url = URI->new(escape($url));
1540 6         6093 $label = escape_text($label);
1541 6 100       37 if ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
    50          
1542 3         5 $url = escape_xhtml_text($url);
1543 3         6 print qq{$label};
1544             }
1545             elsif ($Opts{target_format} eq "latex") {
1546 3         7 $url = escape_latex_percent($url);
1547 3         9 print qq|\\href{$url}{$label}|;
1548             }
1549             }
1550             elsif (@Arg == 1) {
1551 18         19 my $url = shift @Arg;
1552 18         33 my $url_e = URI->new(escape_verbatim($url));
1553             {
1554 18         865 local $Flag{_verbatim} = 1;
  18         33  
1555 18         28 $url = escape_text($url);
1556             }
1557 18 100       84 if ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
    50          
1558 9         14 $url_e = escape_xhtml_text($url_e);
1559 9         24 print qq{$url};
1560             }
1561             elsif ($Opts{target_format} eq "latex") {
1562 9         19 $url_e = escape_latex_percent($url_e);
1563 9         23 print qq|\\url{$url_e}|;
1564             }
1565             }
1566 24         142 print "$close_delim";
1567             } # ]]]
1568              
1569             sub handle_P_macro { # [[[
1570 156 100   156 0 240 return unless $Process;
1571 78 100       160 if ($Scope{paragraph}) {
    100          
    100          
1572 20         30 handle_paragraph_end();
1573             }
1574             elsif ($State{text}) {
1575 37         47 handle_paragraph();
1576             }
1577             elsif ($Opts{target_format} eq "latex") {
1578 8         12 print "\n"; # can be usefull after a display block
1579             }
1580 78         79 $Scope{item} = 0; # for verse
1581              
1582 78 100       163 if ($State{macro} eq "D") {
    100          
1583 4         5 paragraph_begin();
1584 4         7 print escape_text($Param{'dmark'});
1585             }
1586             elsif (@Arg) {
1587 17         27 my $title = process_inline_macros();
1588 17 100       276 if ($Opts{target_format} eq "latex") {
    50          
1589 6         16 print "\\paragraph{$title}\n";
1590             }
1591             elsif ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
1592 11         30 print
1593             qq{

$title\n};

1594             }
1595 17         23 reopen_spanning_blocks();
1596 17         19 $Scope{paragraph} = 1;
1597             }
1598 78         185 $State{wants_space} = 0;
1599             } # ]]]
1600              
1601             sub handle_Sm_macro { # [[[
1602 146     146 0 374 my %opts = parse_options(
1603             {
1604             t => "s",
1605             ns => "b",
1606             id => "s",
1607             }
1608             );
1609 146   100     419 $opts{id} //= "";
1610 146         183 $opts{id} = escape_text($opts{id});
1611 146 100       191 unless ($Process) {
1612 67 100       107 $ID{ $opts{id} } = xhtml_gen_href("", $opts{id}) if $opts{id};
1613 67         107 return;
1614             }
1615 79 50       120 if ($opts{id} =~ /\s/) {
1616 0         0 diag_error("id identifier should not contain spaces");
1617             }
1618              
1619 79 100       134 my $close_delim = @Arg > 1 ? get_close_delim() : "";
1620              
1621 79         65 my $text = "";
1622 79 100 100     185 if (defined $opts{t} and not defined $Xmtag{ $opts{t} }) {
1623 4         10 diag_error(
1624             "`.Sm' macro invocation:invalid tag argument to `-t' option");
1625 4         5 $opts{t} = undef;
1626             }
1627 79 100       89 if (@Arg) {
1628 75         110 $text = escape_text(args_to_text(\@Arg));
1629             }
1630             else {
1631 4         7 diag_error("`.Sm' macro invocation:arguments required");
1632 4         9 return;
1633             }
1634              
1635 75         164 phrasing_macro_begin($opts{ns});
1636              
1637 75         82 my ($begin, $end);
1638 75 100       205 if (defined $opts{t}) {
1639             $begin = enclose_begin(
1640             $Xmtag{ $opts{t} }{cmd},
1641             { class => $opts{t}, id => $opts{id} }
1642 22         76 );
1643 22 100       59 if (defined $Xmtag{ $opts{t} }{begin}) {
1644 4         8 $begin .= $Xmtag{ $opts{t} }{begin};
1645             }
1646 22 100       38 if (defined $Xmtag{ $opts{t} }{end}) {
1647 4         8 $end = $Xmtag{ $opts{t} }{end};
1648             }
1649 22         31 $end .= enclose_end($Xmtag{ $opts{t} }{cmd});
1650             }
1651 75   66     211 $begin //= enclose_begin($Xmtag{_default}{cmd}, { id => $opts{id} });
1652 75   66     158 $end //= enclose_end($Xmtag{_default}{cmd});
1653 75 100       109 if ($opts{id}) {
1654 9 100       20 if ($Opts{target_format} eq "latex") {
1655 2         6 $begin = "\\hypertarget{$opts{id}}{" . $begin;
1656 2         4 $end .= "}";
1657             }
1658             }
1659 75         257 print $begin . $text . $end . $close_delim;
1660             } # ]]]
1661              
1662             sub handle_Sx_macro { # [[[
1663 186 100   186 0 280 return unless $Process;
1664 92         280 my %opts = parse_options(
1665             {
1666             ns => "b",
1667             name => "s",
1668             t => "s",
1669             id => "b",
1670             }
1671             );
1672              
1673 92   100     288 $opts{t} //= "toc";
1674 92 100       144 my $close_delim = @Arg > 1 ? get_close_delim() : "";
1675 92 100       117 unless (@Arg) {
1676 2         4 diag_error("`.Sx' macro invocation:arguments required");
1677 2         4 return;
1678             }
1679 90 50 66     194 unless (defined $Self->{loX}{ $opts{t} } or $opts{id}) {
1680 0         0 diag_error("`.Sx' macro invocation:invalid argument to -type");
1681 0         0 return;
1682             }
1683              
1684 90         132 my $id = args_to_text(\@Arg);
1685 90         124 $id = escape_text($id);
1686 90         70 my $valid_title;
1687             my $loX_entry;
1688 90 100       126 unless ($opts{id}) {
1689 71         64 $valid_title = 1;
1690 71 100       149 unless (exists $Self->{loX}{ $opts{t} }{$id}) {
1691 2         6 diag_error(
1692             "`.Sx' invocation:unknown title for type '$opts{t}':$id");
1693 2         2 $valid_title = 0;
1694             }
1695 71         88 $loX_entry = $Self->{loX}{ $opts{t} }{$id};
1696             }
1697 90         170 phrasing_macro_begin($opts{ns});
1698 90 100       190 my $name = $opts{name} ? escape_text($opts{name}) : process_inline_macros();
1699              
1700 90 100       1165 if ($Opts{target_format} eq "latex") {
    50          
1701 23 100       55 if ($opts{id}) {
    100          
1702 3 50       8 unless ($ID{$id}) {
1703 0         0 diag_error("reference to unknown id '$id'");
1704             }
1705 3         13 print "\\hyperlink{$id}{$name}$close_delim";
1706             }
1707             elsif ($valid_title) {
1708 19         25 my $num = $loX_entry->{count};
1709 19         18 my $prefix = $loX_entry->{href_prefix};
1710 19         80 print "\\hyperref[$prefix:", $num, "]{", $name, "}", $close_delim;
1711             }
1712             else {
1713 1         3 print $name, $close_delim;
1714             }
1715             }
1716             elsif ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
1717 67 100       119 if ($opts{id}) {
    100          
1718 16 50       25 if (not $ID{$id}) {
1719 0         0 diag_error("reference to unknown id '$id'");
1720 0         0 print qq{$name$close_delim};
1721             }
1722             else {
1723 16         68 print qq{$name$close_delim};
1724             }
1725             }
1726             elsif ($valid_title) {
1727 50         60 my $href = $loX_entry->{href};
1728 50         188 print qq{$name$close_delim};
1729             }
1730             else {
1731 1         5 print qq{$name$close_delim};
1732             }
1733             }
1734             } # ]]]
1735              
1736             sub handle_Ta_macro { # [[[
1737 133 100   133 0 181 return unless $Process;
1738 66 100       45 unless (@{ $Scope{Bl} }) {
  66         95  
1739 3         6 diag_error("unexpected `.Ta' macro outside a `.Bl' macro scope");
1740 3         6 return;
1741             }
1742 63 100       91 unless ($State{under_table_scope}) {
1743 2         3 diag_error("found `.Ta' macro in non ``table'' list");
1744 2         4 return;
1745             }
1746 61 100       76 unless ($Scope{item}) {
1747 2         3 diag_error("found `.Ta' macro outside an `.It' scope");
1748 2         4 return;
1749             }
1750 59         67 close_unclosed_blocks("Bm");
1751              
1752 59         57 chomp $State{text};
1753 59         64 give_wanted_space();
1754 59         62 flush_normal_text();
1755 59         57 print $Param{_table_cell_end};
1756 59         53 print $Param{_table_cell_begin};
1757              
1758 59 100       90 if (@Arg) {
1759 51         66 print escape_text(args_to_text(\@Arg)), "\n";
1760             }
1761             } # ]]]
1762              
1763             sub handle_Tc_macro { # [[[
1764 110 100   110 0 145 if ($Process) {
1765 55         79 handle_Tc_macro_process();
1766             }
1767             else {
1768 55         64 handle_Tc_macro_infos();
1769             }
1770             } # ]]]
1771              
1772             sub handle_Tc_macro_infos { # [[[
1773 55     55 0 189 my %opts = parse_options(
1774             {
1775             summary => "b",
1776             nonum => "b",
1777             mini => "b",
1778             toc => "b",
1779             lof => "b",
1780             lot => "b",
1781             title => "s",
1782             }
1783             );
1784 55 100       132 $InfosFlag{use_minitoc} = 1 if $opts{mini};
1785 55 50 66     111 $InfosFlag{dominilof} = 1 if $opts{mini} and $opts{lof};
1786 55 50 66     90 $InfosFlag{dominilot} = 1 if $opts{mini} and $opts{lot};
1787 55 50 66     161 $InfosFlag{dominitoc} = 1 if $opts{mini} and $opts{toc};
1788             } # ]]]
1789              
1790             sub handle_Tc_macro_process { # [[[
1791 55     55 0 66 close_unclosed_blocks("Bm");
1792 55         58 close_unclosed_blocks("Bl");
1793              
1794 55         213 my %opts = parse_options(
1795             {
1796             summary => "b",
1797             nonum => "b",
1798             mini => "b",
1799             toc => "b",
1800             lof => "b",
1801             lot => "b",
1802             title => "s",
1803             }
1804             );
1805              
1806 55         109 close_eventual_final_paragraph();
1807              
1808 55 100 33     178 unless ($opts{toc} or $opts{lof} or $opts{lot}) {
      33        
1809 46         48 $opts{toc} = 1;
1810             }
1811 55 0 66     255 if ( $opts{toc} && $opts{lof}
      66        
      33        
      33        
      33        
1812             or $opts{toc} and $opts{lot}
1813             or $opts{lof} and $opts{lot})
1814             {
1815 0         0 diag_error(
1816             "`.Tc' invocation:only one of the -toc, -lof and -lot options should bet set"
1817             );
1818 0         0 return;
1819             }
1820              
1821 55 100       221 if ($Opts{target_format} eq "latex") {
    50          
1822 15 100       20 if ($opts{summary}) {
1823 3         8 print "\\setcounter{tocdepth}{0}\n";
1824             }
1825             else {
1826 12         21 print "\\setcounter{tocdepth}{3}\n";
1827             }
1828 15 100       22 if ($opts{mini}) {
1829 6 50       14 if ($opts{lof}) {
    50          
1830 0         0 print "\\minilof\n";
1831             }
1832             elsif ($opts{lot}) {
1833 0         0 print "\\minilot\n";
1834             }
1835             else {
1836 6         14 print "\\minitoc\n";
1837             }
1838             }
1839             else {
1840 9 50       19 if ($opts{lof}) {
    100          
1841 0         0 print "\\listoffigures\n";
1842             }
1843             elsif ($opts{lot}) {
1844 2         5 print "\\listoftables\n";
1845             }
1846             else {
1847 7         14 print "\\tableofcontents\n";
1848             }
1849             }
1850             }
1851             elsif ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
1852 40 50       74 if ($opts{lof}) {
    100          
1853 0         0 xhtml_lof(\%opts);
1854             }
1855             elsif ($opts{lot}) {
1856 7         15 xhtml_lot(\%opts);
1857             }
1858             else {
1859 33         62 xhtml_toc("xhtml", \%opts);
1860             }
1861             }
1862             } # ]]]
1863              
1864             sub handle_X_macro { # [[[
1865 404 100   404 0 568 return if $Process;
1866 202 50       306 unless (@Arg) {
1867 0         0 warn diag(
1868             "warning:.$State{macro} invocation: you should specify arguments");
1869 0         0 return;
1870             }
1871              
1872 202         178 my $cmd = shift @Arg;
1873 202 100       491 if ($cmd eq "dtag") {
    100          
    100          
    50          
1874 22         36 handle_X_dtag_macro($cmd);
1875             }
1876             elsif ($cmd eq "ftag") {
1877 3         7 handle_X_ftag_macro($cmd);
1878             }
1879             elsif ($cmd eq "mtag") {
1880 50         58 handle_X_mtag_macro($cmd);
1881             }
1882             elsif ($cmd eq "set") {
1883 127         137 handle_X_set_macro($cmd);
1884             }
1885             } # ]]]
1886              
1887             sub handle_X_dtag_macro { # [[[
1888 22     22 0 20 my $cmd = shift;
1889 22         63 my %opts = parse_options(
1890             {
1891             f => "s",
1892             t => "s",
1893             c => "s",
1894             },
1895             "$State{macro} $cmd",
1896             );
1897 22 100       45 unless (defined $opts{f}) {
1898 2         8 diag_error(
1899             "`.$State{macro} $cmd' invocation: you should specify `-f' option");
1900 2         5 return;
1901             }
1902 20 100       101 unless ($opts{f} =~ /$Rx{valid_format}/) {
1903 2         7 diag_error("`.X $cmd' invocation:invalid argument to -f:$opts{f}");
1904 2         4 return;
1905             }
1906 18 100       86 return unless $opts{f} =~ /$Rx{format}/;
1907 9 100       16 unless (defined $opts{t}) {
1908 1         5 diag_error(
1909             "-t option should have an argument in `.$State{macro} $cmd' invocation"
1910             );
1911 1         3 return;
1912             }
1913              
1914 8         19 $Xdtag{ $opts{t} }{cmd} = $Xdtag{_default}{cmd};
1915 8 100       15 if (defined $opts{c}) {
1916 5 100       16 if (not $opts{c} =~ /^[a-zA-Z]*$/) {
1917 1         5 diag_error(
1918             "`.X $cmd' invocation: invalid argument to -c:$opts{c}:it should be composed of ascii letters"
1919             );
1920             }
1921 5 100       23 if ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
1922             diag_warning(
1923             "`.X $cmd' invocation:possibly inadequate element argument to -c:$opts{c}"
1924             )
1925             unless $opts{c} eq ""
1926 3 100 66     24 or $HtmlContainingFlow{ $opts{c} };
1927             }
1928 5         16 $Xdtag{ $opts{t} }{cmd} = $opts{c};
1929             }
1930             } # ]]]
1931              
1932             sub handle_X_ftag_macro { # [[[
1933 3     3 0 4 my $cmd = shift;
1934 3         20 my %opts = parse_options(
1935             {
1936             f => "s",
1937             t => "s",
1938             shell => "s",
1939             code => "s",
1940             }
1941             );
1942 3 50       12 if (defined $opts{f}) {
1943 0 0       0 unless ($opts{f} =~ /$Rx{valid_format}/) {
1944 0         0 diag_error("`.X $cmd' invocation: invalid argument to -f:$opts{f}");
1945 0         0 return;
1946             }
1947 0 0       0 return unless $opts{f} =~ /$Rx{format}/;
1948             }
1949 3 50       7 unless (defined $opts{t}) {
1950 0         0 diag_error("`.X $cmd' invocation:-t option should be specified");
1951 0         0 return;
1952             }
1953 3 0 33     8 if ($opts{shell} and $opts{code}) {
1954 0         0 diag_error(
1955             "`.X $cmd' invocation:-shell and -code cannot be used simultaneously"
1956             );
1957             }
1958 3         10 $Filters{ $opts{t} }{shell} = $opts{shell};
1959 3 50       7 if ($opts{code}) {
1960             Text::Frundis::PerlEval::_compile_perl_code(
1961             $Self, $opts{t},
1962 3         11 $opts{code}, "filter"
1963             );
1964             }
1965             } # ]]]
1966              
1967             sub handle_X_mtag_macro { # [[[
1968 50     50 0 36 my $cmd = shift;
1969 50         188 my %opts = parse_options(
1970             {
1971             f => "s",
1972             t => "s",
1973             c => "s",
1974             b => "s",
1975             e => "s",
1976             },
1977             "$State{macro} $cmd",
1978             );
1979 50 100       110 unless (defined $opts{f}) {
1980 4         10 diag_error(
1981             "`.$State{macro} $cmd' invocation: you should specify `-f' option");
1982 4         8 return;
1983             }
1984 46 100       266 unless ($opts{f} =~ /$Rx{valid_format}/) {
1985 2         7 diag_error(
1986             "`.X $cmd' invocation:invalid argument to -f option:$opts{f}");
1987 2         5 return;
1988             }
1989 44 100       214 return unless $opts{f} =~ /$Rx{format}/;
1990              
1991 22 100       32 unless (defined $opts{t}) {
1992 3         8 diag_error("`.X $cmd' invocation:-t option should be specified");
1993 3         7 return;
1994             }
1995              
1996 19         48 $Xmtag{ $opts{t} }{cmd} = $Xmtag{_default}{cmd};
1997 19 100 66     83 if (defined $opts{c} and $opts{c} =~ /^[a-zA-Z]*$/) {
1998 13 50       30 if (not $opts{c} =~ /^[a-zA-Z]*$/) {
1999 0         0 diag_error(
2000             "`.X $cmd' invocation: invalid argument to -c:$opts{c}:it should be composed of ascii letters"
2001             );
2002             }
2003 13 100       61 if ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
2004             diag_warning(
2005             "`.X $cmd' invocation:non phrasing element argument to -c:$opts{c}:you should probably use a dtag"
2006             )
2007             unless $opts{c} eq ""
2008 7 100 100     40 or $HtmlPhrasing{ $opts{c} };
2009             }
2010 13         24 $Xmtag{ $opts{t} }{cmd} = $opts{c};
2011             }
2012              
2013             # other optional options
2014 19 100       32 if (defined $opts{b}) {
2015 9         16 $Xmtag{ $opts{t} }{begin} = escape_text($opts{b});
2016             }
2017 19 100       51 if (defined $opts{e}) {
2018 9         11 $Xmtag{ $opts{t} }{end} = escape_text($opts{e});
2019             }
2020              
2021             } # ]]]
2022              
2023             sub handle_X_set_macro { # [[[
2024 127     127 0 89 my $cmd = shift;
2025 127         294 my %opts = parse_options(
2026             {
2027             f => "s",
2028             },
2029             "$State{macro} $cmd",
2030             );
2031 127 100       225 if (defined $opts{f}) {
2032 8 50       56 unless ($opts{f} =~ /$Rx{valid_format}/) {
2033 0         0 diag_error("`.X $cmd' invocation: invalid argument to -f:$opts{f}");
2034 0         0 return;
2035             }
2036 8 100       52 return unless $opts{f} =~ /$Rx{format}/;
2037             }
2038 123 100       164 unless (@Arg >= 2) {
2039 2         6 diag_error("`.X $cmd' invocation expects two arguments");
2040 2         5 return;
2041             }
2042 121 100       155 if (@Arg > 2) {
2043 2         6 diag_error("`.X $cmd' invocation: too many arguments");
2044             }
2045              
2046 121         85 my $parameter = $Arg[0];
2047 121 100       183 unless ($AllowedParam{$parameter}) {
2048 4         9 diag_warning(
2049             "useless `.X set' definition of unknown parameter '$parameter'");
2050             }
2051              
2052 121         176 $Param{$parameter} = $Arg[1];
2053              
2054 121 100 66     482 if ($parameter =~ /^document-(?:author|date|title)$/) {
    100          
    100          
    100          
    100          
2055 25         46 $Param{$parameter} = escape_text($Param{$parameter});
2056             }
2057             elsif ($parameter eq "nbsp") {
2058 1         4 $Xhtml_escapes{'\~'} = $Param{nbsp};
2059             }
2060             elsif ( $parameter eq "xhtml-index"
2061             and $Param{$parameter} !~ /^(?:full|summary|none)$/)
2062             {
2063 2         36 diag_error(
2064             "`.X set' invocation:xhtml-index parameter:unknown value:$Param{$parameter}"
2065             );
2066             }
2067             elsif ($parameter eq "epub-version") {
2068             diag_error(
2069             "`.X set' invocation:epub-version parameter should be 2 or 3")
2070 1 50       10 unless $Param{$parameter} =~ /^(?:2|3)$/;
2071             }
2072             elsif ($parameter eq "lang") {
2073 9 50       24 if ($IndexTraductions{ $Param{lang} }) {
2074 9         21 $Param{_index} = $IndexTraductions{ $Param{lang} };
2075             }
2076             }
2077             } # ]]]
2078              
2079             sub handle_de_macro { # [[[
2080 160 50   160 0 231 if ($Scope{de}) {
2081 0 0       0 diag_error(
2082             "found `.#de' macro in the scope of a previous `.#de' macro at line $DeMacro{lnum}"
2083             ) if $Process;
2084 0         0 return;
2085             }
2086 160         347 my %opts = parse_options(
2087             {
2088             f => "s",
2089             perl => "b",
2090             }
2091             );
2092              
2093 160 50       283 unless (@Arg) {
2094 0 0       0 diag_error("a name should be specified to the `.#de' declaration")
2095             if $Process;
2096 0         0 return;
2097             }
2098 160         132 my $name = shift @Arg;
2099 160 50 33     555 if ($name =~ /^[A-Z][a-z]$/ or $name =~ /^#/) {
2100 0         0 diag_error(
2101             "two letters names of the form Xy and names starting by # are reserved"
2102             );
2103             }
2104 160         143 $Scope{de} = 1;
2105 160         144 $DeMacro{file} = $File;
2106 160         145 $DeMacro{lnum} = $State{lnum};
2107 160         138 $DeMacro{perl} = $opts{perl};
2108 160         136 $DeMacro{name} = $name;
2109 160   100     523 $Macro{ $DeMacro{name} }{parse} //= [];
2110              
2111 160 100       234 if (defined $opts{f}) {
2112 72 50       426 unless ($opts{f} =~ /$Rx{valid_format}/) {
2113 0 0       0 diag_error(
2114             "`.#de' invocation:invalid argument to -f option:$opts{f}")
2115             if $Process;
2116             }
2117 72 100       305 unless ($opts{f} =~ /$Rx{format}/) {
2118 36         40 $DeMacro{ignore} = 1;
2119             }
2120             }
2121              
2122 160 50 33     402 if (@Arg && $Process) {
2123 0         0 diag_error("`.#de' invocation:too many arguments");
2124             }
2125             } # ]]]
2126              
2127             sub handle_dv_macro { # [[[
2128 16     16 0 31 my %opts = parse_options(
2129             {
2130             f => "s",
2131             }
2132             );
2133 16 50       31 unless (@Arg) {
2134 0         0 diag_error("`.dv' requires arguments");
2135 0         0 return;
2136             }
2137 16 50       22 if (defined $opts{f}) {
2138 0 0       0 unless ($opts{f} =~ /$Rx{valid_format}/) {
2139 0         0 diag_error(
2140             "`.dv' invocation:invalid argument to -f option:$opts{f}");
2141 0         0 return;
2142             }
2143 0 0       0 return unless $opts{f} =~ /$Rx{format}/;
2144             }
2145              
2146 16         24 my ($name, @arg) = @Arg;
2147 16 50       20 if (@arg) {
2148 16         34 $Self->{vars}{$name} = join(" ", @arg);
2149 16         29 return;
2150             }
2151             else {
2152 0         0 diag_error("`.dv' invocation:value required");
2153             }
2154             } # ]]]
2155              
2156             sub handle_end_macro { # [[[
2157 160 100   160 0 240 unless ($Scope{de}) {
2158 4 100       7 diag_error("`..' allowed only within a `.#de' macro scope")
2159             if $Process;
2160 4         7 return;
2161             }
2162 156         102 $Scope{de} = 0;
2163 156 100       234 if ($DeMacro{ignore}) {
2164 36         41 reset_de_macro_state();
2165 36         51 return;
2166             }
2167 120 100       192 $Macro{ $DeMacro{name} }{perl} = 1 if $DeMacro{perl};
2168 120 100       148 if ($DeMacro{perl}) {
2169 60         110 my $text = escape_verbatim($Macro{ $DeMacro{name} }{parse}->[0][0]);
2170 60         54 $Flag{_perl} = 1;
2171             Text::Frundis::PerlEval::_compile_perl_code(
2172             $Self, $DeMacro{name},
2173 60         120 $text, "macro"
2174             );
2175 60         80 $Flag{_perl} = 0;
2176             }
2177 120         197 $Macro{ $DeMacro{name} }{lnum} = $DeMacro{lnum};
2178 120         155 reset_de_macro_state();
2179             } # ]]]
2180              
2181             sub handle_fl_macro { # [[[
2182 36 100   36 0 61 return unless $Process;
2183 18 100       29 unless (@Arg) {
2184 2         4 diag_error("`.#fl' requires at least one argument");
2185 2         3 return;
2186             }
2187 16         21 my ($key, $value) = @Arg;
2188 16 100       29 unless ($AllowedFlag{$key}) {
2189 6         12 diag_warning("unsupported key in `.#fl' macro:$key");
2190             }
2191 16 100       29 if (defined $value) {
    50          
2192 12 50 66     48 if (defined $Flag{$key} and $value eq $Flag{$key}) {
2193 0         0 diag_warning("useless use of `.#fl', value doesn't change");
2194 0         0 return;
2195             }
2196 12         26 $Flag{$key} = $value;
2197             }
2198             elsif (defined $Flag{$key}) {
2199 4         10 $Flag{$key} = !$Flag{$key};
2200             }
2201             else {
2202 0         0 diag_warning("use of undefined state value in `.#fl' macro");
2203             }
2204             } # ]]]
2205              
2206             sub handle_header_macro { # [[[
2207 370 100   370 0 410 if ($Process) {
2208 185         208 handle_header_macro_process();
2209             }
2210             else {
2211 185         174 handle_header_macro_infos();
2212             }
2213             } # ]]]
2214              
2215             sub handle_header_macro_infos { # [[[
2216 185     185 0 155 my $macro = $State{macro};
2217 185         330 my %opts = parse_options(
2218             { nonum => "b" },
2219             );
2220 185 100       322 unless (@Arg) {
2221 2         4 return;
2222             }
2223              
2224 183         122 my $href;
2225 183         348 headers_count_update($opts{nonum});
2226 183 100 66     516 if ($macro eq "Pt") {
    100          
    50          
2227 24         23 $InfosFlag{has_part} = 1;
2228 24         35 $href = xhtml_gen_href("s", $Count{header}, 1);
2229             }
2230             elsif ($macro eq "Ch") {
2231 75         74 $InfosFlag{has_chapter} = 1;
2232 75         98 $href = xhtml_gen_href("s", $Count{header}, 1);
2233             }
2234             elsif ($macro eq "Sh" or $macro eq "Ss") {
2235 84 100       103 if ($Opts{all_in_one_file}) {
2236 54         98 $href = xhtml_gen_href("s", "$Count{header}");
2237             }
2238             else {
2239 30         67 $href = xhtml_gen_href("s", "$Count{section}-$Count{subsection}");
2240             }
2241             }
2242 183         165 my $id = $href;
2243 183         448 $id =~ s/.*#//;
2244 183         501 $id =~ s/\.x?html$//;
2245              
2246 183         277 my $title = escape_text(args_to_text(\@Arg));
2247 183 100       391 if (exists $Self->{loX}{toc}{$title}) {
2248 2         7 diag_error(
2249             "The title '$title' is used more than once as header. This will confuse cross-references."
2250             );
2251             }
2252 183         283 my $num = header_number($opts{nonum});
2253             $Self->{loX}{toc}{$title} = {
2254             href => $href,
2255             id => $id,
2256             href_prefix => "s",
2257             num => $num,
2258             count => $Count{header},
2259             nonum => $opts{nonum},
2260 183         736 };
2261              
2262 183 100       398 if ($macro =~ /^(?:Pt|Ch)$/) {
2263 99         298 push @{ $loXstack{nav} },
2264             {
2265             href => $href,
2266             id => $id,
2267             href_prefix => "s",
2268             macro => $macro,
2269             count => $Count{header},
2270 99         70 };
2271             }
2272              
2273 183         910 push @{ $loXstack{toc} },
2274             {
2275             macro => $macro,
2276             id => $id,
2277             href_prefix => "s",
2278             title => $title,
2279             href => $href,
2280             num => $num,
2281             nonum => $opts{nonum},
2282             count => $Count{header},
2283 183         144 };
2284             } # ]]]
2285              
2286             sub handle_header_macro_process { # [[[
2287 185 100   185 0 239 unless (@Arg) {
2288 2         7 diag_error("`.$State{macro}' macro requires at least one argument");
2289 2         4 return;
2290             }
2291 183         381 my %opts = parse_options(
2292             {
2293             nonum => "b",
2294             },
2295             );
2296 183         254 my $numbered = !$opts{nonum};
2297 183         296 my $title = escape_text(args_to_text(\@Arg));
2298              
2299 183         268 close_unclosed_blocks("Bm");
2300 183         183 close_unclosed_blocks("Bl");
2301              
2302 183         192 close_eventual_final_paragraph();
2303              
2304 183         345 headers_count_update($opts{nonum});
2305 183 100       528 if ($State{macro} =~ /^(?:Pt|Ch)$/) {
2306 99         97 $State{nav_count}++;
2307 99 100 100     508 if ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/
2308             and not $Opts{all_in_one_file})
2309             {
2310 30         39 xhtml_file_output_change($title);
2311             }
2312             }
2313              
2314 183         204 my $toc = $Self->{loX}{toc};
2315              
2316             # opening
2317 183 100 66     631 if ($Opts{target_format} eq "latex") {
    100          
    50          
2318 56         91 my $type = latex_header_name($State{macro});
2319 56 100       68 if ($numbered) {
2320 54         67 print enclose_begin($type);
2321             }
2322             else {
2323 2         6 print enclose_begin($type . "*");
2324             }
2325             }
2326             elsif ($Opts{target_format} eq "xhtml" and $Opts{all_in_one_file}) {
2327             print enclose_begin(
2328             xhtml_section_header($State{macro}),
2329             {
2330             id => "s$toc->{$title}{count}",
2331             class => $State{macro},
2332             }
2333 67         110 );
2334             }
2335             elsif ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
2336 60         106 my $id = $toc->{$title}{id};
2337             print enclose_begin(
2338             xhtml_section_header($State{macro}),
2339             {
2340             id => $id,
2341             class => $State{macro},
2342             }
2343 60         80 );
2344             }
2345              
2346 183         229 my $num = "";
2347 183 100 100     824 if ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/ and not $opts{nonum}) {
2348 120         149 $num = $toc->{$title}{num};
2349 120 50       188 $num = "$num " if $num;
2350             }
2351 183         187 print $num;
2352              
2353 183         232 my $title_render = process_inline_macros();
2354 183         2573 print $title_render;
2355              
2356 183         225 close_unclosed_blocks("Bm");
2357              
2358             # closing
2359 183 100       696 if ($Opts{target_format} eq "latex") {
    50          
2360 56         71 my $type = latex_header_name($State{macro});
2361 56 100       66 if ($numbered) {
2362 54         107 print enclose_end($type), "\n";
2363             }
2364             else {
2365 2         5 print enclose_end($type . "*"), "\n";
2366             print "\\addcontentsline{toc}{"
2367             . latex_header_name($State{macro})
2368 2         4 . "}{$title_render}\n";
2369             }
2370 56         162 print "\\label{s:", $toc->{$title}{count}, "}\n";
2371             }
2372             elsif ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
2373 127         181 print enclose_end(xhtml_section_header($State{macro})), "\n";
2374             }
2375              
2376 183         190 $State{wants_space} = 0;
2377 183         406 $Scope{paragraph} = 0;
2378             } # ]]]
2379              
2380             sub handle_if_macro { # [[[
2381 54     54 0 82 scope_stack_push("#if");
2382 54 50       85 if ($Count{if_ignore}) {
2383 0         0 $Count{if_ignore}++;
2384 0         0 return;
2385             }
2386 54         88 my %opts = parse_options(
2387             {
2388             f => "s",
2389             }
2390             );
2391 54 100 100     155 unless (defined $opts{f} or @Arg) {
2392 8         11 diag_warning("useless `.#if' invocation");
2393 8         13 return;
2394             }
2395              
2396 46 100       66 if (defined $opts{f}) {
2397 26 50       162 unless ($opts{f} =~ /$Rx{valid_format}/) {
2398 0 0       0 diag_error("invalid ``format'' argument in `.#if' macro:$opts{f}")
2399             if $Process;
2400             }
2401 26 100       115 unless ($opts{f} =~ /$Rx{format}/) {
2402 12         14 $Count{if_ignore} = 1;
2403 12         24 return;
2404             }
2405             }
2406              
2407 34 100       55 if (@Arg) {
2408 24         24 my $bool = shift @Arg;
2409 24 50       26 if (@Arg) {
2410 0 0       0 diag_error("`.#if' invocation:too many arguments")
2411             if $Process;
2412             }
2413 24 100       42 unless ($bool) {
2414 6         11 $Count{if_ignore} = 1;
2415             }
2416             }
2417             } # ]]]
2418              
2419             sub handle_if_end_macro { # [[[
2420 50 100   50 0 70 $Count{if_ignore}-- if $Count{if_ignore};
2421 50 100       31 if (@{ $Scope{'#if'} }) {
  50         67  
2422 46         29 pop @{ $Scope{'#if'} };
  46         99  
2423             }
2424             else {
2425 4 100       10 diag_error("`.#;' invocation with no previous `.#if'")
2426             if $Process;
2427             }
2428             } # ]]]
2429              
2430             sub handle_user_macro { # [[[
2431 180     180 0 148 my $macro = $State{macro};
2432 180         180 my $perl = $Macro{$macro}{perl};
2433 180         119 my @processed_parse;
2434              
2435 180 100       221 unless ($perl) {
2436 94         88 my $parse = $Macro{$macro}{parse};
2437 94 100       117 unless (@$parse) {
2438 18         27 return;
2439             }
2440              
2441 76         78 foreach my $block (@$parse) {
2442 90         57 my $remaining = 0;
2443 90 100       136 if (@$block == 2) {
    50          
2444 38         32 my $t = $block->[0];
2445 38         101 $t =~ s{\\+\$(\d+)}{
2446 24 100 33     113 defined $Arg[$1-1] ? $Arg[$1-1] : (++$remaining and "\\\$$1");
2447             }xge;
2448 38         67 push @processed_parse, [ $t, $block->[1] ];
2449             }
2450             elsif (@$block == 3) {
2451 52         47 my $macro_name = $block->[0];
2452 52         32 my @macro_args = @{ $block->[1] };
  52         83  
2453             s{\\+\$(\d+)}{
2454 24 50 0     98 defined $Arg[$1-1] ? $Arg[$1-1] : (++$remaining and "\\\$$1");
2455 52         174 }xge for @macro_args;
2456 52         46 $macro_name =~ s{\\+\$(\d+)}{
2457 0 0 0     0 defined $Arg[$1-1] ? $Arg[$1-1] : (++$remaining and "\\\$$1");
2458             }xge;
2459 52         78 push @processed_parse,
2460             [ $macro_name, \@macro_args, $block->[2] ];
2461 52         40 my $remaining;
2462              
2463 52         49 foreach (@macro_args) {
2464 202 50 0     268 $remaining++ and last if /\\+\$\d/;
2465             }
2466             }
2467 90 100       161 diag_error("`$macro' invocation:not enough arguments provided")
2468             if $remaining;
2469             }
2470             }
2471              
2472             # Keep the line number of the call, the name of the macro, and the current
2473             # file name for better diags.
2474             # Don't permit recursive calls to erase this values as the first user macro
2475             # called is the one that is usefull in diagnostics.
2476 162 100       219 if ($UserMacroCall{depth} == 0) {
2477 154         147 $UserMacroCall{lnum} = $State{lnum};
2478 154         120 $UserMacroCall{name} = $macro;
2479 154         141 $UserMacroCall{file} = $File;
2480             }
2481 162         120 $UserMacroCall{depth}++;
2482 162 100       167 if ($perl) {
2483 86         71 $Flag{_perl} = 1;
2484 86         171 $Self->_call_perl_macro($macro);
2485 86         112 $Flag{_perl} = 0;
2486             }
2487             else {
2488 76 100       77 if ($Process) {
2489 38         48 process_source(\@processed_parse);
2490             }
2491             else {
2492 38         46 collect_source_infos(\@processed_parse);
2493             }
2494             }
2495 162         145 $UserMacroCall{depth}--;
2496 162 100       246 if ($UserMacroCall{depth} == 0) {
2497 154         135 $UserMacroCall{lnum} = undef;
2498 154         111 $UserMacroCall{name} = undef;
2499 154         284 $UserMacroCall{file} = undef;
2500             }
2501             } # ]]]
2502              
2503             ################################################################################
2504             # Utility functions, in alphabetic order.
2505              
2506             sub add_non_breaking_spaces { # [[[
2507 11     11 0 9 my $text = shift;
2508 11 100       17 if ($Flag{'fr-nbsp-auto'}) {
2509 8         90 $text =~ s/\h*(?:\\~)?(?
2510 8         28 $text =~ s/(\x{ab})(?!\\&)(?:\\~)?\h*/$1\\~/xg;
2511             }
2512 11         15 return $text;
2513             } # ]]]
2514              
2515             sub args_to_text { # [[[
2516 1018     1018 0 779 my $args = shift;
2517 1018 100       1230 my $sep = $Flag{ns} ? "" : " ";
2518 1018         1285 my $text = join($sep, @$args);
2519 1018         1467 return $text;
2520             } # ]]]
2521              
2522             sub call { # [[[
2523 12     12 0 17 my ($macro, @args) = @_;
2524 12         18 local $State{macro} = $macro;
2525 12         22 local @Arg = @args;
2526 12 100       20 if ($Process) {
2527 11         16 process_macro();
2528             }
2529             else {
2530 1         6 collect_macro_infos();
2531             }
2532             } # ]]]
2533              
2534             sub close_eventual_final_paragraph { # [[[
2535 434     434 0 317 my $last = shift;
2536 434 100       826 if ($Scope{paragraph}) {
    100          
2537 90         121 handle_paragraph_end($last);
2538             }
2539             elsif ($State{text}) {
2540 124         151 handle_paragraph($last);
2541             }
2542             } # ]]]
2543              
2544             sub close_spanning_blocks { # [[[
2545 275     275 0 206 my $stack = $Scope{Bm};
2546 275         172 for (my $i = $#{$stack}; $i >= 0; $i--) {
  275         631  
2547 10         7 my $st = $stack->[$i];
2548 10         9 my $begin_macro = $st->{macro};
2549              
2550 10         9 my $end;
2551 10 100       14 if (defined $st->{t}) {
2552 2         5 $end = enclose_end($Xmtag{ $st->{t} }{cmd});
2553             }
2554 10   66     28 $end //= enclose_end($Xmtag{_default}{cmd});
2555              
2556 10         23 print $end;
2557             }
2558             } # ]]]
2559              
2560             sub close_unclosed_blocks { # [[[
2561 1179     1179 0 923 my $type = shift;
2562 1179 100       1179 if (test_for_unclosed_block($type)) {
2563 6         12 local @Arg = ();
2564 6         9 local $State{macro} = $type;
2565 6         7 local $Flag{_no_warnings} = 1;
2566 6 100       15 if ($type eq "Bm") {
    50          
    50          
2567 4         4 handle_Em_macro while @{ $Scope{$type} };
  10         27  
2568             }
2569             elsif ($type eq "Bl") {
2570 0         0 handle_El_macro while @{ $Scope{$type} };
  0         0  
2571             }
2572             elsif ($type eq "Bd") {
2573 2         2 handle_Ed_macro while @{ $Scope{$type} };
  6         17  
2574             }
2575             }
2576             } # ]]]
2577              
2578             sub diag { # [[[
2579 149     149 0 119 my $message = shift;
2580 149 100       238 if (defined $UserMacroCall{lnum}) {
    50          
    0          
2581             return
2582 6         21 "frundis:$UserMacroCall{file}:$UserMacroCall{lnum}:in user macro `.$UserMacroCall{name}':$message\n";
2583             }
2584             elsif (defined $State{lnum}) {
2585 143         287 return "frundis:$File:$State{lnum}:$message\n";
2586             }
2587             elsif ($File) {
2588 0         0 return "frundis:$File:$message\n";
2589             }
2590             else {
2591 0         0 return "frundis:$message\n";
2592             }
2593             } # ]]]
2594              
2595             sub diag_error { # [[[
2596 120 50   120 0 171 return if $Flag{_no_warnings};
2597 120         105 my $message = shift;
2598 120         89 $Flag{_frundis_warning} = 1;
2599 120         226 $message = diag("error:$message");
2600 120 50       183 if ($Opts{use_carp}) {
2601 0         0 chomp $message;
2602 0         0 carp $message;
2603             }
2604             else {
2605 120         1343 warn $message;
2606             }
2607 120         169 $Flag{_frundis_warning} = 0;
2608             } # ]]]
2609              
2610             sub diag_fatal { # [[[
2611 0     0 0 0 my $message = shift;
2612 0         0 $message = diag("fatal:$message");
2613 0 0       0 if ($Opts{use_carp}) {
2614 0         0 chomp $message;
2615 0         0 croak $message;
2616             }
2617             else {
2618 0         0 die $message;
2619             }
2620             } # ]]]
2621              
2622             sub diag_warning { # [[[
2623 29 50   29 0 44 return if $Flag{_no_warnings};
2624 29         31 my $message = shift;
2625 29         25 $Flag{_frundis_warning} = 1;
2626 29         52 $message = diag("warning:$message");
2627 29 50       41 if ($Opts{use_carp}) {
2628 0         0 chomp $message;
2629 0         0 carp $message;
2630             }
2631             else {
2632 29         338 warn $message;
2633             }
2634 29         123 $Flag{_frundis_warning} = 0;
2635             } # ]]]
2636              
2637             sub enclose_begin { # [[[
2638 414     414 0 442 my ($elt, $opts) = @_;
2639 414 100       502 unless ($elt) {
2640 4         8 return "";
2641             }
2642 410 100       446 if (defined $opts) {
2643 346 50       539 diag_fatal(
2644             'internal error: enclose_begin: $opts is not a hash reference')
2645             unless ref $opts eq "HASH";
2646             }
2647             else {
2648 64         59 $opts = {};
2649             }
2650 410 100       1352 if ($Opts{target_format} eq "latex") {
    50          
2651 157 100       554 return $opts->{env} ? "\\begin{$elt}" : "\\$elt\{";
2652             }
2653             elsif ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
2654 253         231 my $attributes = "";
2655 253 100       332 if ($opts->{class}) {
2656 146         236 $attributes .= qq{ class="$opts->{class}"};
2657             }
2658 253 100       363 if ($opts->{id}) {
2659 137         187 $attributes .= qq{ id="$opts->{id}"};
2660             }
2661 253         696 return "<${elt}${attributes}>";
2662             }
2663             } # ]]]
2664              
2665             sub enclose_end { # [[[
2666 414     414 0 391 my ($elt, $opts) = @_;
2667 414 100       518 unless ($elt) {
2668 4         7 return "";
2669             }
2670 410 100       446 if (defined $opts) {
2671 84 50       146 diag_fatal('internal error: enclose_end: $opts is not a hash reference')
2672             unless ref $opts eq "HASH";
2673             }
2674             else {
2675 326         305 $opts = {};
2676             }
2677 410 100       1210 if ($Opts{target_format} eq "latex") {
    50          
2678 157 100       414 return $opts->{env} ? "\\end{$elt}" : '}';
2679             }
2680             elsif ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
2681 253         624 return "";
2682             }
2683             } # ]]]
2684              
2685             sub end_any_previous_item { # [[[
2686 51 100   51 0 116 if ($State{text}) {
2687 22         26 chomp $State{text};
2688 22         24 give_wanted_space();
2689 22         25 flush_normal_text();
2690             }
2691             } # ]]]
2692              
2693             sub escape { # [[[
2694 1010     1010 0 745 my $text = shift;
2695 1010         801 $text =~ s/(\\&|\\e|\\~)/$Frundis_escapes{$1}/gex;
  8         17  
2696 1010         1070 return $text;
2697             } # ]]]
2698              
2699             sub escape_latex_percent { # [[[
2700 21     21 0 22 my $text = shift;
2701              
2702             # for url and path arguments
2703 21         124 $text =~ s/%/\\%/g;
2704 21         68 return $text;
2705             } # ]]]
2706              
2707             sub escape_latex_text { # [[[
2708 692     692 0 482 my $text = shift;
2709              
2710 692         944 $text =~ s/(\{|\}|\[|\]|%|&|\$|\#|_|\\|\^|~)/$Latex_escapes{$1}/gex;
  48         114  
2711 692         798 $text =~ tr/\x{a0}/~/;
2712              
2713 692         759 return $text;
2714             } # ]]]
2715              
2716             sub escape_text { # [[[
2717 1872     1872 0 1282 my $text = shift;
2718 1872 100 100     3256 if ($Param{lang} eq "fr" and not $Flag{_verbatim}) {
2719 11         14 $text = add_non_breaking_spaces($text);
2720             }
2721 1872         1930 $text =~ s/(\\&|\\e|\\~)/$Frundis_escapes{$1}/gex;
  130         287  
2722 1872 100       5703 if ($Opts{target_format} eq "latex") {
    50          
2723 692         676 $text = escape_latex_text($text);
2724             }
2725             elsif ($Opts{target_format} =~ /$Rx{xhtml_or_epub}/) {
2726 1180         1276 $text = escape_xhtml_text($text);
2727             }
2728 1872         2549 return $text;
2729             } # ]]]
2730              
2731             sub escape_verbatim { # [[[
2732 179     179 0 153 my $text = shift;
2733 179         396 $text =~ s/(\\&|\\e|\\~)/$Frundis_escapes{$1}/gex;
  135         299  
2734 179 100       424 $text =~ tr/\x{a0}/ / if $Opts{target_format} eq "latex";
2735 179         320 return $text;
2736             } # ]]]
2737              
2738             sub escape_xhtml_text { # [[[
2739 1225     1225 0 940 my $text = shift;
2740              
2741 1225         1724 $text =~ s/(&|<|>|"|')/$Xhtml_escapes{$1}/gex;
  54         151  
2742              
2743 1225         1367 return $text;
2744             } # ]]]
2745              
2746             sub flush_normal_text { # [[[
2747 773     773 0 810 $State{text} =~ s/\n\s*\n/\n/g;
2748 773         868 print $State{text};
2749 773         545 $State{wanted_space} = 0;
2750 773         702 $State{text} = "";
2751             } # ]]]
2752              
2753             sub get_close_delim { # [[[
2754 115     115 0 99 my $close_delim = "";
2755 115 100 100     710 if ( @Arg
      100        
2756 3     3   23 and $Arg[$#Arg] =~ /^(?:\\~)?\p{Punct}+$/
  3         16  
  3         40  
2757             and $Arg[$#Arg] !~ /^\\&/)
2758             {
2759 33         34 $close_delim = pop @Arg;
2760 33 50       62 if ($Param{lang} eq "fr") {
2761 0         0 $close_delim = add_non_breaking_spaces($close_delim);
2762             }
2763 33         35 $close_delim = escape_text($close_delim);
2764             }
2765 115         318 return $close_delim;
2766             } # ]]]
2767              
2768             sub give_wanted_space { # [[[
2769 767 100   767 0 1163 print "\n" if $State{wanted_space};
2770             } # ]]]
2771              
2772             sub handle_paragraph { # [[[
2773 161     161 0 134 my $last = shift;
2774 161         168 paragraph_begin();
2775 161         196 handle_paragraph_end($last);
2776             } # ]]]
2777              
2778             sub handle_paragraph_begin { # [[[
2779 87 50   87 0 138 unless ($Scope{paragraph}) {
2780 87         99 paragraph_begin();
2781             }
2782 87         114 give_wanted_space();
2783 87         140 flush_normal_text();
2784             } # ]]]
2785              
2786             sub handle_paragraph_end { # [[[
2787 275     275 0 216 my $last = shift;
2788 275         294 paragraph_end();
2789 275 100 100     656 if ($Opts{target_format} eq "latex" and not $last) {
2790 87         89 print "\n";
2791             }
2792 275         318 $Scope{paragraph} = 0;
2793             } # ]]]
2794              
2795             sub headers_count_update { # [[[
2796 366     366 0 429 my $nonum = shift;
2797 366         325 my $macro = $State{macro};
2798 366 100       755 if ($macro eq "Pt") {
    100          
    100          
    50          
2799 48         46 $Count{part}++;
2800 48 50       70 $Count{numbered_part}++ unless $nonum;
2801 48         46 $Count{section} = 0;
2802 48         37 $Count{subsection} = 0;
2803 48         37 $Count{numbered_section} = 0;
2804 48         40 $Count{numbered_subsection} = 0;
2805             }
2806             elsif ($macro eq "Ch") {
2807 150         138 $Count{chapter}++;
2808 150 100       226 $Count{numbered_chapter}++ unless $nonum;
2809 150         133 $Count{section} = 0;
2810 150         144 $Count{subsection} = 0;
2811 150         110 $Count{numbered_section} = 0;
2812 150         144 $Count{numbered_subsection} = 0;
2813             }
2814             elsif ($macro eq "Sh") {
2815 112         105 $Count{section}++;
2816 112 100       166 $Count{numbered_section}++ unless $nonum;
2817 112         86 $Count{numbered_subsection} = 0;
2818 112         90 $Count{subsection} = 0;
2819             }
2820             elsif ($macro eq "Ss") {
2821 56         53 $Count{subsection}++;
2822 56 50       92 $Count{numbered_subsection}++ unless $nonum;
2823             }
2824 366         721 $Count{header}++;
2825             } # ]]]
2826              
2827             sub header_level { # [[[
2828 435     435 0 301 my $header_macro = shift;
2829 435         274 my $level = -1;
2830 435 100       556 if ($InfosFlag{has_part}) {
    100          
2831 341         244 $level = 1;
2832             }
2833             elsif ($InfosFlag{has_chapter}) {
2834 86         72 $level = 0;
2835             }
2836             return
2837 435 100       1418 $header_macro eq "Pt" ? $level
    100          
    100          
2838             : $header_macro eq "Ch" ? $level + 1
2839             : $header_macro eq "Sh" ? $level + 2
2840             : $level + 3;
2841             } # ]]]
2842              
2843             sub header_number { # [[[
2844 183     183 0 196 my $nonum = shift;
2845 183 100       234 return "" if $nonum;
2846 174         138 my $macro = $State{macro};
2847 174         113 my $num;
2848 174 100       339 if ($macro eq "Pt") {
    100          
    100          
    50          
2849 24         29 $num = "$Count{numbered_part}";
2850             }
2851             elsif ($macro eq "Ch") {
2852 73         82 $num = "$Count{numbered_chapter}";
2853             }
2854             elsif ($macro eq "Sh") {
2855 49 100       64 if ($InfosFlag{has_chapter}) {
2856 43         72 $num = "$Count{numbered_chapter}.$Count{numbered_section}";
2857             }
2858             else {
2859 6         9 $num = "$Count{numbered_section}";
2860             }
2861             }
2862             elsif ($macro eq "Ss") {
2863 28 100       37 if ($InfosFlag{has_chapter}) {
    50          
2864 26         61 $num =
2865             "$Count{numbered_chapter}.$Count{numbered_section}.$Count{numbered_subsection}";
2866             }
2867             elsif ($Count{numbered_section}) {
2868 2         5 $num = "$Count{numbered_section}.$Count{numbered_subsection}";
2869             }
2870             else {
2871 0         0 $num = "0.$Count{numbered_subsection}";
2872             }
2873             }
2874 174         201 return $num;
2875             } # ]]]
2876              
2877             sub init_infos { # [[[
2878 60 100 66 60 0 198 if ($Opts{target_format} eq "latex") {
    50          
2879 27         327 %Param = (
2880             'dmark' => '---',
2881             'nbsp' => '~',
2882             _desc_name_begin => '\item[',
2883             _desc_name_end => "]\n",
2884             _desc_value_begin => '',
2885             _desc_value_end => "\n",
2886             _item_begin => '\item ',
2887             _item_end => "\n",
2888             _line_break => " \\\\\n",
2889             _list_desc => 'description',
2890             _list_enum => 'enumerate',
2891             _list_item => 'itemize',
2892             _list_table => 'tabular',
2893             _paragraph_begin => "",
2894             _paragraph_end => "\n",
2895             _poemtitle => 'poemtitle',
2896             _table_cell_begin => " & ",
2897             _table_cell_end => "",
2898             _table_row_begin => "",
2899             _table_row_end => " \\\\\n",
2900             _verse => 'verse',
2901             );
2902 27         69 %Xmtag = (_default => { cmd => 'emph' });
2903 27         70 %Xdtag = (_default => { cmd => '' });
2904             }
2905             elsif ($Opts{target_format} eq "xhtml" or $Opts{target_format} eq "epub") {
2906 33         437 %Param = (
2907             'dmark' => "\x{2014}",
2908             'nbsp' => "\x{a0}",
2909             'xhtml-index' => "full",
2910             'xhtml5' => "0",
2911             _desc_name_begin => '
',
2912             _desc_name_end => "\n",
2913             _desc_value_begin => '
',
2914             _desc_value_end => "\n",
2915             _item_begin => '
  • ',
  • 2916             _item_end => "\n",
    2917             _line_break => "
    \n",
    2918             _list_desc => 'dl',
    2919             _list_enum => 'ol',
    2920             _list_item => 'ul',
    2921             _list_table => 'table',
    2922             _paragraph_begin => "

    ",

    2923             _paragraph_end => "

    \n",
    2924             _poemtitle => "h4",
    2925             _table_cell_begin => "",
    2926             _table_cell_end => "
    2927             _table_row_begin => "
    2928             _table_row_end => "
    2929             _verse => '',
    2930             );
    2931 33         91 %Xmtag = (_default => { cmd => 'em' });
    2932 33         74 %Xdtag = (_default => { cmd => 'div' });
    2933             }
    2934              
    2935 60 100       110 if ($Opts{target_format} eq "epub") {
    2936 3         6 $Param{'epub-version'} = "2";
    2937             }
    2938             %loXstack = (
    2939 60         377 toc => [],
    2940             nav => [],
    2941             lot => [],
    2942             lof => [],
    2943             );
    2944 60         267 %InfosFlag = (
    2945             use_verse => 0,
    2946             use_minitoc => 0,
    2947             has_part => 0,
    2948             has_chapter => 0,
    2949             use_graphicx => 0,
    2950             dominilof => 0,
    2951             dominilot => 0,
    2952             dominitoc => 0,
    2953             );
    2954 60         70 $Param{lang} = "en";
    2955 60         70 $Param{_index} = "Index";
    2956 60 100       115 %Filters = defined $Opts{filters} ? %{ $Opts{filters} } : ();
      1         2  
    2957 60         59 %ID = ();
    2958 60         76 @Image = ();
    2959             } # ]]]
    2960              
    2961             sub init_state { # [[[
    2962 120     120 0 450 %State = (
    2963             lnum => undef, # current line number
    2964             macro => undef, # current macro name
    2965             text => "", # accumulated text
    2966             _table_title => undef,
    2967             _xhtml_navigation_text => "",
    2968             );
    2969 120         423 %Flag = (
    2970             'fr-nbsp-auto' => 1, # automatically add nbsps
    2971             _ignore_text => 0, # whether to ignore text lines
    2972             _frundis_warning => 0,
    2973             _no_warnings => 0,
    2974             ns => 0, # no-space mode
    2975             _perl => 0,
    2976             _verbatim => 0, # verbatim mode
    2977             );
    2978 120         485 %Scope = (
    2979             Bd => [], # list of nested .Bd macros
    2980             Bl => [], # list of nested .Bl macros
    2981             Bm => [], # list of nested .Bm macros
    2982             "#if" => [], # list of nested .#if macros
    2983             de => 0, # in macro definition
    2984             if_ignore => 0,
    2985             item => 0, # under a non closed
    2986             paragraph => 0, # under a non closed

    2987             );
    2988 120         237 reset_Bf_macro_state();
    2989 120         185 reset_de_macro_state();
    2990 120         235 %UserMacroCall = (
    2991             depth => 0,
    2992             file => undef,
    2993             lnum => undef,
    2994             name => undef,
    2995             );
    2996 120         465 %Count = (
    2997             chapter => 0,
    2998             fig => 0,
    2999             header => 0,
    3000             numbered_chapter => 0,
    3001             numbered_part => 0,
    3002             numbered_section => 0,
    3003             numbered_subsection => 0,
    3004             part => 0,
    3005             section => 0,
    3006             subsection => 0,
    3007             table => 0,
    3008             );
    3009 120 100       706 %Macro = defined $Opts{user_macros} ? %{ $Opts{user_macros} } : ();
      2         6  
    3010 120         193 $Self->{vars} = {};
    3011             } # ]]]
    3012              
    3013             sub interpolate_vars { # [[[
    3014 6023     6023 0 4283 my $text = shift;
    3015 6023         4320 my $vars = $Self->{vars};
    3016 6023         4960 $text =~ s|\\\*\[([^\]]*)\]|
    3017 22         27 my $name = $1;
    3018 22         26 my $repl = $vars->{$name};
    3019 22 100       30 if (defined $repl) { $repl }
      20         38  
    3020             else {
    3021 2         6 diag_warning("variable interpolation:undefined variable:$name");
    3022 2         4 "";
    3023             }
    3024             |gex;
    3025 6023         8395 return $text;
    3026             } # ]]]
    3027              
    3028             sub loX_entry_infos { # [[[
    3029 46     46 0 44 my $opts = shift;
    3030 46         46 my $title = $opts->{title};
    3031 46         42 my $count = $opts->{count};
    3032 46         39 my $class = $opts->{class};
    3033 46         39 my $prefix = $opts->{href_prefix};
    3034 46         61 my $href = xhtml_gen_href($prefix, $count);
    3035 46         150 $Self->{loX}{$class}{$title} = {
    3036             href => $href,
    3037             href_prefix => $prefix,
    3038             count => $count,
    3039             };
    3040 46 100       88 unless (defined $loXstack{$class}) {
    3041 6         11 $loXstack{$class} = [];
    3042             }
    3043              
    3044 46         31 push @{ $loXstack{$class} },
      46         281  
    3045             {
    3046             href_prefix => $prefix,
    3047             href => $href,
    3048             count => $count,
    3049             title => $title,
    3050             };
    3051             } # ]]]
    3052              
    3053             sub phrasing_macro_begin { # [[[
    3054 287     287 0 372 my $ns = shift;
    3055 287         354 chomp $State{text};
    3056 287 100 100     1323 if (!$Flag{ns} and !$ns and ($State{wants_space} or $State{text})) {
          66        
          66        
    3057 225 100       413 $State{text} .= $State{inline} ? " " : "\n";
    3058             }
    3059 287         348 phrasing_macro_handle_whitespace();
    3060             } # ]]]
    3061              
    3062             sub phrasing_macro_end { # [[[
    3063 44     44 0 47 chomp $State{text};
    3064 44         47 phrasing_macro_handle_whitespace();
    3065             } # ]]]
    3066              
    3067             sub phrasing_macro_handle_whitespace { # [[[
    3068 331 100 100 331 0 891 if (!$Scope{paragraph} and !$Scope{item} and !$State{inline}) {
    3069 87         123 handle_paragraph_begin();
    3070             }
    3071             else {
    3072 244         273 give_wanted_space();
    3073 244         243 flush_normal_text();
    3074             }
    3075 331         738 $State{wants_space} = !$Flag{ns};
    3076             } # ]]]
    3077              
    3078             sub paragraph_begin { # [[[
    3079 252     252 0 639 print $Param{_paragraph_begin};
    3080 252         329 reopen_spanning_blocks();
    3081 252         244 $Scope{paragraph} = 1;
    3082             } # ]]]
    3083              
    3084             sub paragraph_end { # [[[
    3085 275     275 0 332 chomp $State{text};
    3086 275         304 give_wanted_space();
    3087 275         293 flush_normal_text();
    3088 275         306 close_spanning_blocks();
    3089 275         332 print $Param{_paragraph_end};
    3090             } # ]]]
    3091              
    3092             sub parse_options { # [[[
    3093 1616     1616 0 1358 my ($spec, $cmd) = @_;
    3094 1616   66     3586 $cmd //= $State{macro};
    3095 1616         1153 my %opts;
    3096 1616         2166 while (@Arg) {
    3097 2131         1910 my $flag = $Arg[0];
    3098 2131 100       4785 last unless ($flag =~ s/^-//);
    3099 987         1262 $flag = escape($flag);
    3100 987         770 shift @Arg;
    3101 987 100       1614 unless ($spec->{$flag}) {
    3102              
    3103 4         12 diag_error("`$cmd' macro invocation: unrecognized option: -$flag");
    3104 4         9 next;
    3105             }
    3106 983 100       1616 if ($spec->{$flag} eq "s") {
        50          
    3107              
    3108             # string argument
    3109 724 100       879 unless (@Arg) {
    3110 4         13 diag_error(
    3111             "`$cmd' macro invocation: option -$flag requires an argument"
    3112             );
    3113 4         9 next;
    3114             }
    3115 720         531 my $arg = shift(@Arg);
    3116 720 50 33     2197 if (defined $arg and $arg !~ /^-/) {
    3117 720         1612 $opts{$flag} = $arg;
    3118             }
    3119             }
    3120             elsif ($spec->{$flag} eq "b") {
    3121              
    3122             # boolean flag
    3123 259         531 $opts{$flag} = 1;
    3124             }
    3125             }
    3126 1616         3426 return %opts;
    3127             } # ]]]
    3128              
    3129             sub parse_macro_line { # [[[
    3130 1621     1621 0 1169 my $text = shift;
    3131 1621         1037 my $macro;
    3132 1621 50       3774 if ($text =~ s/^(\S+)//) {
    3133 1621         1689 $macro = $1;
    3134             }
    3135             else {
    3136 0         0 return ();
    3137             }
    3138 1621         1209 my @args;
    3139 1621         2933 while (
    3140             $text =~ /
    3141             \s*
    3142             (?|
    3143             "( (?| [^"] | "" )* ) "? # quoted string: "" is preserved inside
    3144             |
    3145             (\S+) # unquoted string
    3146             )
    3147             /xg
    3148             )
    3149             {
    3150 2709         2276 my $arg = $1;
    3151 2709         1905 $arg =~ s/""/"/g;
    3152 2709         5306 push @args, $arg;
    3153             }
    3154 1621         2295 return $macro, \@args;
    3155             } # ]]]
    3156              
    3157             sub print_file { # [[[
    3158 33     33 0 43 my ($file, $msg) = @_;
    3159 33 50       353 unless (-f $file) {
    3160 0         0 $file = search_inc_file($file);
    3161             }
    3162 33   100     48 $msg //= "";
    3163 33 50       699 open(my $fh, '<', $file)
    3164             or diag_fatal("$msg:$file:$!");
    3165 33         35 my $text;
    3166 33         21 { local $/; $text = <$fh>; }
      33         95  
      33         374  
    3167 33         162 close $fh;
    3168 33         105 print $text;
    3169             } # ]]]
    3170              
    3171             sub print_filter { # [[[
    3172 6     6 0 7 my ($cmd, $text) = @_;
    3173 6         751 require File::Temp;
    3174              
    3175 6         11774 my $tmp = File::Temp->new(EXLOCK => 0);
    3176 6     1   2119 binmode($tmp, ':encoding(utf-8)');
      1         5  
      1         2  
      1         6  
    3177              
    3178 6         1053 print $tmp $text;
    3179 6         17 local $?;
    3180 6         25 my $filtered_text = qx#<$tmp $cmd#;
    3181 6 50       20633 if ($?) {
    3182 0         0 diag_warning(
    3183             "`$State{macro}' macro:error in command '<$tmp $cmd':status $?:$filtered_text"
    3184             );
    3185             }
    3186             else {
    3187 6         30 print $filtered_text;
    3188             }
    3189 6         183 close $tmp;
    3190             } # ]]]
    3191              
    3192             sub process_inline_macros { # [[[
    3193 283     283 0 241 my $title_render = "";
    3194 283         528 local @Arg = @Arg;
    3195             {
    3196 283         196 local *STDOUT;
      283         385  
    3197 283 50       1766 open(STDOUT, '>', \$title_render) or die "redirecting stdout:$!";
    3198              
    3199             # parse arguments
    3200 283         432 my @arglist = ([]);
    3201 283         461 while (@Arg) {
    3202 467         377 my $word = shift @Arg;
    3203 467 100       772 if ($word =~ /^(?:Bm|Em|Sm)$/) {
    3204 28         51 push @arglist, [$word];
    3205             }
    3206             else {
    3207 439         272 push @{ $arglist[$#arglist] }, $word;
      439         963  
    3208             }
    3209             }
    3210 283         399 local $State{wanted_space} = 0;
    3211 283         274 local $State{wants_space} = 0;
    3212 283         324 foreach my $args (@arglist) {
    3213 311 100       405 next unless @$args;
    3214 307 100       505 if ($args->[0] =~ /^(?:Bm|Em|Sm)$/) {
    3215 28         23 my $macro = shift @$args;
    3216 28         38 local $State{inline} = 1;
    3217 28         33 local $State{macro} = $macro;
    3218 28         50 local @Arg = @$args;
    3219 28         42 $BuiltinMacroHandler{$macro}->();
    3220             }
    3221             else {
    3222 279         349 print escape_text(args_to_text($args));
    3223 279         386 $State{wants_space} = 1;
    3224             }
    3225             }
    3226 283         778 close STDOUT;
    3227             }
    3228              
    3229 283         627 return Encode::decode_utf8($title_render);
    3230             } # ]]]
    3231              
    3232             sub reopen_spanning_blocks { # [[[
    3233 269     269 0 233 my $stack = $Scope{Bm};
    3234 269         433 foreach my $st (@$stack) {
    3235 10         10 my $begin_macro = $st->{macro};
    3236              
    3237 10         8 my $begin;
    3238 10 100       14 if (defined $st->{t}) {
    3239             $begin = enclose_begin(
    3240             $Xmtag{ $st->{t} }{cmd},
    3241             { class => $st->{t} }
    3242 2         7 );
    3243             }
    3244 10   66     28 $begin //= enclose_begin($Xmtag{_default}{cmd});
    3245              
    3246 10         15 print $begin;
    3247             }
    3248             } # ]]]
    3249              
    3250             sub reset_Bf_macro_state { # [[[
    3251 120     120 0 326 %BfMacro = (
    3252             begin_lnum => undef,
    3253             begin_file => undef,
    3254             in_macro => 0,
    3255             filter => undef,
    3256             );
    3257             } # ]]]
    3258              
    3259             sub reset_de_macro_state { # [[[
    3260 276     276 0 989 %DeMacro = (
    3261             text => "",
    3262             name => undef,
    3263             lnum => undef,
    3264             perl => 0,
    3265             ignore => 0,
    3266             file => undef,
    3267             );
    3268             } # ]]]
    3269              
    3270             sub scope_stack_push { # [[[
    3271 206     206 0 229 my ($type, $tag, $id) = @_;
    3272 206 50       294 $Scope{$type} = [] unless defined $Scope{$type};
    3273 206         1128 push @{ $Scope{$type} },
    3274             {
    3275             t => $tag,
    3276             id => $id,
    3277             macro => $State{macro},
    3278             lnum => $UserMacroCall{depth} > 0
    3279             ? $UserMacroCall{lnum}
    3280             : $State{lnum},
    3281             in_user_macro => $UserMacroCall{depth} > 0 ? 1 : 0,
    3282 206 100       145 file => $UserMacroCall{depth} > 0 ? $UserMacroCall{file} : $File,
        100          
        100          
    3283             };
    3284             } # ]]]
    3285              
    3286             sub search_inc_file { # [[[
    3287 0     0 0 0 my $file = shift;
    3288 0         0 foreach (@FrundisINC) {
    3289 0         0 my $fpath = catfile($_, $file);
    3290 0 0       0 if (-f $fpath) {
    3291 0         0 $file = $fpath;
    3292 0         0 last;
    3293             }
    3294             }
    3295 0         0 return $file;
    3296             } # ]]]
    3297              
    3298             sub slurp_file { # [[[
    3299 4     4 0 5 my ($file) = @_;
    3300 4 50       118 open(my $fh, '<', $file)
    3301             or diag_fatal("$file:$!");
    3302 4         6 my $text;
    3303 4         4 { local $/; $text = <$fh>; }
      4         13  
      4         63  
    3304 4         25 close $fh;
    3305 4         16 return $text;
    3306             } # ]]]
    3307              
    3308             sub test_for_unclosed_block { # [[[
    3309 1239     1239 0 933 my ($type) = @_;
    3310 1239         1032 my $stack = $Scope{$type};
    3311 1239 100       1483 if (@$stack) {
    3312 8         9 my $st = $stack->[ $#{$stack} ];
      8         11  
    3313 8         10 my $begin_macro = $st->{macro};
    3314 8         10 my $end_macro = $BlockEnd{$begin_macro};
    3315 8 50       15 my $Bfile = $File eq $st->{file} ? "" : " of file $st->{file}";
    3316             my $in_user_macro =
    3317 8 50       14 $st->{in_user_macro} ? " opened inside user macro" : "";
    3318 8 50       13 my $type = $st->{t} ? " of type $st->{t} " : "";
    3319              
    3320 8         6 my $macro = $State{macro};
    3321 8 100       17 $macro = "`.$macro' macro" if $macro ne "End Of File";
    3322             my $msg =
    3323             !$State{inline}
    3324 8 50       36 ? "found $macro while `.$begin_macro' macro${type}${in_user_macro} at line"
    3325             . " $st->{lnum}$Bfile isn't closed yet by a `.$end_macro'"
    3326             : "unclosed inline markup block${type}${in_user_macro}";
    3327 8         17 diag_error($msg);
    3328 8         17 return 1;
    3329             }
    3330 1231         1716 return 0;
    3331             } # ]]]
    3332              
    3333             sub test_for_unclosed_de { # [[[
    3334 60 100   60 0 97 if ($Scope{de}) {
    3335 2         8 diag_error("found End Of File while `.#de' macro at line"
    3336             . " $DeMacro{lnum} of file $DeMacro{file} isn't closed by a `.#.'"
    3337             );
    3338             }
    3339             } # ]]]
    3340              
    3341             sub test_for_unclosed_format_block { # [[[
    3342 1587 100   1587 0 1983 if ($Scope{format}) {
    3343             my $Bf_file =
    3344             $File eq $BfMacro{begin_file}
    3345 2 50       6 ? ""
    3346             : " of file $BfMacro{begin_file}";
    3347             my $in_user_macro =
    3348 2 50       5 $BfMacro{in_macro} ? " opened inside user macro" : "";
    3349 2         10 diag_error("`.$State{macro}' not allowed inside scope of "
    3350             . "`.Bf' macro$in_user_macro at line $BfMacro{begin_lnum}$Bf_file"
    3351             );
    3352 2         7 return 1;
    3353             }
    3354 1585         4576 return 0;
    3355             } # ]]]
    3356              
    3357             sub test_if_not_allowed_macro { # [[[
    3358 1556     1556 0 1148 my $macro = shift;
    3359 1556 100 100     3025 if ($macro !~ /^Ef$/ and test_for_unclosed_format_block()) {
        100 100        
        100 100        
          100        
    3360 2         5 return 1;
    3361             }
    3362             elsif ($Flag{_verbatim} and $macro !~ /^Ef|Ed$/) {
    3363 1         4 diag_error(
    3364             "`$macro' macro is not allowed inside `.Bf' or `.Bd -t literal' macro scope"
    3365             );
    3366 1         3 return 1;
    3367             }
    3368 1553         4328 elsif ( @{ $Scope{Bl} }
    3369             and $Scope{Bl}->[0]->{t} ne "verse"
    3370             and not $AllowedInBl{$macro})
    3371             {
    3372 2         8 diag_error(
    3373             "`.$macro' macro not allowed inside list of type ``$Scope{Bl}->[0]->{t}''"
    3374             );
    3375 2         6 return 1;
    3376             }
    3377 1551         3260 return 0;
    3378             } # ]]]
    3379              
    3380             ################################################################################
    3381             # Format specific functions, in alphabetic order.
    3382              
    3383             sub epub_copy_images { # [[[
    3384 3     3 0 15 my $images_dir = catdir($Opts{output_file}, "EPUB", "images");
    3385 3 50       38 unless (-d $images_dir) {
    3386             mkdir $images_dir
    3387             or diag_fatal("$images_dir:$!")
    3388 3 100 33     67 unless not @Image and not defined $Param{'epub-cover'};
          66        
    3389             }
    3390              
    3391 3         10 foreach my $image (@Image, $Param{'epub-cover'}) {
    3392 5 100       387 next unless $image;
    3393 4         137 my $image_name = basename($image);
    3394 4 50       46 unless (-f $image) {
    3395 0         0 $image = search_inc_file($image);
    3396             }
    3397 4 50       22 unless (-f $image) {
    3398 0         0 diag_fatal("image copy:$image:no such file");
    3399             }
    3400 4         16 my $new_image = catfile($images_dir, $image_name);
    3401 4 100       37 next if -f $new_image;
    3402 2 50       9 copy($image, $new_image)
    3403             or diag_fatal("image copy:$image to $new_image:$!");
    3404             }
    3405             } # ]]]
    3406              
    3407             sub epub_gen { # [[[
    3408 3 50   3 0 7 unless ($Param{'document-title'}) {
    3409 0         0 diag_error("EPUB requires document-title parameter to be set");
    3410             }
    3411 3   50     10 my $title = $Param{'document-title'} // "";
    3412 3         4 my $lang = $Param{lang};
    3413              
    3414 3         7 epub_gen_mimetype();
    3415              
    3416 3         7 epub_copy_images();
    3417              
    3418             # now 'epub-cover' is copied: preserve only the name
    3419 3         5 my $cover = $Param{'epub-cover'};
    3420 3 100       40 $cover = basename($cover) if $cover;
    3421              
    3422 3         7 epub_gen_container();
    3423              
    3424 3         9 epub_gen_content_opf($title, $lang, $cover);
    3425              
    3426 3 100       12 if ($Param{'epub-version'} =~ /^3/) {
    3427 1         3 epub_gen_nav($title);
    3428             }
    3429              
    3430 3         7 epub_gen_css();
    3431              
    3432 3         7 epub_gen_ncx($title);
    3433              
    3434 3 100       8 if ($cover) {
    3435 2         5 epub_gen_cover($title, $cover);
    3436             }
    3437              
    3438             } # ]]]
    3439              
    3440             sub epub_gen_container { # [[[
    3441             my $container_xml =
    3442 3     3 0 11 catfile($Opts{output_file}, "META-INF", "container.xml");
    3443 3 50       140 open(my $fh, '>', $container_xml)
    3444             or diag_fatal("$container_xml:$!");
    3445              
    3446 3         18 print $fh <
    3447            
    3448             EOS
    3449              
    3450 3         7 print $fh <
    3451            
    3452            
    3453            
    3454            
    3455            
    3456             EOS
    3457 3         61 close $fh;
    3458             } # ]]]
    3459              
    3460             sub epub_gen_content_opf { # [[[
    3461 3     3 0 5 my ($title, $lang, $cover) = @_;
    3462 3         14 my $content_opf = catfile($Opts{output_file}, 'EPUB', 'content.opf');
    3463 3         6 local *STDOUT;
    3464 3 50       123 open(STDOUT, '>', $content_opf) or diag_fatal($!);
    3465              
    3466             # EPUB/content.opf
    3467 3         10 print <
    3468            
    3469             EOS
    3470 3         3 my $deterministic;
    3471 3 50       17 if (defined $Param{'epub-uuid'}) {
    3472 3         4 $deterministic = 1;
    3473             }
    3474              
    3475 3 50       8 unless (defined $Param{'epub-uuid'}) {
    3476              
    3477 0         0 local $@;
    3478 0         0 eval 'require Data::UUID;';
    3479 0 0       0 if ($@) {
    3480 0         0 diag_warning(
    3481             "Data::UUID module not found, falling back to use system time as unique id for epub"
    3482             );
    3483 0         0 $Param{'epub-uuid'} = "epoch:" . time;
    3484             }
    3485             else {
    3486 0         0 my $ug = Data::UUID->new;
    3487 0         0 my $uuid = $ug->create();
    3488 0         0 $Param{'epub-uuid'} = "urn:uuid:" . $ug->to_string($uuid);
    3489             }
    3490             }
    3491 3         7 chomp $Param{'epub-uuid'};
    3492 3 100       11 print <
    3493            
    3494             EOS
    3495 3 100       13 print <
    3496            
    3497             EOS
    3498 3         14 print <
    3499            
    3500             xmlns:dcterms="http://purl.org/dc/terms/"
    3501             xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
    3502             xmlns:opf="http://www.idpf.org/2007/opf">
    3503             $Param{'epub-uuid'}
    3504             EOS
    3505 3         10 print <
    3506             $lang
    3507             $title
    3508             EOS
    3509 3 100       11 if ($Param{'epub-version'} =~ /^3/) {
    3510 1         418 require POSIX;
    3511 1         4280 my $time;
    3512 1 50       3 if ($deterministic) {
    3513 1         6 $time = "0001-01-01T01:01:01Z";
    3514             }
    3515             else {
    3516 0         0 $time = POSIX::strftime("%Y-%m-%dT%H:%M:%SZ", gmtime);
    3517             }
    3518 1 50       10 print <
    3519             $time
    3520             EOS
    3521             }
    3522 3 100       6 if ($Param{'epub-subject'}) {
    3523 2         7 print <
    3524             $Param{'epub-subject'}
    3525             EOS
    3526             }
    3527 3 100       7 if ($Param{'document-author'}) {
    3528 2         6 print <
    3529             $Param{'document-author'}
    3530             EOS
    3531             }
    3532 3 100 100     16 print <
    3533            
    3534             EOS
    3535 3 100       5 if ($Param{'epub-metadata'}) {
    3536 2         5 print_file($Param{'epub-metadata'}, "epub-metadata");
    3537             }
    3538 3         5 print <
    3539            
    3540            
    3541             EOS
    3542 3 100       11 print <
    3543            
    3544             href="nav.xhtml"
    3545             properties="nav"
    3546             media-type="application/xhtml+xml" />
    3547             EOS
    3548 3         5 print <
    3549            
    3550             href="toc.ncx"
    3551             media-type="application/x-dtbncx+xml" />
    3552             EOS
    3553              
    3554 3 100       5 if ($cover) {
    3555 2         10 my $cover_path = catfile('images', $cover);
    3556 2         6 print <
    3557            
    3558             href="$cover_path"
    3559             EOS
    3560             }
    3561 3 100 100     15 print <
    3562             properties="cover-image"
    3563             EOS
    3564 3 100       7 print <
    3565             media-type="image/jpeg" />
    3566             EOS
    3567 3 100       6 print <
    3568            
    3569             href="cover.xhtml"
    3570             media-type="application/xhtml+xml" />
    3571             EOS
    3572              
    3573 3         5 print <
    3574            
    3575             EOS
    3576 3         3 foreach (@{ $loXstack{toc} }) {
      3         7  
    3577 30 100       60 next unless $_->{macro} =~ /^(?:Pt|Ch)$/;
    3578 15         12 my $href = $_->{href};
    3579 15         14 my $id = $_->{id};
    3580 15         25 print <
    3581            
    3582             EOS
    3583             }
    3584 3         5 print <
    3585            
    3586             href="stylesheet.css"
    3587             media-type="text/css" />
    3588             EOS
    3589 3         7 foreach my $image_name (@Image) {
    3590 2         1 my $media_type;
    3591 2 50       9 if ($image_name =~ /\.png$/) {
        0          
        0          
        0          
    3592 2         4 $media_type = "image/png";
    3593             }
    3594             elsif ($image_name =~ /\.jpe?g$/) {
    3595 0         0 $media_type = "image/jpeg";
    3596             }
    3597             elsif ($image_name =~ /\.gif$/) {
    3598 0         0 $media_type = "image/gif";
    3599             }
    3600             elsif ($image_name =~ /\.svg$/) {
    3601 0         0 $media_type = "image/svg";
    3602             }
    3603 2         47 my $image_bname = basename($image_name);
    3604 2         8 my $image_path = catfile('images', $image_bname);
    3605 2         4 $image_bname = escape_xhtml_text($image_bname);
    3606 2         4 $image_path = escape_xhtml_text($image_path);
    3607 2         11 print <
    3608            
    3609             href="$image_path"
    3610             media-type="$media_type" />
    3611             EOS
    3612             }
    3613              
    3614 3         5 print <
    3615            
    3616            
    3617             EOS
    3618 3 100       6 print <
    3619            
    3620             EOS
    3621 3         4 print <
    3622            
    3623             EOS
    3624 3         3 foreach (@{ $loXstack{toc} }) {
      3         6  
    3625 30 100       51 next unless $_->{macro} =~ /^(?:Pt|Ch)$/;
    3626 15         12 my $name = $_->{id};
    3627 15         19 print <
    3628            
    3629             EOS
    3630             }
    3631 3 100       10 print <
    3632            
    3633             EOS
    3634 3         4 print <
    3635            
    3636            
    3637             EOS
    3638 3 100       6 print <
    3639            
    3640             EOS
    3641 3         4 print <
    3642            
    3643             EOS
    3644 3         75 print <
    3645            
    3646             EOS
    3647             } # ]]]
    3648              
    3649             sub epub_gen_cover { # [[[
    3650 2     2 0 3 my ($title, $cover) = @_;
    3651 2         18 my $cover_xhtml = catfile($Opts{output_file}, 'EPUB', 'cover.xhtml');
    3652 2         5 local *STDOUT;
    3653 2 50       85 open(STDOUT, '>', $cover_xhtml) or diag_fatal("$cover_xhtml:$!");
    3654 2         11 print <
    3655            
    3656             EOS
    3657 2         5 xhtml_and_epub_common_header();
    3658 2         53 print <
    3659             $title
    3660            
    3661            
    3662            
    3663            
    3664             cover image
    3665            
    3666            
    3667            
    3668             EOS
    3669              
    3670             } # ]]]
    3671              
    3672             sub epub_gen_css { # [[[
    3673 3     3 0 5 my $css_text = "";
    3674 3 100       7 if ($Param{'epub-css'}) {
    3675 2 50       23 unless (-f $Param{'epub-css'}) {
    3676 0         0 $Param{'epub-css'} = search_inc_file($Param{'epub-css'});
    3677             }
    3678 2 50       42 open(my $fh, '<', "$Param{'epub-css'}")
    3679             or diag_fatal("parameter epub-css:$Param{'epub-css'}:$!");
    3680 2         7 local $/;
    3681 2         23 $css_text = <$fh>;
    3682 2         13 close $fh;
    3683             }
    3684 3         16 my $stylesheet_css = catfile($Opts{output_file}, 'EPUB', 'stylesheet.css');
    3685 3 50       135 open(my $fh, '>', $stylesheet_css)
    3686             or diag_fatal("$stylesheet_css:$!");
    3687              
    3688             # EPUB/stylesheet.css
    3689 3         7 print $fh $css_text;
    3690 3         16 close $fh;
    3691             } # ]]]
    3692              
    3693             sub epub_gen_mimetype { # [[[
    3694 3     3 0 4 my $mimetype = "application/epub+zip";
    3695 3         12 my $mimetype_path = catfile($Opts{output_file}, 'mimetype');
    3696 3 50       150 open(my $fh, '>', $mimetype_path)
    3697             or diag_fatal("$mimetype_path:$!");
    3698 3         30 print $fh $mimetype;
    3699 3         99 close $fh;
    3700             } # ]]]
    3701              
    3702             sub epub_gen_nav { # [[[
    3703 1     1 0 1 my $title = shift;
    3704 1         5 my $nav_xhtml = catfile($Opts{output_file}, 'EPUB', 'nav.xhtml');
    3705 1         2 local *STDOUT;
    3706 1 50       55 open(STDOUT, '>', $nav_xhtml)
    3707             or diag_fatal("$nav_xhtml:$!");
    3708 1         7 print <
    3709            
    3710            
    3711            
    3712             xmlns:epub="http://www.idpf.org/2007/ops">
    3713            
    3714            
    3715             EOS
    3716 1 50       5 print <
    3717             $title
    3718            
    3719            
    3720            
    3721             EOS
    3722 1         2 print <
    3723              
    3724             EOS
    3725              
    3726 1         3 xhtml_toc("nav");
    3727             print_file($Param{'epub-nav-landmarks'})
    3728 1 50       3 if $Param{'epub-nav-landmarks'};
    3729              
    3730 1         25 print <
    3731            
    3732            
    3733             EOS
    3734             } # ]]]
    3735              
    3736             sub epub_gen_ncx { # [[[
    3737 3     3 0 7 my ($title) = @_;
    3738 3         13 my $toc_ncx = catfile($Opts{output_file}, 'EPUB', 'toc.ncx');
    3739 3         4 local *STDOUT;
    3740 3 50       146 open(STDOUT, '>', $toc_ncx)
    3741             or diag_fatal("$toc_ncx:$!");
    3742              
    3743 3         26 print <
    3744            
    3745            
    3746            
    3747            
    3748            
    3749            
    3750            
    3751            
    3752            
    3753             EOS
    3754 3 50       12 print <
    3755            
    3756             $title
    3757            
    3758             EOS
    3759 3         8 xhtml_toc("ncx");
    3760 3         68 print <
    3761            
    3762             EOS
    3763             } # ]]]
    3764              
    3765             sub latex_document_begin { # [[[
    3766 2     2 0 5 my $lang = $Param{lang};
    3767 2   50     8 my $lang_babel = $Lang_babel{$lang} // "english";
    3768 2   50     5 my $lang_mini = $Lang_mini{$lang} // "english";
    3769              
    3770 2   50     6 my $title = $Param{'document-title'} // "";
    3771 2   100     6 my $author = $Param{'document-author'} // "";
    3772 2   100     7 my $date = $Param{'document-date'} // "";
    3773 2 100       4 if ($Param{'latex-preamble'}) {
    3774 1         3 print_file($Param{'latex-preamble'}, "latex-preamble");
    3775             }
    3776             else {
    3777 1 50 33     4 if ($InfosFlag{has_chapter} or $InfosFlag{has_part}) {
    3778 1         5 print <
    3779             \\documentclass[a4paper,11pt]{book}
    3780             EOS
    3781             }
    3782             else {
    3783 0         0 print <
    3784             \\documentclass[a4paper,11pt]{article}
    3785             EOS
    3786             }
    3787 1         3 print <
    3788             \\usepackage[T1]{fontenc}
    3789             \\usepackage[utf8]{inputenc}
    3790             \\usepackage[$lang_babel]{babel}
    3791             EOS
    3792 1 50       3 print <
    3793             \\usepackage[$lang_mini]{minitoc}
    3794             EOS
    3795 1 50       3 print <
    3796             \\usepackage{verse}
    3797             EOS
    3798 1 50       2 print <
    3799             \\usepackage{graphicx}
    3800             EOS
    3801 1         5 print <
    3802             \\usepackage{verbatim}
    3803             \\usepackage[linkcolor=blue,colorlinks=true]{hyperref}
    3804              
    3805             \\title{$title}
    3806             \\author{$author}
    3807             \\date{$date}
    3808             EOS
    3809             }
    3810              
    3811 2         3 print "\\begin{document}\n";
    3812              
    3813 2 50       7 print "\\dominilof\n" if $InfosFlag{dominilof};
    3814 2 50       5 print "\\dominilot\n" if $InfosFlag{dominilot};
    3815 2 50       3 print "\\dominitoc\n" if $InfosFlag{dominitoc};
    3816              
    3817 2 100       6 print <
    3818             \\maketitle
    3819             EOS
    3820             }
    3821              
    3822             sub latex_document_end {
    3823 2     2 0 74 print <
    3824              
    3825             \\end{document}
    3826             EOS
    3827             } # ]]]
    3828              
    3829             sub latex_header_name { # [[[
    3830 114     114 0 146 my $macro = shift;
    3831             return
    3832             $macro eq "Ch" ? "chapter"
    3833             : $macro eq "Sh" ? "section"
    3834             : $macro eq "Ss" ? "subsection"
    3835             : $macro eq "Pt" ? "part"
    3836 114 50       233 : do { diag_error("internal_error:latex_header_name"); "section" };
      0 100       0  
      0 100       0  
        100          
    3837             } # ]]]
    3838              
    3839             sub xhtml_and_epub_common_header { # [[[
    3840 41 100 100 41 0 246 if ( $Opts{target_format} eq "epub" and $Param{'epub-version'} =~ /^3/
          66        
          66        
    3841             or $Opts{target_format} eq "xhtml" and $Param{'xhtml5'})
    3842             {
    3843 14         54 print <
    3844            
    3845             EOS
    3846             }
    3847             else {
    3848 27         90 print <
    3849            
    3850             EOS
    3851             }
    3852 41         98 print <
    3853            
    3854            
    3855             EOS
    3856 41 100 100     116 if ($Opts{target_format} eq "epub" and $Param{'epub-version'} =~ /^3/) {
    3857 7         10 print <
    3858            
    3859             EOS
    3860             }
    3861             else {
    3862 34         41 print <
    3863            
    3864             EOS
    3865             }
    3866              
    3867             } # ]]]
    3868              
    3869             sub xhtml_document_header { # [[[
    3870 39     39 0 48 my $title = shift;
    3871              
    3872 39         52 xhtml_and_epub_common_header();
    3873              
    3874 39 50       91 print <
    3875             $title
    3876             EOS
    3877 39 50       68 print <
    3878            
    3879             EOS
    3880 39 100 100     155 if ($Param{'epub-css'} and $Opts{target_format} eq "epub") {
        100 66        
    3881 12         16 print <
    3882            
    3883             EOS
    3884             }
    3885             elsif ($Param{'xhtml-css'} and $Opts{target_format} eq "xhtml") {
    3886 14         30 print <
    3887            
    3888             EOS
    3889             }
    3890 39         37 print <
    3891            
    3892            
    3893             EOS
    3894 39 100 66     87 if ($Opts{target_format} ne "epub" and $Param{'xhtml-top'}) {
    3895 14         19 print_file($Param{'xhtml-top'}, "xhtml-top");
    3896             }
    3897             } # ]]]
    3898              
    3899             sub xhtml_document_footer { # [[[
    3900 39 100 66 39 0 103 if ($Opts{target_format} ne "epub" and $Param{'xhtml-bottom'}) {
    3901 14         22 print_file($Param{'xhtml-bottom'}, "xhtml-bottom");
    3902             }
    3903 39         343 print <
    3904            
    3905            
    3906             EOS
    3907             } # ]]]
    3908              
    3909             sub xhtml_file_output_change { # [[[
    3910 30     30 0 26 my $title = shift;
    3911              
    3912 30 100 66     68 if ($Opts{target_format} ne "epub" and $State{_xhtml_navigation_text}) {
    3913 12         24 print $State{_xhtml_navigation_text};
    3914             }
    3915 30         38 xhtml_document_footer();
    3916              
    3917 30         18 my $out_file;
    3918 30 100       44 if ($Opts{target_format} eq "epub") {
    3919             $out_file = catfile(
    3920 15         78 $Opts{output_file}, 'EPUB',
    3921             "body-$Count{part}-$Count{chapter}.xhtml"
    3922             );
    3923             }
    3924             else {
    3925             $out_file =
    3926 15         84 catfile($Opts{output_file}, "body-$Count{part}-$Count{chapter}.html");
    3927             }
    3928 30 50       2000 open(STDOUT, '>', $out_file) or diag_fatal("$out_file:$!");
    3929 30         58 xhtml_document_header($title);
    3930              
    3931 30 100       61 return if $Opts{target_format} eq "epub";
    3932              
    3933             # IF NOT EPUB
    3934              
    3935 15         9 my ($previous, $next);
    3936             $previous = $loXstack{nav}->[ $State{nav_count} - 2 ]
    3937 15 100       42 unless $State{nav_count} <= 1;
    3938             $next = $loXstack{nav}->[ $State{nav_count} ]
    3939 15 100       9 unless $State{nav_count} >= @{ $loXstack{nav} };
      15         34  
    3940              
    3941 15         21 $State{_xhtml_navigation_text} = <
    3942            
    3943            
    3944             EOS
    3945 15 100       19 if (defined $previous) {
    3946 12         13 my $href = $previous->{href};
    3947 12         20 $State{_xhtml_navigation_text} .= <
    3948            
  • <
  • 3949             EOS
    3950             }
    3951             else {
    3952 3         8 $State{_xhtml_navigation_text} .= <
    3953            
  • <
  • 3954             EOS
    3955             }
    3956 15         24 $State{_xhtml_navigation_text} .= <
    3957            
  • $Param{_index}
  • 3958             EOS
    3959 15 100       18 if (defined $next) {
    3960 12         11 my $href = $next->{href};
    3961 12         18 $State{_xhtml_navigation_text} .= <
    3962            
  • >
  • 3963             EOS
    3964             }
    3965             else {
    3966 3         4 $State{_xhtml_navigation_text} .= <
    3967            
  • >
  • 3968             EOS
    3969             }
    3970 15         12 $State{_xhtml_navigation_text} .= <
    3971            
    3972            
    3973             EOS
    3974 15         32 print $State{_xhtml_navigation_text};
    3975              
    3976             } # ]]]
    3977              
    3978             sub xhtml_loX { # [[[
    3979 11     11 0 14 my ($class) = @_;
    3980             diag_warning("frundis:warning:no '$class' information found, skipping\n")
    3981             and return
    3982             unless defined $loXstack{$class}
    3983 11 50 0     24 and @{ $loXstack{$class} };
      11   33     30  
    3984 11         23 print qq{
    \n};
    3985 11         10 print qq{
      \n};
    3986              
    3987 11         10 foreach my $entry (@{ $loXstack{$class} }) {
      11         18  
    3988 26         35 xhtml_toc_like_entry($entry, {}, 1);
    3989             }
    3990 11         14 print qq{ \n};
    3991 11         62 print qq{\n};
    3992             } # ]]]
    3993              
    3994             sub xhtml_gen_href { # [[[
    3995 248     248 0 242 my ($prefix, $count, $hasfile) = @_;
    3996 248         175 my $href;
    3997 248 100       319 if ($Opts{all_in_one_file}) {
        100          
    3998 168         219 $href = "#$prefix$count";
    3999             }
    4000             elsif ($hasfile) {
    4001 30 100       45 my $suffix = $Opts{target_format} eq "epub" ? ".xhtml" : ".html";
    4002 30         60 $href = "body-$Count{part}-$Count{chapter}" . $suffix;
    4003             }
    4004             else {
    4005 50 100       73 my $suffix = $Opts{target_format} eq "epub" ? ".xhtml" : ".html";
    4006             $href =
    4007             ($Count{part} || $Count{chapter})
    4008 50 100 66     163 ? "body-$Count{part}-$Count{chapter}$suffix#$prefix$count"
    4009             : "index$suffix#$prefix$count";
    4010             }
    4011 248         371 return $href;
    4012             } # ]]]
    4013              
    4014             sub xhtml_lof { # [[[
    4015 0     0 0 0 xhtml_loX("lof");
    4016             } # ]]]
    4017              
    4018             sub xhtml_lot { # [[[
    4019 7     7 0 15 xhtml_loX("lot");
    4020             } # ]]]
    4021              
    4022             sub xhtml_section_header { # [[[
    4023 254     254 0 212 my $macro = shift;
    4024 254         315 return "h" . header_level($macro);
    4025             } # ]]]
    4026              
    4027             sub xhtml_titlepage { # [[[
    4028 9 100   9 0 20 if ($Param{'title-page'}) {
    4029             warn
    4030             "frundis:warning:parameter ``title-page'' set to 1 but no document title specified\n"
    4031 6 50       13 unless $Param{'document-title'};
    4032             warn
    4033             "frundis:warning:parameter ``title-page'' set to 1 but no document date specified\n"
    4034 6 50       13 unless $Param{'document-date'};
    4035             warn
    4036             "frundis:warning:parameter ``title-page'' set to true value but no document "
    4037             . "author specified with ``document-author'' parameter\n"
    4038 6 50       11 unless $Param{'document-author'};
    4039 6 50       22 print <
    4040            

    $Param{'document-title'}

    4041             EOS
    4042 6 50       21 print <
    4043            

    $Param{'document-author'}

    4044             EOS
    4045 6 50       18 print <
    4046            

    $Param{'document-date'}

    4047             EOS
    4048             }
    4049             } # ]]]
    4050              
    4051             sub xhtml_toc { # [[[
    4052 40     40 0 52 my ($type, $opts) = @_;
    4053             diag_warning(
    4054             "frundis:warning:no TOC information found, skipping TOC generation\n")
    4055             and return
    4056 40 50 0     25 unless @{ $loXstack{toc} };
      40         89  
    4057 40   100     76 $opts //= {};
    4058 40         64 $opts->{prefix} = "s";
    4059 40         35 $opts->{toc} = 1;
    4060 40         24 my $start = 0;
    4061 40         37 my $mini_macro = "Ch";
    4062 40 100 66     88 if ($opts->{mini} and $State{nav_count}) {
    4063 20         33 my $nav_entry = $loXstack{nav}->[ $State{nav_count} - 1 ];
    4064 20         17 $start = $nav_entry->{count};
    4065 20         24 $mini_macro = $nav_entry->{macro};
    4066             }
    4067              
    4068 40 100       83 my $close_list =
        100          
    4069             $type eq "ncx" ? ""
    4070             : $type eq "nav" ? ""
    4071             : "";
    4072 40 50       105 my $close_item =
        100          
        100          
    4073             $type eq "ncx" ? ""
    4074             : $type eq "xhtml" ? ""
    4075             : $type eq "nav" ? ""
    4076             : diag_error("internal_error:xhtml_toc");
    4077              
    4078             # TOC top
    4079 40 100       75 if ($type eq "ncx") {
        100          
        50          
    4080 3         4 print "\n";
    4081 3   50     9 my $title = $Param{'document-title'} // "";
    4082 3         9 print <
    4083            
    4084             $title
    4085            
    4086            
    4087             EOS
    4088             }
    4089             elsif ($type eq "xhtml") {
    4090 36         63 print q{
    }, "\n";
    4091 36         29 my $title;
    4092 36 100 100     98 if ($opts->{mini} or defined $opts->{title}) {
    4093 28         32 $title = $opts->{title};
    4094             }
    4095             else {
    4096 8         10 $title = $Param{'document-title'};
    4097             }
    4098 36 100       77 print <
    4099            

    $title

    4100             EOS
    4101 36         42 print "
      \n";
    4102             }
    4103             elsif ($type eq "nav") {
    4104 1         1 print qq{
    4105 1 50       4 print <
    4106            

    $Param{'document-title'}

    4107             EOS
    4108 1         2 print "
      \n";
    4109             }
    4110              
    4111             # TOC entries
    4112             # $level: the actual depth level of the entry in TOC.
    4113             # $title_level: the level of the title (1 for Pt, 2 for Ch, etc.)
    4114             # $previous_title_level: the level of the previous title
    4115 40         33 my $level = 0; # 0 for first iteration
    4116 40         24 my $previous_title_level = 1;
    4117 40         44 for (my $i = $start ; $i <= $#{ $loXstack{toc} } ; $i++) {
      286         450  
    4118 260         197 my $entry = $loXstack{toc}->[$i];
    4119 260         202 my $macro = $entry->{macro};
    4120 260 100       298 if ($opts->{mini}) {
    4121 86 100 100     246 last if $macro eq $mini_macro or $macro eq "Pt";
    4122             }
    4123 246 100       309 if ($opts->{summary}) {
    4124 110 50 66     188 if ($opts->{mini} and $mini_macro eq "Ch") {
    4125 0 0       0 next unless $macro eq "Sh";
    4126             }
    4127             else {
    4128 110 100       246 next unless $macro =~ /^(?:Pt|Ch)$/;
    4129             }
    4130             }
    4131 181         197 my $title_level = header_level($macro);
    4132              
    4133             # Computation of $level and $previous_title_level
    4134 181 100       322 if ($level == 0) {
        100          
        100          
        50          
    4135 40         34 $level = 1;
    4136 40         26 $previous_title_level = $title_level;
    4137             }
    4138             elsif ($title_level > $previous_title_level) {
    4139 75         51 my $diference = $title_level - $previous_title_level;
    4140 75 100       94 if ($type eq "xhtml") {
        100          
    4141 53         71 print " " x ($level + 1), "
      \n";
    4142             }
    4143             elsif ($type eq "nav") {
    4144 6         9 print " " x ($level + 1), "
      \n";
    4145             }
    4146 75         54 $previous_title_level = $title_level;
    4147 75         57 $level = $level + $diference;
    4148             }
    4149             elsif ($title_level < $previous_title_level) {
    4150 36         29 my $diference = $title_level - $previous_title_level;
    4151 36 100       50 $diference = 1 - $level if $diference + $level < 1;
    4152 36         70 print " " x ($level + 1), "$close_item\n";
    4153 36         62 for (my $i = $level ; $i > $level + $diference ; $i--) {
    4154 45         92 print " " x $i, "$close_list$close_item\n";
    4155             }
    4156 36         28 $previous_title_level = $title_level;
    4157 36         22 $level = $level + $diference;
    4158 36 50       52 $level = 1 if $level < 1;
    4159             }
    4160             elsif ($title_level == $previous_title_level) {
    4161 30         59 print " " x ($level + 1), "$close_item\n";
    4162             }
    4163              
    4164             # Print entry
    4165 181 100       238 if ($type eq "ncx") {
        100          
        50          
    4166 30         28 my $num = $entry->{num};
    4167 30 100       38 $num = "$num. " if $num;
    4168 30         49 print " " x ($level + 1), qq{\n};
    4169 30         50 print " " x ($level + 2),
    4170             qq{$num$entry->{title}\n};
    4171 30         28 my $href = $entry->{href};
    4172 30         52 print " " x ($level + 2), qq{\n};
    4173             }
    4174             elsif ($type eq "xhtml") {
    4175 140         145 xhtml_toc_like_entry($entry, $opts, $level);
    4176             }
    4177             elsif ($type eq "nav") {
    4178 11         10 my $href = $entry->{href};
    4179 11         10 my $num = $entry->{num};
    4180 11 100       14 $num = "$num. " if $num;
    4181 11         42 print " " x ($level + 1),
    4182             qq{
  • $num$entry->{title}\n};
  • 4183             }
    4184             }
    4185 40 50       102 print " " x ($level + 1), "$close_item\n" if $level > 0;
    4186 40         70 for (my $i = $level ; $i > 1 ; $i--) {
    4187 30         60 print " " x $i, "$close_list$close_item\n";
    4188             }
    4189              
    4190             # TOC bottom
    4191 40 100       68 if ($type eq "ncx") {
        100          
        50          
    4192 3         7 print "", "\n";
    4193             }
    4194             elsif ($type eq "xhtml") {
    4195 36         37 print " ", "\n";
    4196 36         117 print "", "\n";
    4197             }
    4198             elsif ($type eq "nav") {
    4199 1         2 print " ", "\n";
    4200 1         2 print "", "\n";
    4201             }
    4202             } # ]]]
    4203              
    4204             sub xhtml_toc_like_entry { # [[[
    4205 166     166 0 138 my ($entry, $opts, $level) = @_;
    4206 166         131 my $href = $entry->{href};
    4207 166         127 my $num = "";
    4208 166 100 66     368 unless ($opts->{nonum}
          66        
    4209             or ($href =~ /^index/ and not $Opts{all_in_one_file}))
    4210             {
    4211 118 100       128 if ($opts->{toc}) {
    4212 92         67 $num = $entry->{num};
    4213 92 100       129 $num .= ". " if $num;
    4214             }
    4215             else {
    4216 26         29 $num = "$entry->{count}. ";
    4217             }
    4218             }
    4219 166 100       168 if ($Opts{all_in_one_file}) {
    4220 76         235 print " " x ($level + 1),
    4221             qq{
  • $num$entry->{title}\n};
  • 4222             }
    4223             else {
    4224 90         287 print " " x ($level + 1),
    4225             qq{
  • $num$entry->{title}\n};
  • 4226             }
    4227             } # ]]]
    4228              
    4229             1;
    4230              
    4231             # vim:foldmarker=[[[,]]]:foldmethod=marker:sw=4:sts=4:expandtab