texi2html

来自「FFTW, a collection of fast C routines to」· 代码 · 共 2,095 行 · 第 1/4 页

	    push(@lines, "\n");
	    $_ = &debug("\n", __LINE__);
	    &html_pop;
	}
    } elsif ($html_element eq 'body' || $html_element eq 'BLOCKQUOTE') {
	push(@lines, "<P>\n");
	&html_push('P');
	$_ = &debug($_, __LINE__);
    }
    # otherwise
    push(@lines, $_);
}

# finish TOC
$level = 0;
while ($level < $curlevel) {
    $curlevel--;
    push(@toc_lines, "</UL>\n");
}

print "# end of pass 1\n" if $verbose;

#+++############################################################################
#                                                                              #
# Pass 2/3: handle style, menu, index, cross-reference                         #
#                                                                              #
#---############################################################################

@lines2 = ();				# whole document (2nd pass)
@lines3 = ();				# whole document (3rd pass)
$in_menu = 0;				# am I inside a menu

while (@lines) {
    $_ = shift(@lines);
    #
    # special case (protected sections)
    #
    if (/^$PROTECTTAG/o) {
	push(@lines2, $_);
	next;
    }
    #
    # menu
    #
    $in_menu = 1, push(@lines2, &debug("<UL>\n", __LINE__)), next if /^\@menu\b/;
    $in_menu = 0, push(@lines2, &debug("</UL>\n", __LINE__)), next if /^\@end\s+menu\b/;
    if ($in_menu) {
	if (/^\*\s+($NODERE)::/o) {
	    $descr = $';
	    chop($descr);
	    &menu_entry($1, $1, $descr);
	} elsif (/^\*\s+(.+):\s+([^\t,\.\n]+)[\t,\.\n]/) {
	    $descr = $';
	    chop($descr);
	    &menu_entry($1, $2, $descr);
	} elsif (/^\*/) {
	    warn "$ERROR Bad menu line: $_";
	} else { # description continued?
	    push(@lines2, $_);
	}
	next;
    }
    #
    # printindex
    #
    if (/^\@printindex\s+(\w\w)\b/) {
	local($index, *ary, @keys, $key, $letter, $last_letter, @refs);
	if ($predefined_index{$1}) {
	    $index = $predefined_index{$1} . 'index';
	} else {
	    $index = $1 . 'index';
	}
	eval("*ary = *$index");
	@keys = keys(%ary);
	foreach $key (@keys) {
	    $_ = $key;
	    1 while s/<(\w+)>\`(.*)\'<\/\1>/$2/; # remove HTML tags with quotes
	    1 while s/<(\w+)>(.*)<\/\1>/$2/;     # remove HTML tags
	    $_ = &unprotect_html($_);
	    &unprotect_texi;
	    tr/A-Z/a-z/; # lowercase
	    $key2alpha{$key} = $_;
	    print "# index $key sorted as $_\n"
		if $key ne $_ && $debug & $DEBUG_INDEX;
	}
	push(@lines2, "Jump to:\n");
	$last_letter = undef;
	foreach $key (sort byalpha @keys) {
	    $letter = substr($key2alpha{$key}, 0, 1);
	    $letter = substr($key2alpha{$key}, 0, 2) if $letter eq $;;
	    if (!defined($last_letter) || $letter ne $last_letter) {
		push(@lines2, "-\n") if defined($last_letter);
		push(@lines2, "<A HREF=\"#$index\_$letter\">" . &protect_html($letter) . "</A>\n");
		$last_letter = $letter;
	    }
	}
	push(@lines2, "<P>\n");
	$last_letter = undef;
	foreach $key (sort byalpha @keys) {
	    $letter = substr($key2alpha{$key}, 0, 1);
	    $letter = substr($key2alpha{$key}, 0, 2) if $letter eq $;;
	    if (!defined($last_letter) || $letter ne $last_letter) {
		push(@lines2, "</DIR>\n") if defined($last_letter);
		push(@lines2, "<H2><A NAME=\"$index\_$letter\">" . &protect_html($letter) . "</A></H2>\n");
		push(@lines2, "<DIR>\n");
		$last_letter = $letter;
	    }
	    @refs = ();
	    foreach (split(/$;/, $ary{$key})) {
		push(@refs, &anchor('', $_, $key, 0));
	    }
	    push(@lines2, "<LI>" . join(", ", @refs) . "\n");
	}
	push(@lines2, "</DIR>\n") if defined($last_letter);
	next;
    }
    #
    # simple style substitutions
    #
    $_ = &substitute_style($_);
    #
    # xref
    #
    while (/\@(x|px|info|)ref{($XREFRE)(}?)/o) {
	# note: Texinfo may accept other characters
	($type, $nodes, $full) = ($1, $2, $3);
	($before, $after) = ($`, $');
	if (! $full && $after) {
	    warn "$ERROR Bad xref (no ending } on line): $_";
	    $_ = "$before$;0${type}ref\{$nodes$after";
	    next; # while xref
	}
	if ($type eq 'x') {
	    $type = 'See ';
	} elsif ($type eq 'px') {
	    $type = 'see ';
	} elsif ($type eq 'info') {
	    $type = 'See Info';
	} else {
	    $type = '';
	}
	unless ($full) {
	    $next = shift(@lines);
	    $next = &substitute_style($next);
	    chop($nodes); # remove final newline
	    if ($next =~ /\}/) { # split on 2 lines
		$nodes .= " $`";
		$after = $';
	    } else {
		$nodes .= " $next";
		$next = shift(@lines);
		$next = &substitute_style($next);
		chop($nodes);
		if ($next =~ /\}/) { # split on 3 lines
		    $nodes .= " $`";
		    $after = $';
		} else {
		    warn "$ERROR Bad xref (no ending }): $_";
		    $_ = "$before$;0xref\{$nodes$after";
		    unshift(@lines, $next);
		    next; # while xref
		}
	    }
	}
	$nodes =~ s/\s+/ /g; # remove useless spaces
	@args = split(/\s*,\s*/, $nodes);
	$node = $args[0]; # the node is always the first arg
	&normalise_node($node);
	$sec = $node2sec{$node};
	if (@args == 5) { # reference to another manual
	    $sec = $args[2] || $node;
	    $man = $args[4] || $args[3];
	    $_ = "${before}${type}Section `$sec' in \@cite{$man}$after";
	} elsif ($type =~ /Info/) { # inforef
	    warn "$ERROR Wrong number of arguments: $_" unless @args == 3;
	    ($nn, $_, $in) = @args;
	    $_ = "${before}${type} file `$in', node `$nn'$after";
	} elsif ($sec) {
	    $href = $node2href{$node};
	    $_ = "${before}${type}Section " . &anchor('', $href, $sec) . $after;
	} else {
	    warn "$ERROR Undefined node ($node): $_";
	    $_ = "$before$;0xref{$nodes}$after";
	}
    }
    #
    # try to guess bibliography references or glossary terms
    #
    unless (/^<H\d><A NAME=\"SEC\d/) {
	if ($use_bibliography) {
	    $done = '';
	    while (/$BIBRE/o) {
		($pre, $what, $post) = ($`, $&, $');
		$href = $bib2href{$what};
		if (defined($href) && $post !~ /^[^<]*<\/A>/) {
		    $done .= $pre . &anchor('', $href, $what);
		} else {
		    $done .= "$pre$what";
		}
		$_ = $post;
	    }
	    $_ = $done . $_;
	}
	if ($use_glossary) {
	    $done = '';
	    while (/\b\w+\b/) {
		($pre, $what, $post) = ($`, $&, $');
		$entry = $what;
		$entry =~ tr/A-Z/a-z/ unless $entry =~ /^[A-Z\s]+$/;
		$href = $gloss2href{$entry};
		if (defined($href) && $post !~ /^[^<]*<\/A>/) {
		    $done .= $pre . &anchor('', $href, $what);
		} else {
		    $done .= "$pre$what";
		}
		$_ = $post;
	    }
	    $_ = $done . $_;
	}
    }
    # otherwise
    push(@lines2, $_);
}
print "# end of pass 2\n" if $verbose;

