src/man2hlp/man2hlp.in

   1 #! @PERL@ -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
 208     # Skipping lines?
 209     return if $skip_flag;
 210     # Copying verbatim?
 211     if ($verbatim_flag)
 212     {
 213         # Attempt to handle backslash quoting
 214         foreach (split //, $buffer)
 215         {
 216             if ($_ eq '\\' && !$backslash_flag)
 217             {
 218                 $backslash_flag = 1;
 219                 next;
 220             }
 221             $backslash_flag = 0;
 222             print $f_out $_;
 223         }
 224     }
 225     else
 226     {
 227         # Split into words
 228         $buffer = strtok($buffer, " \t\n");
 229         # Repeat for each word
 230         while (defined $buffer)
 231         {
 232             # Skip empty strings
 233             if ($buffer ne '')
 234             {
 235                 $len = string_len($buffer);
 236                 # Words are separated by spaces
 237                 if ($col > 0)
 238                 {
 239                     print $f_out ' ';
 240                     $col++;
 241                 }
 242                 elsif ($indentation)
 243                 {
 244                     print $f_out ' ' while $col++ < $indentation;
 245                 }
 246                 # Attempt to handle backslash quoting
 247                 foreach (split //, $buffer)
 248                 {
 249                     if ($_ eq '\\' && !$backslash_flag)
 250                     {
 251                         $backslash_flag = 1;
 252                         next;
 253                     }
 254                     $backslash_flag = 0;
 255                     print $f_out $_;
 256                 }
 257                 # Increase column
 258                 $col += $len;
 259             }
 260             # Get the next word
 261             $buffer = strtok(undef, " \t\n");
 262         }                       # while
 263     }
 264 }
 265
 266 # Like print_string but with printf-like syntax
 267 sub printf_string
 268 {
 269     print_string sprintf shift, @_;
 270 }
 271
 272 # Handle NODE and .SH commands.  is_sh is 1 for .SH, 0 for NODE
 273 # FIXME: Consider to remove first parameter
 274 sub handle_node($$)
 275 {
 276     my ($buffer, $is_sh) = @_;
 277     my ($len, $heading_level);
 278
 279     # If we already skipped a section, don't skip another
 280     $skip_flag = 0 if $skip_flag == 2;
 281
 282     # Get the command parameters
 283     $buffer = strtok(undef, "");
 284     if (! defined $buffer)
 285     {
 286         print_error "Syntax error: .SH: no title";
 287         return;
 288     }
 289     else
 290     {
 291         # Remove quotes
 292         $buffer =~ s/^"// and $buffer =~ s/"$//;
 293         # Calculate heading level
 294         $heading_level = 0;
 295         $heading_level++ while substr($buffer, $heading_level, 1) eq ' ';
 296         # Heading level must be even
 297         if ($heading_level % 2)
 298         {
 299             print_error "Syntax error: .SH: odd heading level";
 300         }
 301         if ($no_split_flag)
 302         {
 303             # Don't start a new section
 304             newline;
 305             print_string $buffer;
 306             newline;
 307             newline;
 308             $no_split_flag = 0;
 309         }
 310         elsif ($skip_flag)
 311         {
 312             # Skipping title and marking text for skipping
 313             $skip_flag = 2;
 314         }
 315         else
 316         {
 317             $buffer = substr($buffer, $heading_level);
 318             if (! $is_sh || ! $node)
 319             {
 320                 # Start a new section, but omit empty section names
 321                 if ($buffer ne '')
 322                 {
 323                     printf $f_out "%s[%s]", $CHAR_NODE_END, $buffer;
 324                     newline;
 325                 }
 326
 327                 # Add section to the linked list
 328                 if (! defined $cnode)
 329                 {
 330                     $cnode = $nodes;
 331                 }
 332                 else
 333                 {
 334                     $cnode->{'next'} = struct_node();
 335                     $cnode = $cnode->{'next'};
 336                 }
 337                 $cnode->{'node'} = $buffer;
 338                 $cnode->{'lname'} = undef;
 339                 $cnode->{'next'} = undef;
 340                 $cnode->{'heading_level'} = $heading_level;
 341             }
 342             if ($is_sh)
 343             {
 344                 $cnode->{'lname'} = $buffer;
 345                 print_string $buffer;
 346                 newline;
 347                 newline;
 348             }
 349         }                       # Start new section
 350     }                         # Has parameters
 351     $node = ! $is_sh;
 352 }
 353
 354 # Convert character from the macro name to the font marker
 355 sub char_to_font($)
 356 {
 357     my ($c) = @_;
 358     my %font = (
 359         'R' => $CHAR_FONT_NORMAL,
 360         'B' => $CHAR_FONT_BOLD,
 361         'I' => $CHAR_FONT_ITALIC
 362     );
 363     return exists $font{$c} ? $font{$c} : chr(0);
 364 }
 365
 366 #
 367 # Handle alternate font commands (.BR, .IR, .RB, .RI, .BI, .IB)
 368 # Return 0 if the command wasn't recognized, 1 otherwise
 369 #
 370 sub handle_alt_font($)
 371 {
 372     my ($buffer) = @_;
 373     my $in_quotes = 0;
 374     my $alt_state = 0;
 375
 376     return 0 if length($buffer) != 3;
 377     return 0 if substr($buffer, 0, 1) ne '.';
 378
 379     my @font = (
 380         char_to_font substr($buffer, 1, 1),
 381         char_to_font substr($buffer, 2, 1)
 382     );
 383
 384     # Exclude names with unknown characters, .BB, .II and .RR
 385     if ($font[0] eq chr(0) || $font[1] eq chr(0) || $font[0] eq $font[1])
 386     {
 387         return 0;
 388     }
 389
 390     my $p = strtok(undef, "");
 391     return 1 unless defined $p;
 392
 393     $buffer = $font[0];
 394
 395     my @p = split //, $p;
 396     while (@p)
 397     {
 398
 399         if ($p[0] eq '"')
 400         {
 401             $in_quotes = !$in_quotes;
 402             shift @p;
 403             next;
 404         }
 405
 406         if ($p[0] eq ' ' && !$in_quotes)
 407         {
 408             shift @p;
 409             # Don't change font if we are at the end
 410             if (@p)
 411             {
 412                 $alt_state = $alt_state ? 0 : 1;
 413                 $buffer .= $font[$alt_state];
 414             }
 415
 416             # Skip more spaces
 417             shift @p while @p && $p[0] eq ' ';
 418
 419             next;
 420         }
 421
 422         $buffer .= shift @p;
 423     }
 424
 425     # Turn off attributes if necessary
 426     if ($font[$alt_state] ne $CHAR_FONT_NORMAL)
 427     {
 428         $buffer .= $CHAR_FONT_NORMAL;
 429     }
 430
 431     print_string $buffer;
 432
 433     return 1;
 434 }
 435
 436 # Handle .IP and .TP commands.  is_tp is 1 for .TP, 0 for .IP
 437 sub handle_tp_ip($)
 438 {
 439     my ($is_tp) = @_;
 440     newline if $col > 0;
 441     newline;
 442     if ($is_tp)
 443     {
 444         $tp_flag = 1;
 445         $indentation = 0;
 446     }
 447     else
 448     {
 449         $indentation = 8;
 450     }
 451 }
 452
 453 # Handle all the roff dot commands.  See man groff_man for details
 454 sub handle_command($)
 455 {
 456     my ($buffer) = @_;
 457     my $len;
 458
 459     # Get the command name
 460     $buffer = strtok($buffer, " \t");
 461
 462     if ($buffer eq ".SH")
 463     {
 464         $indentation = 0;
 465         handle_node $buffer, 1;
 466     }
 467     elsif ($buffer eq ".\\\"NODE")
 468     {
 469         handle_node $buffer, 0;
 470     }
 471     elsif ($buffer eq ".\\\"DONT_SPLIT\"")
 472     {
 473         $no_split_flag = 1;
 474     }
 475     elsif ($buffer eq ".\\\"SKIP_SECTION\"")
 476     {
 477         $skip_flag = 1;
 478     }
 479     elsif ($buffer eq ".\\\"LINK2\"")
 480     {
 481         # Next two input lines form a link
 482         $link_flag = 2;
 483     }
 484     elsif ($buffer eq ".PP" || $buffer eq ".P" || $buffer eq ".LP")
 485     {
 486         $indentation = 0;
 487         # End of paragraph
 488         newline if $col > 0;
 489         newline;
 490     }
 491     elsif ($buffer eq ".nf")
 492     {
 493         # Following input lines are to be handled verbatim
 494         $verbatim_flag = 1;
 495         newline if $col > 0;
 496     }
 497     elsif ($buffer eq ".I" || $buffer eq ".B" || $buffer eq ".SB")
 498     {
 499         # Bold text or italics text
 500         my $backslash_flag = 0;
 501
 502         # .SB [text]
 503         # Causes the text on the same line or the text on the
 504         # next  line  to  appear  in boldface font, one point
 505         # size smaller than the default font.
 506         #
 507
 508         # FIXME: text is optional, so there is no error
 509
 510         my $p = strtok(undef, "");
 511         if (! defined $p)
 512         {
 513             print_error "Syntax error: .I | .B | .SB : no text";
 514             return;
 515         }
 516
 517         $buffer = substr($buffer, 1, 1) eq 'I' ? $CHAR_FONT_ITALIC : $CHAR_FONT_BOLD;
 518
 519         # Attempt to handle backslash quoting
 520         foreach (split //, $p)
 521         {
 522             if ($_ eq '\\' && !$backslash_flag)
 523             {
 524                 $backslash_flag = 1;
 525                 next;
 526             }
 527             $backslash_flag = 0;
 528             $buffer .= $_;
 529         }
 530         print_string $buffer . $CHAR_FONT_NORMAL;
 531     }
 532     elsif ($buffer eq ".TP")
 533     {
 534         handle_tp_ip 1;
 535     }
 536     elsif ($buffer eq ".IP")
 537     {
 538         handle_tp_ip 0;
 539     }
 540     elsif ($buffer eq ".\\\"TOPICS")
 541     {
 542         if ($out_row > 1)
 543         {
 544             print_error "Syntax error: .\\\"TOPICS must be first command";
 545             return;
 546         }
 547         $buffer = strtok(undef, "");
 548         if (! defined $buffer)
 549         {
 550             print_error "Syntax error: .\\\"TOPICS: no text";
 551             return;
 552         }
 553         # Remove quotes
 554         $buffer =~ s/^"// and $buffer =~ s/"$//;
 555         $topics = $buffer;
 556     }
 557     elsif ($buffer eq ".br")
 558     {
 559         newline if $col;
 560     }
 561     elsif ($buffer =~  /^\.\\"/)
 562     {
 563         # Comment { Hello from K.O. ;-) }
 564     }
 565     elsif ($buffer eq ".TH")
 566     {
 567         # Title header
 568     }
 569     elsif ($buffer eq ".SM")
 570     {
 571         # Causes the text on the same line or the text on the
 572         # next  line  to  appear  in a font that is one point
 573         # size smaller than the default font.
 574         $buffer = strtok(undef, "");
 575         print_string $buffer if defined $buffer;
 576     }
 577     elsif (handle_alt_font($buffer) == 1)
 578     {
 579         return;
 580     }
 581     else
 582     {
 583         # Other commands are ignored
 584         print_error sprintf "Warning: unsupported command %s", $buffer;
 585         return;
 586     }
 587 }
 588
 589 sub struct_links()
 590 {
 591     return {
 592         'linkname'  => undef,   # Section name
 593         'line'      => undef,   # Input line in ...
 594         'filename'  => undef,
 595         'next'      => undef
 596     }
 597 }
 598
 599 my $links = struct_links();
 600 my $current_link;
 601
 602
 603 sub handle_link($)
 604 {
 605     my ($buffer) = @_;
 606     my $old = \$static{"handle_link old"};
 607     my $len;
 608     my $amp;
 609     my $amp_arg;
 610
 611     if ($link_flag == 1)
 612     {
 613         # Old format link, not supported
 614     }
 615     elsif ($link_flag == 2)
 616     {
 617         # First part of new format link
 618         # Bold text or italics text
 619         if (substr($buffer, 0, 2) eq '.I' || substr($buffer, 0, 2) eq '.B')
 620         {
 621             $buffer =~ s/^..[\s\t]*//;
 622         }
 623         $$old = $buffer;
 624         $link_flag = 3;
 625
 626     }
 627     elsif ($link_flag == 3)
 628     {
 629         # Second part of new format link
 630         $buffer =~ s/^\.//;
 631         $buffer =~ s/^\\//;
 632         $buffer =~ s/^"//;
 633         $buffer =~ s/"$//;
 634
 635         # "Layout\&)," -- "Layout" should be highlighted, but not "),"
 636         ($$old, $amp_arg) = split /\\&/, $$old, 2;
 637         $amp_arg = "" unless defined $amp_arg;
 638         printf_string "%s%s%s%s%s%s\n", $CHAR_LINK_START, $$old,
 639                        $CHAR_LINK_POINTER, $buffer, $CHAR_LINK_END, $amp_arg;
 640         $link_flag = 0;
 641         # Add to the linked list
 642         if (defined $current_link)
 643         {
 644             $current_link->{'next'} = struct_links();
 645             $current_link = $current_link->{'next'};
 646             $current_link->{'next'} = undef;
 647         }
 648         else
 649         {
 650             $current_link = $links;
 651         }
 652         $current_link->{'linkname'} = $buffer;
 653         $current_link->{'filename'} = $c_in;
 654         $current_link->{'line'} = $in_row;
 655     }
 656 }
 657
 658 sub main
 659 {
 660     my $len;                    # Length of input line
 661     my $c_man;                  # Manual filename
 662     my $c_tmpl;                 # Template filename
 663     my $f_man;                  # Manual file
 664     my $f_tmpl;                 # Template file
 665     my $buffer;                 # Full input line
 666     my $lc_node = undef;
 667     my $outfile_buffer;         # Large buffer to keep the output file
 668     my $cont_start;             # Start of [Contents]
 669     my $file_end;               # Length of the output file
 670
 671     # Validity check for arguments
 672     if (@ARGV != 3)
 673     {
 674         warn "Usage: man2hlp file.man template_file helpfile\n";
 675         return 3;
 676     }
 677
 678     $c_man  = $ARGV[0];
 679     $c_tmpl = $ARGV[1];
 680     $c_out  = $ARGV[2];
 681
 682     # First stage - process the manual, write to the output file
 683
 684     $f_man = fopen_check "<", $c_man;
 685     $f_out = fopen_check ">", $c_out;
 686     $c_in = $c_man;
 687
 688     # Repeat for each input line
 689     while (<$f_man>)
 690     {
 691         # Remove terminating newline
 692         chomp;
 693         $buffer = $_;
 694         my $input_line;       # Input line without initial "\&"
 695
 696         if (substr($buffer, 0, 2) eq '\\&')
 697         {
 698             $input_line = substr($buffer, 2);
 699         }
 700         else
 701         {
 702             $input_line = $buffer;
 703         }
 704
 705         $in_row++;
 706         $len = length($input_line);
 707
 708         if ($verbatim_flag)
 709         {
 710             # Copy the line verbatim
 711             if ($input_line eq ".fi")
 712             {
 713                 $verbatim_flag = 0;
 714             }
 715             else
 716             {
 717                 print_string $input_line;
 718                 newline;
 719             }
 720         }
 721         elsif ($link_flag)
 722         {
 723             # The line is a link
 724             handle_link $input_line;
 725         }
 726         elsif (substr($buffer, 0, 1) eq '.')
 727         {
 728             # The line is a roff command
 729             handle_command $input_line;
 730         }
 731         else
 732         {
 733             #A normal line, just output it
 734             print_string $input_line;
 735         }
 736         # .TP label processed as usual line
 737         if ($tp_flag)
 738         {
 739             if ($tp_flag == 1)
 740             {
 741                 $tp_flag = 2;
 742             }
 743             else
 744             {
 745                 $tp_flag = 0;
 746                 $indentation = 8;
 747                 if ($col >= $indentation)
 748                 {
 749                     newline;
 750                 }
 751                 else
 752                 {
 753                     print $f_out " " while ++$col < $indentation;
 754                 }
 755             }
 756         }
 757     }
 758
 759     newline;
 760     fclose_check $f_man;
 761     # First stage ends here, closing the manual
 762
 763     # Second stage - process the template file
 764     $f_tmpl = fopen_check "<", $c_tmpl;
 765     $c_in = $c_tmpl;
 766
 767     # Repeat for each input line
 768     # Read a line
 769     while (<$f_tmpl>)
 770     {
 771         $buffer = $_;
 772         if (defined $lc_node)
 773         {
 774             if ($buffer ne "\n")
 775             {
 776                 $cnode->{'lname'} = $buffer;
 777                 chomp $cnode->{'lname'};
 778             }
 779             $lc_node = undef;
 780         }
 781         else
 782         {
 783             my $char_node_end = index($buffer, $CHAR_NODE_END);
 784             $lc_node = $char_node_end < 0 ? undef : substr($buffer, $char_node_end);
 785
 786             if (defined $lc_node && substr($lc_node, 1, 1) eq '[')
 787             {
 788                 my $p = index($lc_node, ']');
 789                 if ($p >= 0) {
 790                     if (substr($lc_node, 1, 6) eq '[main]')
 791                     {
 792                         $lc_node = undef;
 793                     }
 794                     else
 795                     {
 796                         if (! defined $cnode)
 797                         {
 798                             $cnode = $nodes;
 799                         }
 800                         else
 801                         {
 802                             $cnode->{'next'} = struct_node();
 803                             $cnode = $cnode->{'next'};
 804                         }
 805                         $cnode->{'node'} = substr($lc_node, 2, $p-2);
 806                         $cnode->{'lname'} = undef;
 807                         $cnode->{'next'} = undef;
 808                         $cnode->{'heading_level'} = 0;
 809                     }
 810                 }
 811                 else
 812                 {
 813                   $lc_node = undef;
 814                 }
 815             }
 816             else
 817             {
 818                 $lc_node = undef;
 819             }
 820         }
 821         print $f_out $buffer;
 822     }
 823
 824     $cont_start = tell $f_out;
 825     if ($cont_start <= 0)
 826     {
 827         perror $c_out;
 828         return 1;
 829     }
 830
 831     if ($topics)
 832     {
 833         printf $f_out "\004[Contents]\n%s\n\n", $topics;
 834     }
 835     else
 836     {
 837         print $f_out "\004[Contents]\n";
 838     }
 839
 840     for ($current_link = $links; defined $current_link && defined $current_link->{'linkname'};)
 841     {
 842         my $found = 0;
 843         my $next = $current_link->{'next'};
 844
 845         if ($current_link->{'linkname'} eq "Contents")
 846         {
 847             $found = 1;
 848         }
 849         else
 850         {
 851             for ($cnode = $nodes; defined $cnode && defined $cnode->{'node'}; $cnode = $cnode->{'next'})
 852             {
 853                 if ($cnode->{'node'} eq $current_link->{'linkname'})
 854                 {
 855                     $found = 1;
 856                     last;
 857                 }
 858             }
 859         }
 860         if (! $found)
 861         {
 862             $buffer = sprintf "Stale link \"%s\"", $current_link->{'linkname'};
 863             $c_in = $current_link->{'filename'};
 864             $in_row = $current_link->{'line'};
 865             print_error $buffer;
 866         }
 867
 868         $current_link = $next;
 869     }
 870
 871     for ($cnode = $nodes; defined $cnode && defined $cnode->{'node'};)
 872     {
 873         my $next = $cnode->{'next'};
 874         $lc_node = $cnode->{'node'};
 875
 876         if (defined $lc_node && $lc_node ne '') {
 877             printf $f_out "  %*s\001%s\002%s\003", $cnode->{'heading_level'},
 878                 "", $cnode->{'lname'} ? $cnode->{'lname'} : $lc_node, $lc_node;
 879         }
 880         print $f_out "\n";
 881         $cnode = $next;
 882     }
 883
 884     $file_end = tell $f_out;
 885
 886     # Sanity check
 887     if (($file_end <= 0) || ($file_end - $cont_start <= 0))
 888     {
 889         warn $c_out ."\n";
 890         return 1;
 891     }
 892
 893     fclose_check $f_out;
 894     fclose_check $f_tmpl;
 895     # Second stage ends here, closing all files, note the end of output
 896
 897     #
 898     # Third stage - swap two parts of the output file.
 899     # First, open the output file for reading and load it into the memory.
 900     #
 901     $outfile_buffer = '';
 902     $f_out = fopen_check '<', $c_out;
 903     $outfile_buffer .= $_ while <$f_out>;
 904     fclose_check $f_out;
 905     # Now the output file is in the memory
 906
 907     # Again open output file for writing
 908     $f_out = fopen_check '>', $c_out;
 909
 910     # Write part after the "Contents" node
 911     print $f_out substr($outfile_buffer, $cont_start, $file_end - $cont_start);
 912
 913     # Write part before the "Contents" node
 914     print $f_out substr($outfile_buffer, 0, $cont_start-1);
 915     print $f_out "\n";
 916     fclose_check $f_out;
 917
 918     return 0;
 919 }
 920
 921 exit main();