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