src/man2hlp/man2hlp.in

   1 #! @PERL_FOR_BUILD@ -w
   2 #
   3 #  Man page to help file converter
   4 #  Copyright (C) 1994, 1995, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
   5 #  2007, 2010, 2011
   6 #  The Free Software Foundation, Inc.
   7 #
   8 #  Originally written by:
   9 #   Andrew V. Samoilov, 2002
  10 #   Pavel Roskin, 2002
  11 #   Andrew Borodin <aborodin@vmail.ru>, 2010
  12 #
  13 #  Completely rewritten in Perl by:
  14 #   Alexandr Prenko, 2010
  15 #
  16 # This program is free software: you can redistribute it and/or modify
  17 # it under the terms of the GNU General Public License as published by
  18 # the Free Software Foundation, either version 3 of the License, or
  19 # (at your option) any later version.
  20 #
  21 # This program is distributed in the hope that it will be useful,
  22 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 # GNU General Public License for more details.
  25 #
  26 # You should have received a copy of the GNU General Public License
  27 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  28 #
  29 # \file man2hlp
  30 # \brief Source: man page to help file converter
  31
  32 use strict;
  33 use warnings;
  34
  35 # Perl have no static variables, so this hash emulates them
  36 my %static = (
  37     "string_len anchor_flag"    => 0,
  38     "string_len lc_link_flag"   => 0,
  39     "handle_link old"           => undef
  40 );
  41
  42 # Imported constants
  43 my $CHAR_LINK_START     = chr(01);      # Ctrl-A
  44 my $CHAR_LINK_POINTER   = chr(02);      # Ctrl-B
  45 my $CHAR_LINK_END       = chr(03);      # Ctrl-C
  46 my $CHAR_NODE_END       = chr(04);      # Ctrl-D
  47 my $CHAR_ALTERNATE      = chr(05);      # Ctrl-E
  48 my $CHAR_NORMAL         = chr(06);      # Ctrl-F
  49 my $CHAR_VERSION        = chr(07);      # Ctrl-G
  50 my $CHAR_FONT_BOLD      = chr(010);     # Ctrl-H
  51 my $CHAR_FONT_NORMAL    = chr(013);     # Ctrl-K
  52 my $CHAR_FONT_ITALIC    = chr(024);     # Ctrl-T
  53 # end of import
  54
  55 my $col = 0;            # Current output column
  56 my $out_row = 1;        # Current output row
  57 my $in_row = 0;         # Current input row
  58 my $no_split_flag = 0;  # Flag: Don't split section on next ".SH"
  59 my $skip_flag = 0;      # Flag: Skip this section.
  60                         #       0 = don't skip,
  61                         #       1 = skipping title,
  62                         #       2 = title skipped, skipping text
  63 my $link_flag = 0;      # Flag: Next line is a link
  64 my $verbatim_flag = 0;  # Flag: Copy input to output verbatim
  65 my $node = 0;           # Flag: This line is an original ".SH"
  66
  67 my $c_out;              # Output filename
  68 my $f_out;              # Output file
  69
  70 my $c_in;               # Current input filename
  71
  72 my $indentation;        # Indentation level, n spaces
  73 my $tp_flag;            # Flag: .TP paragraph
  74                         #       1 = this line is .TP label,
  75                         #       2 = first line of label description.
  76 my $topics = undef;
  77
  78 # Emulate C strtok()
  79 my $strtok;
  80
  81 sub strtok($$) {
  82     my ($str, $chars) = @_;
  83
  84     if (! defined $chars || $chars eq "")
  85     {
  86         my $result = $strtok;
  87         $strtok = undef;
  88         return $result;
  89     }
  90
  91     $str = $strtok unless defined $str;
  92     return undef unless defined $str;
  93
  94     my $result;
  95     $str =~ s/^[$chars]+//;
  96     ($result, $strtok) = split /[$chars]+/, $str, 2;
  97     ($result, $strtok) = split /[$chars]+/, $strtok, 2 if defined $result && $result eq "";
  98     $strtok = undef if ! defined $strtok || $strtok eq "";
  99     return $result;
 100 }
 101
 102 sub struct_node() {
 103     return {
 104         "node"          => undef,   # Section name
 105         "lname"         => undef,   # Translated .SH, undef if not translated
 106         "next"          => undef,
 107         "heading_level" => undef
 108     }
 109 }
 110
 111 my $nodes = struct_node();
 112 my $cnode;              # Current node
 113
 114 # Report error in input
 115 sub print_error($)
 116 {
 117     my ($message) = @_;
 118     warn sprintf  "man2hlp: %s in file \"%s\" on line %d\n", $message, $c_in, $in_row;
 119 }
 120
 121 # Do open, exit if it fails
 122 sub fopen_check ($$)
 123 {
 124     my ($mode, $filename) = @_;
 125     my $f;
 126
 127     unless (open $f, $mode, $filename)
 128     {
 129         warn sprintf("man2hlp: Cannot open file \"%s\" ($!)\n", $filename);
 130         exit 3;
 131     }
 132     return $f;
 133 }
 134
 135 # Do close, exit if it fails
 136 sub fclose_check($)
 137 {
 138     my ($f) = @_;
 139     unless (close $f)
 140     {
 141         warn "man2hlp: Cannot close file ($!)\n";
 142         exit 3;
 143     }
 144 }
 145
 146 # Change output line
 147 sub newline()
 148 {
 149     $out_row++;
 150     $col = 0;
 151     print $f_out "\n";
 152 }
 153
 154 # Calculate the length of string
 155 sub string_len
 156 {
 157     my ($buffer) = @_;
 158     my $anchor_flag = \$static{"string_len anchor_flag"}; # Flag: Inside hypertext anchor name ho4u_v_Ariom
 159     my $lc_link_flag = \$static{"string_len lc_link_flag"}; # Flag: Inside hypertext link target name
 160     my $backslash_flag = 0;     # Flag: Backslash quoting
 161     my $len = 0;                # Result: the length of the string
 162
 163
 164     foreach my $c (split //, $buffer)
 165     {
 166         if ($c eq $CHAR_LINK_POINTER)
 167         {
 168             $$lc_link_flag = 1;   # Link target name starts
 169         }
 170         elsif ($c eq $CHAR_LINK_END)
 171         {
 172             $$lc_link_flag = 0;   # Link target name ends
 173         }
 174         elsif ($c eq $CHAR_NODE_END)
 175         {
 176             # Node anchor name starts
 177             $$anchor_flag = 1;
 178             # Ugly hack to prevent loss of one space
 179             $len++;
 180         }
 181         # Don't add control characters to the length
 182         next if ord($c) >= 0 && ord($c) < 32;
 183         # Attempt to handle backslash quoting
 184         if ($c eq '\\' && !$backslash_flag)
 185         {
 186             $backslash_flag = 1;
 187             next;
 188         }
 189         $backslash_flag = 0;
 190         # Increase length if not inside anchor name or link target name
 191         $len++ if !$$anchor_flag && !$$lc_link_flag;
 192         if ($$anchor_flag && $c eq ']')
 193         {
 194             # Node anchor name ends
 195             $$anchor_flag = 0;
 196         }
 197     }
 198     return $len;
 199 }
 200
 201 # Output the string
 202 sub print_string($)
 203 {
 204     my ($buffer) = @_;
 205     my $len;                    # The length of current word
 206     my $backslash_flag = 0;
 207     my $font_change_flag = 0;
 208     my $quotes_flag = 0;
 209
 210     # Skipping lines?
 211     return if $skip_flag;
 212     # Copying verbatim?
 213     if ($verbatim_flag)
 214     {
 215         # Attempt to handle backslash quoting
 216         foreach (split //, $buffer)
 217         {
 218             if ($_ eq '\\' && !$backslash_flag)
 219             {
 220                 $backslash_flag = 1;
 221                 next;
 222             }
 223             $backslash_flag = 0;
 224             print $f_out $_;
 225         }
 226     }
 227     else
 228     {
 229         # Split into words
 230         $buffer = strtok($buffer, " \t\n");
 231         # Repeat for each word
 232         while (defined $buffer)
 233         {
 234             # Skip empty strings
 235             if ($buffer ne '')
 236             {
 237                 $len = string_len($buffer);
 238                 # Words are separated by spaces
 239                 if ($col > 0)
 240                 {
 241                     print $f_out ' ';
 242                     $col++;
 243                 }
 244                 elsif ($indentation)
 245                 {
 246                     print $f_out ' ' while $col++ < $indentation;
 247                 }
 248                 # Attempt to handle backslash quoting
 249                 foreach (split //, $buffer)
 250                 {
 251                     # handle quotes: \(lq, \(rq, \(dq
 252                     if ($quotes_flag != 0)
 253                     {
 254                         if (($_ eq 'l' || $_ eq 'r' || $_ eq 'd') && $quotes_flag == 1)
 255                         {
 256                             # continue quotes handling
 257                             $quotes_flag = 2;
 258                             next;
 259                         }
 260                         elsif ($_ eq 'q' && $quotes_flag == 2)
 261                         {
 262                             # finish quotes handling
 263                             $quotes_flag = 0;
 264                             print $f_out '"';
 265                             next;
 266                         }
 267                         else
 268                         {
 269                             print $f_out '(' . $_;
 270                             print_error "Syntax error: unsupported \\(" . $_ . " command";
 271                         }
 272                     }
 273                     # handle \fR, \fB, \fI and \fP commands
 274                     if ($font_change_flag)
 275                     {
 276                         if ($_ eq 'B')
 277                         {
 278                             print $f_out $CHAR_FONT_BOLD;
 279                         }
 280                         elsif ($_ eq 'I')
 281                         {
 282                             print $f_out $CHAR_FONT_ITALIC;
 283                         }
 284                         elsif ($_ eq 'R' || $_ eq 'P')
 285                         {
 286                             print $f_out $CHAR_FONT_NORMAL;
 287                         }
 288                         else
 289                         {
 290                             print $f_out 'f' . $_;
 291                             print_error "Syntax error: unsupported \\f" . $_ . " command";
 292                         }
 293
 294                         $font_change_flag = 0;
 295                         next;
 296                     }
 297                     if ($_ eq '(' && $backslash_flag)
 298                     {
 299                         $quotes_flag = 1;
 300                         $backslash_flag = 0;
 301                         next;
 302                     }
 303                     if ($_ eq 'f' && $backslash_flag)
 304                     {
 305                         $font_change_flag = 1;
 306                         $backslash_flag = 0;
 307                         next;
 308                     }
 309                     if ($_ eq '\\' && !$backslash_flag)
 310                     {
 311                         $backslash_flag = 1;
 312                         next;
 313                     }
 314                     $backslash_flag = 0;
 315                     $font_change_flag = 0;
 316                     $quotes_flag = 0;
 317                     print $f_out $_;
 318                 }
 319                 # Increase column
 320                 $col += $len;
 321             }
 322             # Get the next word
 323             $buffer = strtok(undef, " \t\n");
 324         }                       # while
 325     }
 326 }
 327
 328 # Like print_string but with printf-like syntax
 329 sub printf_string
 330 {
 331     print_string sprintf shift, @_;
 332 }
 333
 334 # Handle NODE and .SH commands.  is_sh is 1 for .SH, 0 for NODE
 335 # FIXME: Consider to remove first parameter
 336 sub handle_node($$)
 337 {
 338     my ($buffer, $is_sh) = @_;
 339     my ($len, $heading_level);
 340
 341     # If we already skipped a section, don't skip another
 342     $skip_flag = 0 if $skip_flag == 2;
 343
 344     # Get the command parameters
 345     $buffer = strtok(undef, "");
 346     if (! defined $buffer)
 347     {
 348         print_error "Syntax error: .SH: no title";
 349         return;
 350     }
 351     else
 352     {
 353         # Remove quotes
 354         $buffer =~ s/^"// and $buffer =~ s/"$//;
 355         # Calculate heading level
 356         $heading_level = 0;
 357         $heading_level++ while substr($buffer, $heading_level, 1) eq ' ';
 358         # Heading level must be even
 359         if ($heading_level % 2)
 360         {
 361             print_error "Syntax error: .SH: odd heading level";
 362         }
 363         if ($no_split_flag)
 364         {
 365             # Don't start a new section
 366             newline;
 367             print_string $buffer;
 368             newline;
 369             newline;
 370             $no_split_flag = 0;
 371         }
 372         elsif ($skip_flag)
 373         {
 374             # Skipping title and marking text for skipping
 375             $skip_flag = 2;
 376         }
 377         else
 378         {
 379             $buffer = substr($buffer, $heading_level);
 380             if (! $is_sh || ! $node)
 381             {
 382                 # Start a new section, but omit empty section names
 383                 if ($buffer ne '')
 384                 {
 385                     printf $f_out "%s[%s]", $CHAR_NODE_END, $buffer;
 386                     newline;
 387                 }
 388
 389                 # Add section to the linked list
 390                 if (! defined $cnode)
 391                 {
 392                     $cnode = $nodes;
 393                 }
 394                 else
 395                 {
 396                     $cnode->{'next'} = struct_node();
 397                     $cnode = $cnode->{'next'};
 398                 }
 399                 $cnode->{'node'} = $buffer;
 400                 $cnode->{'lname'} = undef;
 401                 $cnode->{'next'} = undef;
 402                 $cnode->{'heading_level'} = $heading_level;
 403             }
 404             if ($is_sh)
 405             {
 406                 $cnode->{'lname'} = $buffer;
 407                 print_string $buffer;
 408                 newline;
 409                 newline;
 410             }
 411         }                       # Start new section
 412     }                         # Has parameters
 413     $node = ! $is_sh;
 414 }
 415
 416 # Convert character from the macro name to the font marker
 417 sub char_to_font($)
 418 {
 419     my ($c) = @_;
 420     my %font = (
 421         'R' => $CHAR_FONT_NORMAL,
 422         'B' => $CHAR_FONT_BOLD,
 423         'I' => $CHAR_FONT_ITALIC
 424     );
 425     return exists $font{$c} ? $font{$c} : chr(0);
 426 }
 427
 428 #
 429 # Handle alternate font commands (.BR, .IR, .RB, .RI, .BI, .IB)
 430 # Return 0 if the command wasn't recognized, 1 otherwise
 431 #
 432 sub handle_alt_font($)
 433 {
 434     my ($buffer) = @_;
 435     my $in_quotes = 0;
 436     my $alt_state = 0;
 437
 438     return 0 if length($buffer) != 3;
 439     return 0 if substr($buffer, 0, 1) ne '.';
 440
 441     my @font = (
 442         char_to_font substr($buffer, 1, 1),
 443         char_to_font substr($buffer, 2, 1)
 444     );
 445
 446     # Exclude names with unknown characters, .BB, .II and .RR
 447     if ($font[0] eq chr(0) || $font[1] eq chr(0) || $font[0] eq $font[1])
 448     {
 449         return 0;
 450     }
 451
 452     my $p = strtok(undef, "");
 453     return 1 unless defined $p;
 454
 455     $buffer = $font[0];
 456
 457     my @p = split //, $p;
 458     while (@p)
 459     {
 460
 461         if ($p[0] eq '"')
 462         {
 463             $in_quotes = !$in_quotes;
 464             shift @p;
 465             next;
 466         }
 467
 468         if ($p[0] eq ' ' && !$in_quotes)
 469         {
 470             shift @p;
 471             # Don't change font if we are at the end
 472             if (@p)
 473             {
 474                 $alt_state = $alt_state ? 0 : 1;
 475                 $buffer .= $font[$alt_state];
 476             }
 477
 478             # Skip more spaces
 479             shift @p while @p && $p[0] eq ' ';
 480
 481             next;
 482         }
 483
 484         $buffer .= shift @p;
 485     }
 486
 487     # Turn off attributes if necessary
 488     if ($font[$alt_state] ne $CHAR_FONT_NORMAL)
 489     {
 490         $buffer .= $CHAR_FONT_NORMAL;
 491     }
 492
 493     print_string $buffer;
 494
 495     return 1;
 496 }
 497
 498 # Handle .IP and .TP commands.  is_tp is 1 for .TP, 0 for .IP
 499 sub handle_tp_ip($)
 500 {
 501     my ($is_tp) = @_;
 502     newline if $col > 0;
 503     newline;
 504     if ($is_tp)
 505     {
 506         $tp_flag = 1;
 507         $indentation = 0;
 508     }
 509     else
 510     {
 511         $indentation = 8;
 512     }
 513 }
 514
 515 # Handle all the roff dot commands.  See man groff_man for details
 516 sub handle_command($)
 517 {
 518     my ($buffer) = @_;
 519     my $len;
 520
 521     # Get the command name
 522     $buffer = strtok($buffer, " \t");
 523
 524     if ($buffer eq ".SH")
 525     {
 526         $indentation = 0;
 527         handle_node $buffer, 1;
 528     }
 529     elsif ($buffer eq ".\\\"NODE")
 530     {
 531         handle_node $buffer, 0;
 532     }
 533     elsif ($buffer eq ".\\\"DONT_SPLIT\"")
 534     {
 535         $no_split_flag = 1;
 536     }
 537     elsif ($buffer eq ".\\\"SKIP_SECTION\"")
 538     {
 539         $skip_flag = 1;
 540     }
 541     elsif ($buffer eq ".\\\"LINK2\"")
 542     {
 543         # Next two input lines form a link
 544         $link_flag = 2;
 545     }
 546     elsif ($buffer eq ".PP" || $buffer eq ".P" || $buffer eq ".LP")
 547     {
 548         $indentation = 0;
 549         # End of paragraph
 550         newline if $col > 0;
 551         newline;
 552     }
 553     elsif ($buffer eq ".nf")
 554     {
 555         # Following input lines are to be handled verbatim
 556         $verbatim_flag = 1;
 557         newline if $col > 0;
 558     }
 559     elsif ($buffer eq ".I" || $buffer eq ".B" || $buffer eq ".SB")
 560     {
 561         # Bold text or italics text
 562         my $backslash_flag = 0;
 563
 564         # .SB [text]
 565         # Causes the text on the same line or the text on the
 566         # next  line  to  appear  in boldface font, one point
 567         # size smaller than the default font.
 568         #
 569
 570         # FIXME: text is optional, so there is no error
 571
 572         my $p = strtok(undef, "");
 573         if (! defined $p)
 574         {
 575             print_error "Syntax error: .I | .B | .SB : no text";
 576             return;
 577         }
 578
 579         $buffer = substr($buffer, 1, 1) eq 'I' ? $CHAR_FONT_ITALIC : $CHAR_FONT_BOLD;
 580
 581         # Attempt to handle backslash quoting
 582         foreach (split //, $p)
 583         {
 584             if ($_ eq '\\' && !$backslash_flag)
 585             {
 586                 $backslash_flag = 1;
 587                 next;
 588             }
 589             $backslash_flag = 0;
 590             $buffer .= $_;
 591         }
 592         print_string $buffer . $CHAR_FONT_NORMAL;
 593     }
 594     elsif ($buffer eq ".TP")
 595     {
 596         handle_tp_ip 1;
 597     }
 598     elsif ($buffer eq ".IP")
 599     {
 600         handle_tp_ip 0;
 601     }
 602     elsif ($buffer eq ".\\\"TOPICS")
 603     {
 604         if ($out_row > 1)
 605         {
 606             print_error "Syntax error: .\\\"TOPICS must be first command";
 607             return;
 608         }
 609         $buffer = strtok(undef, "");
 610         if (! defined $buffer)
 611         {
 612             print_error "Syntax error: .\\\"TOPICS: no text";
 613             return;
 614         }
 615         # Remove quotes
 616         $buffer =~ s/^"// and $buffer =~ s/"$//;
 617         $topics = $buffer;
 618     }
 619     elsif ($buffer eq ".br")
 620     {
 621         newline if $col;
 622     }
 623     elsif ($buffer =~  /^\.\\"/)
 624     {
 625         # Comment { Hello from K.O. ;-) }
 626     }
 627     elsif ($buffer eq ".TH")
 628     {
 629         # Title header
 630     }
 631     elsif ($buffer eq ".SM")
 632     {
 633         # Causes the text on the same line or the text on the
 634         # next  line  to  appear  in a font that is one point
 635         # size smaller than the default font.
 636         $buffer = strtok(undef, "");
 637         print_string $buffer if defined $buffer;
 638     }
 639     elsif (handle_alt_font($buffer) == 1)
 640     {
 641         return;
 642     }
 643     elsif ($buffer eq ".RE")
 644     {
 645         newline;
 646     }
 647     else
 648     {
 649         # Other commands are ignored
 650         print_error sprintf "Warning: unsupported command %s", $buffer;
 651         return;
 652     }
 653 }
 654
 655 sub struct_links()
 656 {
 657     return {
 658         'linkname'  => undef,   # Section name
 659         'line'      => undef,   # Input line in ...
 660         'filename'  => undef,
 661         'next'      => undef
 662     }
 663 }
 664
 665 my $links = struct_links();
 666 my $current_link;
 667
 668
 669 sub handle_link($)
 670 {
 671     my ($buffer) = @_;
 672     my $old = \$static{"handle_link old"};
 673     my $len;
 674     my $amp;
 675     my $amp_arg;
 676
 677     if ($link_flag == 1)
 678     {
 679         # Old format link, not supported
 680     }
 681     elsif ($link_flag == 2)
 682     {
 683         # First part of new format link
 684         # Bold text or italics text
 685         if (substr($buffer, 0, 2) eq '.I' || substr($buffer, 0, 2) eq '.B')
 686         {
 687             $buffer =~ s/^..[\s\t]*//;
 688         }
 689         $$old = $buffer;
 690         $link_flag = 3;
 691
 692     }
 693     elsif ($link_flag == 3)
 694     {
 695         # Second part of new format link
 696         $buffer =~ s/^\.//;
 697         $buffer =~ s/^\\//;
 698         $buffer =~ s/^"//;
 699         $buffer =~ s/"$//;
 700
 701         # "Layout\&)," -- "Layout" should be highlighted, but not "),"
 702         ($$old, $amp_arg) = split /\\&/, $$old, 2;
 703         $amp_arg = "" unless defined $amp_arg;
 704         printf_string "%s%s%s%s%s%s\n", $CHAR_LINK_START, $$old,
 705                        $CHAR_LINK_POINTER, $buffer, $CHAR_LINK_END, $amp_arg;
 706         $link_flag = 0;
 707         # Add to the linked list
 708         if (defined $current_link)
 709         {
 710             $current_link->{'next'} = struct_links();
 711             $current_link = $current_link->{'next'};
 712             $current_link->{'next'} = undef;
 713         }
 714         else
 715         {
 716             $current_link = $links;
 717         }
 718         $current_link->{'linkname'} = $buffer;
 719         $current_link->{'filename'} = $c_in;
 720         $current_link->{'line'} = $in_row;
 721     }
 722 }
 723
 724 sub main
 725 {
 726     my $len;                    # Length of input line
 727     my $c_man;                  # Manual filename
 728     my $c_tmpl;                 # Template filename
 729     my $f_man;                  # Manual file
 730     my $f_tmpl;                 # Template file
 731     my $buffer;                 # Full input line
 732     my $lc_node = undef;
 733     my $outfile_buffer;         # Large buffer to keep the output file
 734     my $cont_start;             # Start of [Contents]
 735     my $file_end;               # Length of the output file
 736
 737     # Validity check for arguments
 738     if (@ARGV != 3)
 739     {
 740         warn "Usage: man2hlp file.man template_file helpfile\n";
 741         return 3;
 742     }
 743
 744     $c_man  = $ARGV[0];
 745     $c_tmpl = $ARGV[1];
 746     $c_out  = $ARGV[2];
 747
 748     # First stage - process the manual, write to the output file
 749
 750     $f_man = fopen_check "<", $c_man;
 751     $f_out = fopen_check ">", $c_out;
 752     $c_in = $c_man;
 753
 754     # Repeat for each input line
 755     while (<$f_man>)
 756     {
 757         # Remove terminating newline
 758         chomp;
 759         $buffer = $_;
 760         my $input_line;       # Input line without initial "\&"
 761
 762         if (substr($buffer, 0, 2) eq '\\&')
 763         {
 764             $input_line = substr($buffer, 2);
 765         }
 766         else
 767         {
 768             $input_line = $buffer;
 769         }
 770
 771         $in_row++;
 772         $len = length($input_line);
 773
 774         if ($verbatim_flag)
 775         {
 776             # Copy the line verbatim
 777             if ($input_line eq ".fi")
 778             {
 779                 $verbatim_flag = 0;
 780             }
 781             else
 782             {
 783                 print_string $input_line;
 784                 newline;
 785             }
 786         }
 787         elsif ($link_flag)
 788         {
 789             # The line is a link
 790             handle_link $input_line;
 791         }
 792         elsif (substr($buffer, 0, 1) eq '.')
 793         {
 794             # The line is a roff command
 795             handle_command $input_line;
 796         }
 797         else
 798         {
 799             #A normal line, just output it
 800             print_string $input_line;
 801         }
 802         # .TP label processed as usual line
 803         if ($tp_flag)
 804         {
 805             if ($tp_flag == 1)
 806             {
 807                 $tp_flag = 2;
 808             }
 809             else
 810             {
 811                 $tp_flag = 0;
 812                 $indentation = 8;
 813                 if ($col >= $indentation)
 814                 {
 815                     newline;
 816                 }
 817                 else
 818                 {
 819                     print $f_out " " while ++$col < $indentation;
 820                 }
 821             }
 822         }
 823     }
 824
 825     newline;
 826     fclose_check $f_man;
 827     # First stage ends here, closing the manual
 828
 829     # Second stage - process the template file
 830     $f_tmpl = fopen_check "<", $c_tmpl;
 831     $c_in = $c_tmpl;
 832
 833     # Repeat for each input line
 834     # Read a line
 835     while (<$f_tmpl>)
 836     {
 837         $buffer = $_;
 838         if (defined $lc_node)
 839         {
 840             if ($buffer ne "\n")
 841             {
 842                 $cnode->{'lname'} = $buffer;
 843                 chomp $cnode->{'lname'};
 844             }
 845             $lc_node = undef;
 846         }
 847         else
 848         {
 849             my $char_node_end = index($buffer, $CHAR_NODE_END);
 850             $lc_node = $char_node_end < 0 ? undef : substr($buffer, $char_node_end);
 851
 852             if (defined $lc_node && substr($lc_node, 1, 1) eq '[')
 853             {
 854                 my $p = index($lc_node, ']');
 855                 if ($p >= 0) {
 856                     if (substr($lc_node, 1, 6) eq '[main]')
 857                     {
 858                         $lc_node = undef;
 859                     }
 860                     else
 861                     {
 862                         if (! defined $cnode)
 863                         {
 864                             $cnode = $nodes;
 865                         }
 866                         else
 867                         {
 868                             $cnode->{'next'} = struct_node();
 869                             $cnode = $cnode->{'next'};
 870                         }
 871                         $cnode->{'node'} = substr($lc_node, 2, $p-2);
 872                         $cnode->{'lname'} = undef;
 873                         $cnode->{'next'} = undef;
 874                         $cnode->{'heading_level'} = 0;
 875                     }
 876                 }
 877                 else
 878                 {
 879                   $lc_node = undef;
 880                 }
 881             }
 882             else
 883             {
 884                 $lc_node = undef;
 885             }
 886         }
 887         print $f_out $buffer;
 888     }
 889
 890     $cont_start = tell $f_out;
 891     if ($cont_start <= 0)
 892     {
 893         perror $c_out;
 894         return 1;
 895     }
 896
 897     if ($topics)
 898     {
 899         printf $f_out "\004[Contents]\n%s\n\n", $topics;
 900     }
 901     else
 902     {
 903         print $f_out "\004[Contents]\n";
 904     }
 905
 906     for ($current_link = $links; defined $current_link && defined $current_link->{'linkname'};)
 907     {
 908         my $found = 0;
 909         my $next = $current_link->{'next'};
 910
 911         if ($current_link->{'linkname'} eq "Contents")
 912         {
 913             $found = 1;
 914         }
 915         else
 916         {
 917             for ($cnode = $nodes; defined $cnode && defined $cnode->{'node'}; $cnode = $cnode->{'next'})
 918             {
 919                 if ($cnode->{'node'} eq $current_link->{'linkname'})
 920                 {
 921                     $found = 1;
 922                     last;
 923                 }
 924             }
 925         }
 926         if (! $found)
 927         {
 928             $buffer = sprintf "Stale link \"%s\"", $current_link->{'linkname'};
 929             $c_in = $current_link->{'filename'};
 930             $in_row = $current_link->{'line'};
 931             print_error $buffer;
 932         }
 933
 934         $current_link = $next;
 935     }
 936
 937     for ($cnode = $nodes; defined $cnode && defined $cnode->{'node'};)
 938     {
 939         my $next = $cnode->{'next'};
 940         $lc_node = $cnode->{'node'};
 941
 942         if (defined $lc_node && $lc_node ne '') {
 943             printf $f_out "  %*s\001%s\002%s\003", $cnode->{'heading_level'},
 944                 "", $cnode->{'lname'} ? $cnode->{'lname'} : $lc_node, $lc_node;
 945         }
 946         print $f_out "\n";
 947         $cnode = $next;
 948     }
 949
 950     $file_end = tell $f_out;
 951
 952     # Sanity check
 953     if (($file_end <= 0) || ($file_end - $cont_start <= 0))
 954     {
 955         warn $c_out ."\n";
 956         return 1;
 957     }
 958
 959     fclose_check $f_out;
 960     fclose_check $f_tmpl;
 961     # Second stage ends here, closing all files, note the end of output
 962
 963     #
 964     # Third stage - swap two parts of the output file.
 965     # First, open the output file for reading and load it into the memory.
 966     #
 967     $outfile_buffer = '';
 968     $f_out = fopen_check '<', $c_out;
 969     $outfile_buffer .= $_ while <$f_out>;
 970     fclose_check $f_out;
 971     # Now the output file is in the memory
 972
 973     # Again open output file for writing
 974     $f_out = fopen_check '>', $c_out;
 975
 976     # Write part after the "Contents" node
 977     print $f_out substr($outfile_buffer, $cont_start, $file_end - $cont_start);
 978
 979     # Write part before the "Contents" node
 980     print $f_out substr($outfile_buffer, 0, $cont_start-1);
 981     print $f_out "\n";
 982     fclose_check $f_out;
 983
 984     return 0;
 985 }
 986
 987 exit main();