src/man2hlp/man2hlp.in

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