#
# split style substitutions
#
while (@lines2) {
    $_ = shift(@lines2);
    #
    # special case (protected sections)
    #
    if (/^$PROTECTTAG/o) {
	push(@lines3, $_);
	next;
    }
    #
    # split style substitutions
    #
    $old = '';
    while ($old ne $_) {
        $old = $_;
	if (/\@(\w+)\{/) {
	    ($before, $style, $after) = ($`, $1, $');
	    if (defined($style_map{$style})) {
		$_ = $after;
		$text = '';
		$after = '';
		$failed = 1;
		while (@lines2) {
		    if (/\}/) {
			$text .= $`;
			$after = $';
			$failed = 0;
			last;
		    } else {
			$text .= $_;
			$_ = shift(@lines2);
		    }
		}
		if ($failed) {
		    die "* Bad syntax (\@$style) after: $before\n";
		} else {
		    $text = &apply_style($style, $text);
		    $_ = "$before$text$after";
		}
	    }
	}
    }
    # otherwise
    push(@lines3, $_);
}
print "# end of pass 3\n" if $verbose;

#+++############################################################################
#                                                                              #
# Pass 4: foot notes, final cleanup                                            #
#                                                                              #
#---############################################################################

@foot_lines = ();			# footnotes
@doc_lines = ();			# final document
$end_of_para = 0;			# true if last line is <P>

