File Coverage

lib/Text/Frundis/Processing.pm
Criterion Covered Total %
statement 1771 1915 92.4
branch 1048 1298 80.7
condition 238 324 73.4
subroutine 145 148 97.9
pod 0 132 0.0
total 3202 3817 83.8


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

$State{_table_title}

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

$label

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

$title\n};

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

    ",

    2907             _paragraph_end => "

    \n",
    2908             _poemtitle => "h4",
    2909             _table_cell_begin => "",
    2910             _table_cell_end => "
    2911             _table_row_begin => "
    2912             _table_row_end => "
    2913             _verse => '',
    2914             );
    2915 33         180 %Xmtag = (_default => { cmd => 'em' });
    2916 33         149 %Xdtag = (_default => { cmd => 'div' });
    2917             }
    2918              
    2919 60 100       232 if ($Opts{target_format} eq "epub") {
    2920 3         8 $Param{'epub-version'} = "2";
    2921             }
    2922             %loXstack = (
    2923 60         953 toc => [],
    2924             nav => [],
    2925             lot => [],
    2926             lof => [],
    2927             );
    2928 60         566 %InfosFlag = (
    2929             use_verse => 0,
    2930             use_minitoc => 0,
    2931             has_part => 0,
    2932             has_chapter => 0,
    2933             use_graphicx => 0,
    2934             dominilof => 0,
    2935             dominilot => 0,
    2936             dominitoc => 0,
    2937             );
    2938 60         148 $Param{lang} = "en";
    2939 60         158 $Param{_index} = "Index";
    2940 60 100       218 %Filters = defined $Opts{filters} ? %{ $Opts{filters} } : ();
      1         4  
    2941 60         133 %ID = ();
    2942 60         132 @Image = ();
    2943             } # ]]]
    2944              
    2945             sub init_state { # [[[
    2946 120     120 0 1002 %State = (
    2947             lnum => undef, # current line number
    2948             macro => undef, # current macro name
    2949             text => "", # accumulated text
    2950             _table_title => undef,
    2951             _xhtml_navigation_text => "",
    2952             );
    2953 120         767 %Flag = (
    2954             'fr-nbsp-auto' => 1, # automatically add nbsps
    2955             _ignore_text => 0, # whether to ignore text lines
    2956             _frundis_warning => 0,
    2957             _no_warnings => 0,
    2958             ns => 0, # no-space mode
    2959             _perl => 0,
    2960             _verbatim => 0, # verbatim mode
    2961             );
    2962 120         979 %Scope = (
    2963             Bd => [], # list of nested .Bd macros
    2964             Bl => [], # list of nested .Bl macros
    2965             Bm => [], # list of nested .Bm macros
    2966             "#if" => [], # list of nested .#if macros
    2967             de => 0, # in macro definition
    2968             if_ignore => 0,
    2969             item => 0, # under a non closed
    2970             paragraph => 0, # under a non closed

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

    $Param{'document-title'}

    4025             EOS
    4026 6 50       32 print <
    4027            

    $Param{'document-author'}

    4028             EOS
    4029 6 50       33 print <
    4030            

    $Param{'document-date'}

    4031             EOS
    4032             }
    4033             } # ]]]
    4034              
    4035             sub xhtml_toc { # [[[
    4036 40     40 0 108 my ($type, $opts) = @_;
    4037             diag_warning(
    4038             "frundis:warning:no TOC information found, skipping TOC generation\n")
    4039             and return
    4040 40 50 0     53 unless @{ $loXstack{toc} };
      40         147  
    4041 40   100     141 $opts //= {};
    4042 40         116 $opts->{prefix} = "s";
    4043 40         81 $opts->{toc} = 1;
    4044 40         70 my $start = 0;
    4045 40         67 my $mini_macro = "Ch";
    4046 40 100 66     179 if ($opts->{mini} and $State{nav_count}) {
    4047 20         82 my $nav_entry = $loXstack{nav}->[ $State{nav_count} - 1 ];
    4048 20         38 $start = $nav_entry->{count};
    4049 20         48 $mini_macro = $nav_entry->{macro};
    4050             }
    4051              
    4052 40 100       152 my $close_list =
        100          
    4053             $type eq "ncx" ? ""
    4054             : $type eq "nav" ? ""
    4055             : "";
    4056 40 50       157 my $close_item =
        100          
        100          
    4057             $type eq "ncx" ? ""
    4058             : $type eq "xhtml" ? ""
    4059             : $type eq "nav" ? ""
    4060             : diag_error("internal_error:xhtml_toc");
    4061              
    4062             # TOC top
    4063 40 100       142 if ($type eq "ncx") {
        100          
        50          
    4064 3         10 print "\n";
    4065 3   50     16 my $title = $Param{'document-title'} // "";
    4066 3         20 print <
    4067            
    4068             $title
    4069            
    4070            
    4071             EOS
    4072             }
    4073             elsif ($type eq "xhtml") {
    4074 36         120 print q{
    }, "\n";
    4075 36         51 my $title;
    4076 36 100 100     183 if ($opts->{mini} or defined $opts->{title}) {
    4077 28         63 $title = $opts->{title};
    4078             }
    4079             else {
    4080 8         21 $title = $Param{'document-title'};
    4081             }
    4082 36 100       130 print <
    4083            

    $title

    4084             EOS
    4085 36         100 print "
      \n";
    4086             }
    4087             elsif ($type eq "nav") {
    4088 1         4 print qq{
    4089 1 50       13 print <
    4090            

    $Param{'document-title'}

    4091             EOS
    4092 1         4 print "
      \n";
    4093             }
    4094              
    4095             # TOC entries
    4096             # $level: the actual depth level of the entry in TOC.
    4097             # $title_level: the level of the title (1 for Pt, 2 for Ch, etc.)
    4098             # $previous_title_level: the level of the previous title
    4099 40         66 my $level = 0; # 0 for first iteration
    4100 40         61 my $previous_title_level = 1;
    4101 40         79 for (my $i = $start ; $i <= $#{ $loXstack{toc} } ; $i++) {
      286         996  
    4102 260         494 my $entry = $loXstack{toc}->[$i];
    4103 260         495 my $macro = $entry->{macro};
    4104 260 100       736 if ($opts->{mini}) {
    4105 86 100 100     434 last if $macro eq $mini_macro or $macro eq "Pt";
    4106             }
    4107 246 100       637 if ($opts->{summary}) {
    4108 110 50 66     385 if ($opts->{mini} and $mini_macro eq "Ch") {
    4109 0 0       0 next unless $macro eq "Sh";
    4110             }
    4111             else {
    4112 110 100       476 next unless $macro =~ /^(?:Pt|Ch)$/;
    4113             }
    4114             }
    4115 181         500 my $title_level = header_level($macro);
    4116              
    4117             # Computation of $level and $previous_title_level
    4118 181 100       620 if ($level == 0) {
        100          
        100          
        50          
    4119 40         61 $level = 1;
    4120 40         65 $previous_title_level = $title_level;
    4121             }
    4122             elsif ($title_level > $previous_title_level) {
    4123 75         132 my $diference = $title_level - $previous_title_level;
    4124 75 100       275 if ($type eq "xhtml") {
        100          
    4125 53         154 print " " x ($level + 1), "
      \n";
    4126             }
    4127             elsif ($type eq "nav") {
    4128 6         31 print " " x ($level + 1), "
      \n";
    4129             }
    4130 75         132 $previous_title_level = $title_level;
    4131 75         152 $level = $level + $diference;
    4132             }
    4133             elsif ($title_level < $previous_title_level) {
    4134 36         81 my $diference = $title_level - $previous_title_level;
    4135 36 100       115 $diference = 1 - $level if $diference + $level < 1;
    4136 36         127 print " " x ($level + 1), "$close_item\n";
    4137 36         130 for (my $i = $level ; $i > $level + $diference ; $i--) {
    4138 45         211 print " " x $i, "$close_list$close_item\n";
    4139             }
    4140 36         55 $previous_title_level = $title_level;
    4141 36         60 $level = $level + $diference;
    4142 36 50       108 $level = 1 if $level < 1;
    4143             }
    4144             elsif ($title_level == $previous_title_level) {
    4145 30         113 print " " x ($level + 1), "$close_item\n";
    4146             }
    4147              
    4148             # Print entry
    4149 181 100       601 if ($type eq "ncx") {
        100          
        50          
    4150 30         78 my $num = $entry->{num};
    4151 30 100       94 $num = "$num. " if $num;
    4152 30         128 print " " x ($level + 1), qq{\n};
    4153 30         159 print " " x ($level + 2),
    4154             qq{$num$entry->{title}\n};
    4155 30         92 my $href = $entry->{href};
    4156 30         146 print " " x ($level + 2), qq{\n};
    4157             }
    4158             elsif ($type eq "xhtml") {
    4159 140         314 xhtml_toc_like_entry($entry, $opts, $level);
    4160             }
    4161             elsif ($type eq "nav") {
    4162 11         34 my $href = $entry->{href};
    4163 11         28 my $num = $entry->{num};
    4164 11 100       45 $num = "$num. " if $num;
    4165 11         91 print " " x ($level + 1),
    4166             qq{
  • $num$entry->{title}\n};
  • 4167             }
    4168             }
    4169 40 50       197 print " " x ($level + 1), "$close_item\n" if $level > 0;
    4170 40         122 for (my $i = $level ; $i > 1 ; $i--) {
    4171 30         144 print " " x $i, "$close_list$close_item\n";
    4172             }
    4173              
    4174             # TOC bottom
    4175 40 100       151 if ($type eq "ncx") {
        100          
        50          
    4176 3         29 print "", "\n";
    4177             }
    4178             elsif ($type eq "xhtml") {
    4179 36         128 print " ", "\n";
    4180 36         168 print "", "\n";
    4181             }
    4182             elsif ($type eq "nav") {
    4183 1         4 print " ", "\n";
    4184 1         7 print "", "\n";
    4185             }
    4186             } # ]]]
    4187              
    4188             sub xhtml_toc_like_entry { # [[[
    4189 166     166 0 312 my ($entry, $opts, $level) = @_;
    4190 166         340 my $href = $entry->{href};
    4191 166         241 my $num = "";
    4192 166 100 66     768 unless ($opts->{nonum}
          66        
    4193             or ($href =~ /^index/ and not $Opts{all_in_one_file}))
    4194             {
    4195 118 100       278 if ($opts->{toc}) {
    4196 92         235 $num = $entry->{num};
    4197 92 100       269 $num .= ". " if $num;
    4198             }
    4199             else {
    4200 26         60 $num = "$entry->{count}. ";
    4201             }
    4202             }
    4203 166 100       406 if ($Opts{all_in_one_file}) {
    4204 76         518 print " " x ($level + 1),
    4205             qq{
  • $num$entry->{title}\n};
  • 4206             }
    4207             else {
    4208 90         604 print " " x ($level + 1),
    4209             qq{
  • $num$entry->{title}\n};
  • 4210             }
    4211             } # ]]]
    4212              
    4213             1;
    4214              
    4215             # vim:foldmarker=[[[,]]]:foldmethod=marker:sw=4:sts=4:expandtab