summaryrefslogtreecommitdiffstats
path: root/src/man2hlp/man2hlp.in
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/man2hlp/man2hlp.in987
1 files changed, 987 insertions, 0 deletions
diff --git a/src/man2hlp/man2hlp.in b/src/man2hlp/man2hlp.in
new file mode 100644
index 0000000..08765d8
--- /dev/null
+++ b/src/man2hlp/man2hlp.in
@@ -0,0 +1,987 @@
+#! @PERL_FOR_BUILD@ -w
+#
+# Man page to help file converter
+# Copyright (C) 1994, 1995, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
+# 2007, 2010, 2011
+# The Free Software Foundation, Inc.
+#
+# Originally written by:
+# Andrew V. Samoilov, 2002
+# Pavel Roskin, 2002
+# Andrew Borodin <aborodin@vmail.ru>, 2010
+#
+# Completely rewritten in Perl by:
+# Alexandr Prenko, 2010
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+#
+# \file man2hlp
+# \brief Source: man page to help file converter
+
+use strict;
+use warnings;
+
+# Perl have no static variables, so this hash emulates them
+my %static = (
+ "string_len anchor_flag" => 0,
+ "string_len lc_link_flag" => 0,
+ "handle_link old" => undef
+);
+
+# Imported constants
+my $CHAR_LINK_START = chr(01); # Ctrl-A
+my $CHAR_LINK_POINTER = chr(02); # Ctrl-B
+my $CHAR_LINK_END = chr(03); # Ctrl-C
+my $CHAR_NODE_END = chr(04); # Ctrl-D
+my $CHAR_ALTERNATE = chr(05); # Ctrl-E
+my $CHAR_NORMAL = chr(06); # Ctrl-F
+my $CHAR_VERSION = chr(07); # Ctrl-G
+my $CHAR_FONT_BOLD = chr(010); # Ctrl-H
+my $CHAR_FONT_NORMAL = chr(013); # Ctrl-K
+my $CHAR_FONT_ITALIC = chr(024); # Ctrl-T
+# end of import
+
+my $col = 0; # Current output column
+my $out_row = 1; # Current output row
+my $in_row = 0; # Current input row
+my $no_split_flag = 0; # Flag: Don't split section on next ".SH"
+my $skip_flag = 0; # Flag: Skip this section.
+ # 0 = don't skip,
+ # 1 = skipping title,
+ # 2 = title skipped, skipping text
+my $link_flag = 0; # Flag: Next line is a link
+my $verbatim_flag = 0; # Flag: Copy input to output verbatim
+my $node = 0; # Flag: This line is an original ".SH"
+
+my $c_out; # Output filename
+my $f_out; # Output file
+
+my $c_in; # Current input filename
+
+my $indentation; # Indentation level, n spaces
+my $tp_flag; # Flag: .TP paragraph
+ # 1 = this line is .TP label,
+ # 2 = first line of label description.
+my $topics = undef;
+
+# Emulate C strtok()
+my $strtok;
+
+sub strtok($$) {
+ my ($str, $chars) = @_;
+
+ if (! defined $chars || $chars eq "")
+ {
+ my $result = $strtok;
+ $strtok = undef;
+ return $result;
+ }
+
+ $str = $strtok unless defined $str;
+ return undef unless defined $str;
+
+ my $result;
+ $str =~ s/^[$chars]+//;
+ ($result, $strtok) = split /[$chars]+/, $str, 2;
+ ($result, $strtok) = split /[$chars]+/, $strtok, 2 if defined $result && $result eq "";
+ $strtok = undef if ! defined $strtok || $strtok eq "";
+ return $result;
+}
+
+sub struct_node() {
+ return {
+ "node" => undef, # Section name
+ "lname" => undef, # Translated .SH, undef if not translated
+ "next" => undef,
+ "heading_level" => undef
+ }
+}
+
+my $nodes = struct_node();
+my $cnode; # Current node
+
+# Report error in input
+sub print_error($)
+{
+ my ($message) = @_;
+ warn sprintf "man2hlp: %s in file \"%s\" on line %d\n", $message, $c_in, $in_row;
+}
+
+# Do open, exit if it fails
+sub fopen_check ($$)
+{
+ my ($mode, $filename) = @_;
+ my $f;
+
+ unless (open $f, $mode, $filename)
+ {
+ warn sprintf("man2hlp: Cannot open file \"%s\" ($!)\n", $filename);
+ exit 3;
+ }
+ return $f;
+}
+
+# Do close, exit if it fails
+sub fclose_check($)
+{
+ my ($f) = @_;
+ unless (close $f)
+ {
+ warn "man2hlp: Cannot close file ($!)\n";
+ exit 3;
+ }
+}
+
+# Change output line
+sub newline()
+{
+ $out_row++;
+ $col = 0;
+ print $f_out "\n";
+}
+
+# Calculate the length of string
+sub string_len
+{
+ my ($buffer) = @_;
+ my $anchor_flag = \$static{"string_len anchor_flag"}; # Flag: Inside hypertext anchor name ho4u_v_Ariom
+ my $lc_link_flag = \$static{"string_len lc_link_flag"}; # Flag: Inside hypertext link target name
+ my $backslash_flag = 0; # Flag: Backslash quoting
+ my $len = 0; # Result: the length of the string
+
+
+ foreach my $c (split //, $buffer)
+ {
+ if ($c eq $CHAR_LINK_POINTER)
+ {
+ $$lc_link_flag = 1; # Link target name starts
+ }
+ elsif ($c eq $CHAR_LINK_END)
+ {
+ $$lc_link_flag = 0; # Link target name ends
+ }
+ elsif ($c eq $CHAR_NODE_END)
+ {
+ # Node anchor name starts
+ $$anchor_flag = 1;
+ # Ugly hack to prevent loss of one space
+ $len++;
+ }
+ # Don't add control characters to the length
+ next if ord($c) >= 0 && ord($c) < 32;
+ # Attempt to handle backslash quoting
+ if ($c eq '\\' && !$backslash_flag)
+ {
+ $backslash_flag = 1;
+ next;
+ }
+ $backslash_flag = 0;
+ # Increase length if not inside anchor name or link target name
+ $len++ if !$$anchor_flag && !$$lc_link_flag;
+ if ($$anchor_flag && $c eq ']')
+ {
+ # Node anchor name ends
+ $$anchor_flag = 0;
+ }
+ }
+ return $len;
+}
+
+# Output the string
+sub print_string($)
+{
+ my ($buffer) = @_;
+ my $len; # The length of current word
+ my $backslash_flag = 0;
+ my $font_change_flag = 0;
+ my $quotes_flag = 0;
+
+ # Skipping lines?
+ return if $skip_flag;
+ # Copying verbatim?
+ if ($verbatim_flag)
+ {
+ # Attempt to handle backslash quoting
+ foreach (split //, $buffer)
+ {
+ if ($_ eq '\\' && !$backslash_flag)
+ {
+ $backslash_flag = 1;
+ next;
+ }
+ $backslash_flag = 0;
+ print $f_out $_;
+ }
+ }
+ else
+ {
+ # Split into words
+ $buffer = strtok($buffer, " \t\n");
+ # Repeat for each word
+ while (defined $buffer)
+ {
+ # Skip empty strings
+ if ($buffer ne '')
+ {
+ $len = string_len($buffer);
+ # Words are separated by spaces
+ if ($col > 0)
+ {
+ print $f_out ' ';
+ $col++;
+ }
+ elsif ($indentation)
+ {
+ print $f_out ' ' while $col++ < $indentation;
+ }
+ # Attempt to handle backslash quoting
+ foreach (split //, $buffer)
+ {
+ # handle quotes: \(lq, \(rq, \(dq
+ if ($quotes_flag != 0)
+ {
+ if (($_ eq 'l' || $_ eq 'r' || $_ eq 'd') && $quotes_flag == 1)
+ {
+ # continue quotes handling
+ $quotes_flag = 2;
+ next;
+ }
+ elsif ($_ eq 'q' && $quotes_flag == 2)
+ {
+ # finish quotes handling
+ $quotes_flag = 0;
+ print $f_out '"';
+ next;
+ }
+ else
+ {
+ print $f_out '(' . $_;
+ print_error "Syntax error: unsupported \\(" . $_ . " command";
+ }
+ }
+ # handle \fR, \fB, \fI and \fP commands
+ if ($font_change_flag)
+ {
+ if ($_ eq 'B')
+ {
+ print $f_out $CHAR_FONT_BOLD;
+ }
+ elsif ($_ eq 'I')
+ {
+ print $f_out $CHAR_FONT_ITALIC;
+ }
+ elsif ($_ eq 'R' || $_ eq 'P')
+ {
+ print $f_out $CHAR_FONT_NORMAL;
+ }
+ else
+ {
+ print $f_out 'f' . $_;
+ print_error "Syntax error: unsupported \\f" . $_ . " command";
+ }
+
+ $font_change_flag = 0;
+ next;
+ }
+ if ($_ eq '(' && $backslash_flag)
+ {
+ $quotes_flag = 1;
+ $backslash_flag = 0;
+ next;
+ }
+ if ($_ eq 'f' && $backslash_flag)
+ {
+ $font_change_flag = 1;
+ $backslash_flag = 0;
+ next;
+ }
+ if ($_ eq '\\' && !$backslash_flag)
+ {
+ $backslash_flag = 1;
+ next;
+ }
+ $backslash_flag = 0;
+ $font_change_flag = 0;
+ $quotes_flag = 0;
+ print $f_out $_;
+ }
+ # Increase column
+ $col += $len;
+ }
+ # Get the next word
+ $buffer = strtok(undef, " \t\n");
+ } # while
+ }
+}
+
+# Like print_string but with printf-like syntax
+sub printf_string
+{
+ print_string sprintf shift, @_;
+}
+
+# Handle NODE and .SH commands. is_sh is 1 for .SH, 0 for NODE
+# FIXME: Consider to remove first parameter
+sub handle_node($$)
+{
+ my ($buffer, $is_sh) = @_;
+ my ($len, $heading_level);
+
+ # If we already skipped a section, don't skip another
+ $skip_flag = 0 if $skip_flag == 2;
+
+ # Get the command parameters
+ $buffer = strtok(undef, "");
+ if (! defined $buffer)
+ {
+ print_error "Syntax error: .SH: no title";
+ return;
+ }
+ else
+ {
+ # Remove quotes
+ $buffer =~ s/^"// and $buffer =~ s/"$//;
+ # Calculate heading level
+ $heading_level = 0;
+ $heading_level++ while substr($buffer, $heading_level, 1) eq ' ';
+ # Heading level must be even
+ if ($heading_level % 2)
+ {
+ print_error "Syntax error: .SH: odd heading level";
+ }
+ if ($no_split_flag)
+ {
+ # Don't start a new section
+ newline;
+ print_string $buffer;
+ newline;
+ newline;
+ $no_split_flag = 0;
+ }
+ elsif ($skip_flag)
+ {
+ # Skipping title and marking text for skipping
+ $skip_flag = 2;
+ }
+ else
+ {
+ $buffer = substr($buffer, $heading_level);
+ if (! $is_sh || ! $node)
+ {
+ # Start a new section, but omit empty section names
+ if ($buffer ne '')
+ {
+ printf $f_out "%s[%s]", $CHAR_NODE_END, $buffer;
+ newline;
+ }
+
+ # Add section to the linked list
+ if (! defined $cnode)
+ {
+ $cnode = $nodes;
+ }
+ else
+ {
+ $cnode->{'next'} = struct_node();
+ $cnode = $cnode->{'next'};
+ }
+ $cnode->{'node'} = $buffer;
+ $cnode->{'lname'} = undef;
+ $cnode->{'next'} = undef;
+ $cnode->{'heading_level'} = $heading_level;
+ }
+ if ($is_sh)
+ {
+ $cnode->{'lname'} = $buffer;
+ print_string $buffer;
+ newline;
+ newline;
+ }
+ } # Start new section
+ } # Has parameters
+ $node = ! $is_sh;
+}
+
+# Convert character from the macro name to the font marker
+sub char_to_font($)
+{
+ my ($c) = @_;
+ my %font = (
+ 'R' => $CHAR_FONT_NORMAL,
+ 'B' => $CHAR_FONT_BOLD,
+ 'I' => $CHAR_FONT_ITALIC
+ );
+ return exists $font{$c} ? $font{$c} : chr(0);
+}
+
+#
+# Handle alternate font commands (.BR, .IR, .RB, .RI, .BI, .IB)
+# Return 0 if the command wasn't recognized, 1 otherwise
+#
+sub handle_alt_font($)
+{
+ my ($buffer) = @_;
+ my $in_quotes = 0;
+ my $alt_state = 0;
+
+ return 0 if length($buffer) != 3;
+ return 0 if substr($buffer, 0, 1) ne '.';
+
+ my @font = (
+ char_to_font substr($buffer, 1, 1),
+ char_to_font substr($buffer, 2, 1)
+ );
+
+ # Exclude names with unknown characters, .BB, .II and .RR
+ if ($font[0] eq chr(0) || $font[1] eq chr(0) || $font[0] eq $font[1])
+ {
+ return 0;
+ }
+
+ my $p = strtok(undef, "");
+ return 1 unless defined $p;
+
+ $buffer = $font[0];
+
+ my @p = split //, $p;
+ while (@p)
+ {
+
+ if ($p[0] eq '"')
+ {
+ $in_quotes = !$in_quotes;
+ shift @p;
+ next;
+ }
+
+ if ($p[0] eq ' ' && !$in_quotes)
+ {
+ shift @p;
+ # Don't change font if we are at the end
+ if (@p)
+ {
+ $alt_state = $alt_state ? 0 : 1;
+ $buffer .= $font[$alt_state];
+ }
+
+ # Skip more spaces
+ shift @p while @p && $p[0] eq ' ';
+
+ next;
+ }
+
+ $buffer .= shift @p;
+ }
+
+ # Turn off attributes if necessary
+ if ($font[$alt_state] ne $CHAR_FONT_NORMAL)
+ {
+ $buffer .= $CHAR_FONT_NORMAL;
+ }
+
+ print_string $buffer;
+
+ return 1;
+}
+
+# Handle .IP and .TP commands. is_tp is 1 for .TP, 0 for .IP
+sub handle_tp_ip($)
+{
+ my ($is_tp) = @_;
+ newline if $col > 0;
+ newline;
+ if ($is_tp)
+ {
+ $tp_flag = 1;
+ $indentation = 0;
+ }
+ else
+ {
+ $indentation = 8;
+ }
+}
+
+# Handle all the roff dot commands. See man groff_man for details
+sub handle_command($)
+{
+ my ($buffer) = @_;
+ my $len;
+
+ # Get the command name
+ $buffer = strtok($buffer, " \t");
+
+ if ($buffer eq ".SH")
+ {
+ $indentation = 0;
+ handle_node $buffer, 1;
+ }
+ elsif ($buffer eq ".\\\"NODE")
+ {
+ handle_node $buffer, 0;
+ }
+ elsif ($buffer eq ".\\\"DONT_SPLIT\"")
+ {
+ $no_split_flag = 1;
+ }
+ elsif ($buffer eq ".\\\"SKIP_SECTION\"")
+ {
+ $skip_flag = 1;
+ }
+ elsif ($buffer eq ".\\\"LINK2\"")
+ {
+ # Next two input lines form a link
+ $link_flag = 2;
+ }
+ elsif ($buffer eq ".PP" || $buffer eq ".P" || $buffer eq ".LP")
+ {
+ $indentation = 0;
+ # End of paragraph
+ newline if $col > 0;
+ newline;
+ }
+ elsif ($buffer eq ".nf")
+ {
+ # Following input lines are to be handled verbatim
+ $verbatim_flag = 1;
+ newline if $col > 0;
+ }
+ elsif ($buffer eq ".I" || $buffer eq ".B" || $buffer eq ".SB")
+ {
+ # Bold text or italics text
+ my $backslash_flag = 0;
+
+ # .SB [text]
+ # Causes the text on the same line or the text on the
+ # next line to appear in boldface font, one point
+ # size smaller than the default font.
+ #
+
+ # FIXME: text is optional, so there is no error
+
+ my $p = strtok(undef, "");
+ if (! defined $p)
+ {
+ print_error "Syntax error: .I | .B | .SB : no text";
+ return;
+ }
+
+ $buffer = substr($buffer, 1, 1) eq 'I' ? $CHAR_FONT_ITALIC : $CHAR_FONT_BOLD;
+
+ # Attempt to handle backslash quoting
+ foreach (split //, $p)
+ {
+ if ($_ eq '\\' && !$backslash_flag)
+ {
+ $backslash_flag = 1;
+ next;
+ }
+ $backslash_flag = 0;
+ $buffer .= $_;
+ }
+ print_string $buffer . $CHAR_FONT_NORMAL;
+ }
+ elsif ($buffer eq ".TP")
+ {
+ handle_tp_ip 1;
+ }
+ elsif ($buffer eq ".IP")
+ {
+ handle_tp_ip 0;
+ }
+ elsif ($buffer eq ".\\\"TOPICS")
+ {
+ if ($out_row > 1)
+ {
+ print_error "Syntax error: .\\\"TOPICS must be first command";
+ return;
+ }
+ $buffer = strtok(undef, "");
+ if (! defined $buffer)
+ {
+ print_error "Syntax error: .\\\"TOPICS: no text";
+ return;
+ }
+ # Remove quotes
+ $buffer =~ s/^"// and $buffer =~ s/"$//;
+ $topics = $buffer;
+ }
+ elsif ($buffer eq ".br")
+ {
+ newline if $col;
+ }
+ elsif ($buffer =~ /^\.\\"/)
+ {
+ # Comment { Hello from K.O. ;-) }
+ }
+ elsif ($buffer eq ".TH")
+ {
+ # Title header
+ }
+ elsif ($buffer eq ".SM")
+ {
+ # Causes the text on the same line or the text on the
+ # next line to appear in a font that is one point
+ # size smaller than the default font.
+ $buffer = strtok(undef, "");
+ print_string $buffer if defined $buffer;
+ }
+ elsif (handle_alt_font($buffer) == 1)
+ {
+ return;
+ }
+ elsif ($buffer eq ".RE")
+ {
+ newline;
+ }
+ else
+ {
+ # Other commands are ignored
+ print_error sprintf "Warning: unsupported command %s", $buffer;
+ return;
+ }
+}
+
+sub struct_links()
+{
+ return {
+ 'linkname' => undef, # Section name
+ 'line' => undef, # Input line in ...
+ 'filename' => undef,
+ 'next' => undef
+ }
+}
+
+my $links = struct_links();
+my $current_link;
+
+
+sub handle_link($)
+{
+ my ($buffer) = @_;
+ my $old = \$static{"handle_link old"};
+ my $len;
+ my $amp;
+ my $amp_arg;
+
+ if ($link_flag == 1)
+ {
+ # Old format link, not supported
+ }
+ elsif ($link_flag == 2)
+ {
+ # First part of new format link
+ # Bold text or italics text
+ if (substr($buffer, 0, 2) eq '.I' || substr($buffer, 0, 2) eq '.B')
+ {
+ $buffer =~ s/^..[\s\t]*//;
+ }
+ $$old = $buffer;
+ $link_flag = 3;
+
+ }
+ elsif ($link_flag == 3)
+ {
+ # Second part of new format link
+ $buffer =~ s/^\.//;
+ $buffer =~ s/^\\//;
+ $buffer =~ s/^"//;
+ $buffer =~ s/"$//;
+
+ # "Layout\&)," -- "Layout" should be highlighted, but not "),"
+ ($$old, $amp_arg) = split /\\&/, $$old, 2;
+ $amp_arg = "" unless defined $amp_arg;
+ printf_string "%s%s%s%s%s%s\n", $CHAR_LINK_START, $$old,
+ $CHAR_LINK_POINTER, $buffer, $CHAR_LINK_END, $amp_arg;
+ $link_flag = 0;
+ # Add to the linked list
+ if (defined $current_link)
+ {
+ $current_link->{'next'} = struct_links();
+ $current_link = $current_link->{'next'};
+ $current_link->{'next'} = undef;
+ }
+ else
+ {
+ $current_link = $links;
+ }
+ $current_link->{'linkname'} = $buffer;
+ $current_link->{'filename'} = $c_in;
+ $current_link->{'line'} = $in_row;
+ }
+}
+
+sub main
+{
+ my $len; # Length of input line
+ my $c_man; # Manual filename
+ my $c_tmpl; # Template filename
+ my $f_man; # Manual file
+ my $f_tmpl; # Template file
+ my $buffer; # Full input line
+ my $lc_node = undef;
+ my $outfile_buffer; # Large buffer to keep the output file
+ my $cont_start; # Start of [Contents]
+ my $file_end; # Length of the output file
+
+ # Validity check for arguments
+ if (@ARGV != 3)
+ {
+ warn "Usage: man2hlp file.man template_file helpfile\n";
+ return 3;
+ }
+
+ $c_man = $ARGV[0];
+ $c_tmpl = $ARGV[1];
+ $c_out = $ARGV[2];
+
+ # First stage - process the manual, write to the output file
+
+ $f_man = fopen_check "<", $c_man;
+ $f_out = fopen_check ">", $c_out;
+ $c_in = $c_man;
+
+ # Repeat for each input line
+ while (<$f_man>)
+ {
+ # Remove terminating newline
+ chomp;
+ $buffer = $_;
+ my $input_line; # Input line without initial "\&"
+
+ if (substr($buffer, 0, 2) eq '\\&')
+ {
+ $input_line = substr($buffer, 2);
+ }
+ else
+ {
+ $input_line = $buffer;
+ }
+
+ $in_row++;
+ $len = length($input_line);
+
+ if ($verbatim_flag)
+ {
+ # Copy the line verbatim
+ if ($input_line eq ".fi")
+ {
+ $verbatim_flag = 0;
+ }
+ else
+ {
+ print_string $input_line;
+ newline;
+ }
+ }
+ elsif ($link_flag)
+ {
+ # The line is a link
+ handle_link $input_line;
+ }
+ elsif (substr($buffer, 0, 1) eq '.')
+ {
+ # The line is a roff command
+ handle_command $input_line;
+ }
+ else
+ {
+ #A normal line, just output it
+ print_string $input_line;
+ }
+ # .TP label processed as usual line
+ if ($tp_flag)
+ {
+ if ($tp_flag == 1)
+ {
+ $tp_flag = 2;
+ }
+ else
+ {
+ $tp_flag = 0;
+ $indentation = 8;
+ if ($col >= $indentation)
+ {
+ newline;
+ }
+ else
+ {
+ print $f_out " " while ++$col < $indentation;
+ }
+ }
+ }
+ }
+
+ newline;
+ fclose_check $f_man;
+ # First stage ends here, closing the manual
+
+ # Second stage - process the template file
+ $f_tmpl = fopen_check "<", $c_tmpl;
+ $c_in = $c_tmpl;
+
+ # Repeat for each input line
+ # Read a line
+ while (<$f_tmpl>)
+ {
+ $buffer = $_;
+ if (defined $lc_node)
+ {
+ if ($buffer ne "\n")
+ {
+ $cnode->{'lname'} = $buffer;
+ chomp $cnode->{'lname'};
+ }
+ $lc_node = undef;
+ }
+ else
+ {
+ my $char_node_end = index($buffer, $CHAR_NODE_END);
+ $lc_node = $char_node_end < 0 ? undef : substr($buffer, $char_node_end);
+
+ if (defined $lc_node && substr($lc_node, 1, 1) eq '[')
+ {
+ my $p = index($lc_node, ']');
+ if ($p >= 0) {
+ if (substr($lc_node, 1, 6) eq '[main]')
+ {
+ $lc_node = undef;
+ }
+ else
+ {
+ if (! defined $cnode)
+ {
+ $cnode = $nodes;
+ }
+ else
+ {
+ $cnode->{'next'} = struct_node();
+ $cnode = $cnode->{'next'};
+ }
+ $cnode->{'node'} = substr($lc_node, 2, $p-2);
+ $cnode->{'lname'} = undef;
+ $cnode->{'next'} = undef;
+ $cnode->{'heading_level'} = 0;
+ }
+ }
+ else
+ {
+ $lc_node = undef;
+ }
+ }
+ else
+ {
+ $lc_node = undef;
+ }
+ }
+ print $f_out $buffer;
+ }
+
+ $cont_start = tell $f_out;
+ if ($cont_start <= 0)
+ {
+ perror $c_out;
+ return 1;
+ }
+
+ if ($topics)
+ {
+ printf $f_out "\004[Contents]\n%s\n\n", $topics;
+ }
+ else
+ {
+ print $f_out "\004[Contents]\n";
+ }
+
+ for ($current_link = $links; defined $current_link && defined $current_link->{'linkname'};)
+ {
+ my $found = 0;
+ my $next = $current_link->{'next'};
+
+ if ($current_link->{'linkname'} eq "Contents")
+ {
+ $found = 1;
+ }
+ else
+ {
+ for ($cnode = $nodes; defined $cnode && defined $cnode->{'node'}; $cnode = $cnode->{'next'})
+ {
+ if ($cnode->{'node'} eq $current_link->{'linkname'})
+ {
+ $found = 1;
+ last;
+ }
+ }
+ }
+ if (! $found)
+ {
+ $buffer = sprintf "Stale link \"%s\"", $current_link->{'linkname'};
+ $c_in = $current_link->{'filename'};
+ $in_row = $current_link->{'line'};
+ print_error $buffer;
+ }
+
+ $current_link = $next;
+ }
+
+ for ($cnode = $nodes; defined $cnode && defined $cnode->{'node'};)
+ {
+ my $next = $cnode->{'next'};
+ $lc_node = $cnode->{'node'};
+
+ if (defined $lc_node && $lc_node ne '') {
+ printf $f_out " %*s\001%s\002%s\003", $cnode->{'heading_level'},
+ "", $cnode->{'lname'} ? $cnode->{'lname'} : $lc_node, $lc_node;
+ }
+ print $f_out "\n";
+ $cnode = $next;
+ }
+
+ $file_end = tell $f_out;
+
+ # Sanity check
+ if (($file_end <= 0) || ($file_end - $cont_start <= 0))
+ {
+ warn $c_out ."\n";
+ return 1;
+ }
+
+ fclose_check $f_out;
+ fclose_check $f_tmpl;
+ # Second stage ends here, closing all files, note the end of output
+
+ #
+ # Third stage - swap two parts of the output file.
+ # First, open the output file for reading and load it into the memory.
+ #
+ $outfile_buffer = '';
+ $f_out = fopen_check '<', $c_out;
+ $outfile_buffer .= $_ while <$f_out>;
+ fclose_check $f_out;
+ # Now the output file is in the memory
+
+ # Again open output file for writing
+ $f_out = fopen_check '>', $c_out;
+
+ # Write part after the "Contents" node
+ print $f_out substr($outfile_buffer, $cont_start, $file_end - $cont_start);
+
+ # Write part before the "Contents" node
+ print $f_out substr($outfile_buffer, 0, $cont_start-1);
+ print $f_out "\n";
+ fclose_check $f_out;
+
+ return 0;
+}
+
+exit main();
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-26 06:02:34 +0000