while (@lines3) {
    $_ = shift(@lines3);
    #
    # special case (protected sections)
    #
    if (/^$PROTECTTAG/o) {
	push(@doc_lines, $_);
	$end_of_para = 0;
	next;
    }
    #
    # footnotes
    #
    while (/\@footnote([^\{\s]+)\{/) {
	($before, $d, $after) = ($`, $1, $');
	$_ = $after;
	$text = '';
	$after = '';
	$failed = 1;
	while (@lines3) {
	    if (/\}/) {
		$text .= $`;
		$after = $';
		$failed = 0;
		last;
	    } else {
		$text .= $_;
		$_ = shift(@lines3);
	    }
	}
	if ($failed) {
	    die "* Bad syntax (\@footnote) after: $before\n";
	} else {
	    $foot_num++;
	    $docid  = "DOCF$foot_num";
	    $footid = "FOOT$foot_num";
	    $foot = "($foot_num)";
	    push(@foot_lines, "<H3>" . &anchor($footid, "$d#$docid", $foot) . "</H3>\n");
	    $text = "<P>$text" unless $text =~ /^\s*<P>/;
	    push(@foot_lines, "$text\n");
	    $_ = $before . &anchor($docid, "$docu_foot#$footid", $foot) . $after;
	}
    }
    #
    # remove unnecessary <P>
    #
    if (/^\s*<P>\s*$/) {
	next if $end_of_para++;
    } else {
	$end_of_para = 0;
    }
    # otherwise
    push(@doc_lines, $_);
}
print "# end of pass 4\n" if $verbose;

#+++############################################################################
#                                                                              #
# Pass 5: print things                                                         #
#                                                                              #
#---############################################################################

$header = <<EOT;
<!-- This HTML file has been created by $THISPROG
     from $docu on $TODAY -->
EOT

$full_title = $value{'_title'} || $value{'_settitle'} || "Untitled Document";
$title = $value{'_settitle'} || $full_title;
$_ = &substitute_style($full_title);
&unprotect_texi;
s/\n$//; # rmv last \n (if any)
$full_title = "<H1>" . join("</H1>\n<H1>", split(/\n/, $_)) . "</H1>\n";

#
# print ToC
#
if (!$monolithic && @toc_lines) {
    if (open(FILE, "> $docu_toc")) {
	print "# creating $docu_toc...\n" if $verbose;
	&print_toplevel_header("$title - Table of Contents");
	&print_ruler;
	&print(*toc_lines, FILE);
	&print_toplevel_footer;
	close(FILE);
    } else {
	warn "$ERROR Can't write to $docu_toc: $!\n";
    }
}

#
# print footnotes
#
if (!$monolithic && @foot_lines) {
    if (open(FILE, "> $docu_foot")) {
	print "# creating $docu_foot...\n" if $verbose;
	&print_toplevel_header("$title - Footnotes");
	&print_ruler;
        &print(*foot_lines, FILE);
	&print_toplevel_footer;
	close(FILE);
    } else {
	warn "$ERROR Can't write to $docu_foot: $!\n";
    }
}

#
# print document
#
if ($split_chapter || $split_node) { # split
    $doc_num = 0;
    $last_num = scalar(@sections);
    $first_doc = &doc_name(1);
    $last_doc = &doc_name($last_num);
    while (@sections) {
	$section = shift(@sections);
	&next_doc;
	if (open(FILE, "> $docu_doc")) {
	    print "# creating $docu_doc...\n" if $verbose;
	    &print_header("$title - $section");
	    $prev_doc = ($doc_num == 1 ? undef : &doc_name($doc_num - 1));
	    $next_doc = ($doc_num == $last_num ? undef : &doc_name($doc_num + 1));
	    $navigation = "Go to the ";
	    $navigation .= ($prev_doc ? &anchor('', $first_doc, "first") : "first");
	    $navigation .= ", ";
	    $navigation .= ($prev_doc ? &anchor('', $prev_doc, "previous") : "previous");
	    $navigation .= ", ";
	    $navigation .= ($next_doc ? &anchor('', $next_doc, "next") : "next");
	    $navigation .= ", ";
	    $navigation .= ($next_doc ? &anchor('', $last_doc, "last") : "last");
	    $navigation .= " section, " . &anchor('', $docu_toc, "table of contents") . ".\n";
	    print FILE $navigation;
	    &print_ruler;
	    # find corresponding lines
            @tmp_lines = ();
            while (@doc_lines) {
		$_ = shift(@doc_lines);
		last if ($_ eq $SPLITTAG);
		push(@tmp_lines, $_);
	    }
            &print(*tmp_lines, FILE);
	    &print_ruler;
	    print FILE $navigation;
	    &print_footer;
	    close(FILE);
	} else {
	    warn "$ERROR Can't write to $docu_doc: $!\n";
	}
    }
} else { # not split
    if (open(FILE, "> $docu_doc")) {
	print "# creating $docu_doc...\n" if $verbose;
	if ($monolithic || !@toc_lines) {
	    &print_toplevel_header($title);
	} else {
	    &print_header($title);
	    print FILE $full_title;
	}
	if ($monolithic && @toc_lines) {
	    &print_ruler;
 	    print FILE "<H1>Table of Contents</H1>\n";
 	    &print(*toc_lines, FILE);
	}
	&print_ruler;
        &print(*doc_lines, FILE);
	if ($monolithic && @foot_lines) {
	    &print_ruler;
 	    print FILE "<H1>Footnotes</H1>\n";
 	    &print(*foot_lines, FILE);
	}
	if ($monolithic || !@toc_lines) {
	    &print_toplevel_footer;
	} else {
	    &print_footer;
	}
	close(FILE);
    } else {
	warn "$ERROR Can't write to $docu_doc: $!\n";
    }
}

print "# that's all folks\n" if $verbose;

#+++############################################################################
#                                                                              #
# Low level functions                                                          #
#                                                                              #
#---############################################################################

sub update_sec_num {
    local($name, $level) = @_;

    $level--; # here we start at 0
    if ($name =~ /^appendix/) {
	# appendix style
	if (defined(@appendix_sec_num)) {
	    &incr_sec_num($level, @appendix_sec_num);
	} else {
	    @appendix_sec_num = ('A', 0, 0, 0);
	}
	return(join('.', @appendix_sec_num[0..$level]));
    } else {
	# normal style
	if (defined(@normal_sec_num)) {
	    &incr_sec_num($level, @normal_sec_num);
	} else {
	    @normal_sec_num = (1, 0, 0, 0);
	}
	return(join('.', @normal_sec_num[0..$level]));
    }
}

sub incr_sec_num {
    local($level, $l);
    $level = shift(@_);
    $_[$level]++;
    foreach $l ($level+1 .. 3) {
	$_[$l] = 0;
    }
}

sub check {
    local($_, %seen, %context, $before, $match, $after);

    while (<>) {
	if (/\@(\*|\.|\:|\@|\{|\})/) {
	    $seen{$&}++;
	    $context{$&} .= "> $_" if $verbose;
	    $_ = "$`XX$'";
	    redo;
	}
	if (/\@(\w+)/) {
	    ($before, $match, $after) = ($`, $&, $');
	    if ($before =~ /\b[\w-]+$/ && $after =~ /^[\w-.]*\b/) { # e-mail address
		$seen{'e-mail address'}++;
		$context{'e-mail address'} .= "> $_" if $verbose;
	    } else {
		$seen{$match}++;
		$context{$match} .= "> $_" if $verbose;