texi2html

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

    #
    $tag = '';
    $end_tag = '';
    if (/^\@end\s+(\w+)\b/) {
	$end_tag = $1;
    } elsif (/^\@(\w+)\b/) {
	$tag = $1;
    }
    #
    # handle @ifhtml / @end ifhtml
    #
    if ($in_html) {
	if ($end_tag eq 'ifhtml') {
	    $in_html = 0;
	} else {
	    $tag2pro{$in_html} .= $_;
	}
	next;
    } elsif ($tag eq 'ifhtml') {
	$in_html = $PROTECTTAG . ++$html_num;
	push(@lines, $in_html);
	next;
    }
    #
    # try to skip the line
    #
    if ($end_tag) {
	next if $to_skip{"end $end_tag"};
    } elsif ($tag) {
	next if $to_skip{$tag};
	last if $tag eq 'bye';
    }
    if ($in_top) {
	# parsing the top node
	if ($tag eq 'node' || $tag eq 'include' || $sec2level{$tag}) {
	    # no more in top
	    $in_top = 0;
	} else {
	    # skip it
	    next;
	}
    }
    #
    # try to remove inlined comments
    # syntax from tex-mode.el comment-start-skip
    #
    s/((^|[^\@])(\@\@)*)\@c(omment)? .*/$1/;
    # non-@ substitutions cf. texinfmt.el
    unless ($in_pre) {
	s/``/\"/g;
	s/''/\"/g;
	s/([\w ])---([\w ])/$1--$2/g;
    }
    #
    # analyze the tag
    #
    if ($tag) {
	# skip lines
	&skip_until($tag), next if $tag eq 'ignore';
	if ($expandinfo) {
	    &skip_until($tag), next if $tag eq 'iftex';
	} else {
	    &skip_until($tag), next if $tag eq 'ifinfo';
	}
	&skip_until($tag), next if $tag eq 'tex';
	# handle special tables
	if ($tag =~ /^(|f|v|multi)table$/) {
	    $table_type = $1;
	    $tag = 'table';
	}
	# special cases
	if ($tag eq 'top' || ($tag eq 'node' && /^\@node\s+top\s*,/i)) {
	    $in_top = 1;
	    @lines = (); # ignore all lines before top (title page garbage)
	    next;
	} elsif ($tag eq 'node') {
	    $in_top = 0;
	    warn "$ERROR Bad node line: $_" unless $_ =~ /^\@node\s$NODESRE$/o;
	    $_ = &protect_html($_); # if node contains '&' for instance
	    s/^\@node\s+//;
	    ($node) = split(/,/);
	    &normalise_node($node);
	    if ($split_node) {
		&next_doc;
		push(@lines, $SPLITTAG) if $split_num++;
		push(@sections, $node);
	    }
	    next;
	} elsif ($tag eq 'include') {
	    if (/^\@include\s+($FILERE)\s*$/o) {
		$file = $1;
		unless (-e $file) {
		    foreach $dir (@include_dirs) {
			$file = "$dir/$1";
			last if -e $file;
		    }
		}
		if (-e $file) {
		    &open($file);
		    print "# including $file\n" if $verbose;
		} else {
		    warn "$ERROR Can't find $file, skipping";
		}
	    } else {
		warn "$ERROR Bad include line: $_";
	    }
	    next;
	} elsif ($tag eq 'ifclear') {
	    if (/^\@ifclear\s+($VARRE)\s*$/o) {
		next unless defined($value{$1});
		&skip_until($tag);
	    } else {
		warn "$ERROR Bad ifclear line: $_";
	    }
	    next;
	} elsif ($tag eq 'ifset') {
	    if (/^\@ifset\s+($VARRE)\s*$/o) {
		next if defined($value{$1});
		&skip_until($tag);
	    } else {
		warn "$ERROR Bad ifset line: $_";
	    }
	    next;
	} elsif ($tag eq 'menu') {
	    unless ($show_menu) {
		&skip_until($tag);
		next;
	    }
	    &html_push_if($tag);
	    push(@lines, &html_debug("\n", __LINE__));
	} elsif ($format_map{$tag}) {
	    $in_pre = 1 if $format_map{$tag} eq 'PRE';
	    &html_push_if($format_map{$tag});
	    push(@lines, &html_debug("\n", __LINE__));
	    $in_list++ if $format_map{$tag} eq 'UL' || $format_map{$tag} eq 'OL' ;
	    push(@lines, &debug("<$format_map{$tag}>\n", __LINE__));
	    next;
	} elsif ($tag eq 'table') {
	    if (/^\@(|f|v|multi)table\s+\@(\w+)/) {
		$in_table = $2;
		unshift(@tables, join($;, $table_type, $in_table));
		if ($table_type eq "multi") {
		    push(@lines, &debug("<TABLE BORDER>\n", __LINE__));
		    &html_push_if('TABLE');
		} else {
		    push(@lines, &debug("<DL COMPACT>\n", __LINE__));
		    &html_push_if('DL');
		}
		push(@lines, &html_debug("\n", __LINE__));
	    } else {
		warn "$ERROR Bad table line: $_";
	    }
	    next;
	} elsif ($tag eq 'synindex' || $tag eq 'syncodeindex') {
	    if (/^\@$tag\s+(\w\w?)\s+(\w\w?)\s*$/) {
		eval("*${1}index = *${2}index");
	    } else {
		warn "$ERROR Bad syn*index line: $_";
	    }
	    next;
	} elsif ($tag eq 'sp') {
	    push(@lines, &debug("<P>\n", __LINE__));
	    next;
	} elsif ($tag eq 'setref') {
	    &protect_html; # if setref contains '&' for instance
	    if (/^\@$tag\s*{($NODERE)}\s*$/) {
		$setref = $1;
		$setref =~ s/\s+/ /g; # normalize
		$setref =~ s/ $//;
		$node2sec{$setref} = $name;
		$node2href{$setref} = "$docu_doc#$docid";
	    } else {
		warn "$ERROR Bad setref line: $_";
	    }
	    next;
	} elsif ($tag eq 'defindex' || $tag eq 'defcodeindex') {
	    if (/^\@$tag\s+(\w\w)\s*$/) {
		$valid_index{$1} = 1;
	    } else {
		warn "$ERROR Bad defindex line: $_";
	    }
	    next;
	} elsif (defined($def_map{$tag})) {
	    if ($def_map{$tag}) {
		s/^\@$tag\s+//;
		$tag = $def_map{$tag};
		$_ = "\@$tag $_";
		$tag =~ s/\s.*//;
	    }
	} elsif (defined($user_sub{$tag})) {
	    s/^\@$tag\s+//;
	    $sub = $user_sub{$tag};
	    print "# user $tag = $sub, arg: $_" if $debug & $DEBUG_USER;
	    if (defined(&$sub)) {
		chop($_);
		&$sub($_);
	    } else {
		warn "$ERROR Bad user sub for $tag: $sub\n";
	    }
	    next;
	}
	if (defined($def_map{$tag})) {
	    s/^\@$tag\s+//;
	    if ($tag =~ /x$/) {
		# extra definition line
		$tag = $`;
		$is_extra = 1;
	    } else {
		$is_extra = 0;
	    }
	    while (/\{([^\{\}]*)\}/) {
		# this is a {} construct
		($before, $contents, $after) = ($`, $1, $');
		# protect spaces
		$contents =~ s/\s+/$;9/g;
		# restore $_ protecting {}
		$_ = "$before$;7$contents$;8$after";
	    }
	    @args = split(/\s+/, &protect_html($_));
	    foreach (@args) {
		s/$;9/ /g;	# unprotect spaces
		s/$;7/\{/g;	# ... {
		s/$;8/\}/g;	# ... }
	    }
	    $type = shift(@args);
	    $type =~ s/^\{(.*)\}$/$1/;
	    print "# def ($tag): {$type} ", join(', ', @args), "\n"
		if $debug & $DEBUG_DEF;
	    $type .= ':'; # it's nicer like this
	    $name = shift(@args);
	    $name =~ s/^\{(.*)\}$/$1/;
	    if ($is_extra) {
		$_ = &debug("<DT>", __LINE__);
	    } else {
		$_ = &debug("<DL>\n<DT>", __LINE__);
	    }
	    if ($tag eq 'deffn' || $tag eq 'defvr' || $tag eq 'deftp') {
		$_ .= "<U>$type</U> <B>$name</B>";
		$_ .= " <I>@args</I>" if @args;
	    } elsif ($tag eq 'deftypefn' || $tag eq 'deftypevr'
		     || $tag eq 'defcv' || $tag eq 'defop') {
		$ftype = $name;
		$name = shift(@args);
		$name =~ s/^\{(.*)\}$/$1/;
		$_ .= "<U>$type</U> $ftype <B>$name</B>";
		$_ .= " <I>@args</I>" if @args;
	    } else {
		warn "$ERROR Unknown definition type: $tag\n";
		$_ .= "<U>$type</U> <B>$name</B>";
		$_ .= " <I>@args</I>" if @args;
	    }
 	    $_ .= &debug("\n<DD>", __LINE__);
	    $name = &unprotect_html($name);
	    if ($tag eq 'deffn' || $tag eq 'deftypefn') {
		unshift(@input_spool, "\@findex $name\n");
	    } elsif ($tag eq 'defop') {
		unshift(@input_spool, "\@findex $name on $ftype\n");
	    } elsif ($tag eq 'defvr' || $tag eq 'deftypevr' || $tag eq 'defcv') {
		unshift(@input_spool, "\@vindex $name\n");
	    } else {
		unshift(@input_spool, "\@tindex $name\n");
	    }
	    $dont_html = 1;
	}
    } elsif ($end_tag) {
	if ($format_map{$end_tag}) {
	    $in_pre = 0 if $format_map{$end_tag} eq 'PRE';
	    $in_list-- if $format_map{$end_tag} eq 'UL' || $format_map{$end_tag} eq 'OL' ;
	    &html_pop_if('LI', 'P');
	    &html_pop_if();
	    push(@lines, &debug("</$format_map{$end_tag}>\n", __LINE__));
	    push(@lines, &html_debug("\n", __LINE__));
	} elsif ($end_tag =~ /^(|f|v|multi)table$/) {
	    unless (@tables) {
		warn "$ERROR \@end $end_tag without \@*table\n";
		next;
	    }
	    ($table_type, $in_table) = split($;, shift(@tables));
	    unless ($1 eq $table_type) {
		warn "$ERROR \@end $end_tag without matching \@$end_tag\n";
		next;
	    }
	    if ($table_type eq "multi") {
		push(@lines, "</TR></TABLE>\n");
		&html_pop_if('TR');
	    } else {
		push(@lines, "</DL>\n");
		&html_pop_if('DD');
	    }
	    &html_pop_if();
	    if (@tables) {
		($table_type, $in_table) = split($;, $tables[0]);
	    } else {
		$in_table = 0;
	    }
	} elsif (defined($def_map{$end_tag})) {
 	    push(@lines, &debug("</DL>\n", __LINE__));
	} elsif ($end_tag eq 'menu') {
	    &html_pop_if();
	    push(@lines, $_); # must keep it for pass 2
	}
	next;
    }
    #
    # misc things
    #
    # protect texi and HTML things
    &protect_texi;
    $_ = &protect_html($_) unless $dont_html;
    $dont_html = 0;
    # substitution (unsupported things)
    s/^\@center\s+//g;
    s/^\@exdent\s+//g;
    s/\@noindent\s+//g;
    s/\@refill\s+//g;
    # other substitutions
    &simple_substitutions;
    s/\@value{($VARRE)}/$value{$1}/eg;
    s/\@footnote\{/\@footnote$docu_doc\{/g; # mark footnotes, cf. pass 4
    #
    # analyze the tag again
    #
    if ($tag) {
	if (defined($sec2level{$tag}) && $sec2level{$tag} > 0) {
	    if (/^\@$tag\s+(.+)$/) {
		$name = $1;
		$name =~ s/\s+$//;
		$level = $sec2level{$tag};
		$name = &update_sec_num($tag, $level) . "  $name"
		    if $number_sections && $tag !~ /^unnumbered/;
		if ($tag =~ /heading$/) {
		    push(@lines, &html_debug("\n", __LINE__));
		    if ($html_element ne 'body') {
			# We are in a nice pickle here. We are trying to get a H? heading
			# even though we are not in the body level. So, we convert it to a
			# nice, bold, line by itself.
			$_ = &debug("\n\n<P><STRONG>$name</STRONG>\n\n", __LINE__);
		    } else {
			$_ = &debug("<H$level>$name</H$level>\n", __LINE__);
			&html_push_if('body');
		    }
		    print "# heading, section $name, level $level\n"
			if $debug & $DEBUG_TOC;
		} else {
		    if ($split_chapter) {
			unless ($toplevel) {
			    # first time we see a "section"
			    unless ($level == 1) {
				warn "$ERROR The first section found is not of level 1: $_";
				warn "$ERROR I'll split on sections of level $level...\n";
			    }
			    $toplevel = $level;
			}
			if ($level == $toplevel) {
			    &next_doc;
			    push(@lines, $SPLITTAG) if $split_num++;
			    push(@sections, $name);
			}
		    }
		    $sec_num++;
		    $docid = "SEC$sec_num";
		    $tocid = "TOC$sec_num";
		    # check biblio and glossary
		    $in_bibliography = ($name =~ /^([A-Z]|\d+)?(\.\d+)*\s*bibliography$/i);
		    $in_glossary = ($name =~ /^([A-Z]|\d+)?(\.\d+)*\s*glossary$/i);
		    # check node
		    if ($node) {
			if ($node2sec{$node}) {
			    warn "$ERROR Duplicate node found: $node\n";
			} else {
			    $node2sec{$node} = $name;
			    $node2href{$node} = "$docu_doc#$docid";
			    print "# node $node, section $name, level $level\n"
				if $debug & $DEBUG_TOC;
			}
			$node = '';
		    } else {
			print "# no node, section $name, level $level\n"
			    if $debug & $DEBUG_TOC;
		    }
		    # update TOC
		    while ($level > $curlevel) {
			$curlevel++;
			push(@toc_lines, "<UL>\n");
		    }
		    while ($level < $curlevel) {
			$curlevel--;
			push(@toc_lines, "</UL>\n");
		    }
		    $_ = "<LI>" . &anchor($tocid, "$docu_doc#$docid", $name, 1);
		    push(@toc_lines, &substitute_style($_));
		    # update DOC
		    push(@lines, &html_debug("\n", __LINE__));
		    &html_reset;
		    if ($no_toc_href) {
			$_ =  "<H$level>" . &anchor($docid, "", $name) . "</H$level>\n";
		    } else {
			$_ =  "<H$level>" . &anchor($docid, "$docu_toc#$tocid", $name) . "</H$level>\n";
		    }
		    $_ = &debug($_, __LINE__);
		    push(@lines, &html_debug("\n", __LINE__));
		}
		# update DOC
		foreach $line (split(/\n+/, $_)) {
		    push(@lines, "$line\n");
		}
		next;
	    } else {
		warn "$ERROR Bad section line: $_";
	    }
	} else {
	    # track variables
	    $value{$1} = $2, next if /^\@set\s+($VARRE)\s+(.*)$/o;
	    delete $value{$1}, next if /^\@clear\s+($VARRE)\s*$/o;
	    # store things
	    $value{'_setfilename'}   = $1, next if /^\@setfilename\s+(.*)$/;
	    $value{'_settitle'}      = $1, next if /^\@settitle\s+(.*)$/;
	    $value{'_author'}   .= "$1\n", next if /^\@author\s+(.*)$/;
	    $value{'_subtitle'} .= "$1\n", next if /^\@subtitle\s+(.*)$/;
	    $value{'_title'}    .= "$1\n", next if /^\@title\s+(.*)$/;
	    # index
	    if (/^\@(..?)index\s+/) {
		unless ($valid_index{$1}) {
		    warn "$ERROR Undefined index command: $_";
		    next;
		}
		$id = 'IDX' . ++$idx_num;
		$index = $1 . 'index';
		$what = &substitute_style($');
		$what =~ s/\s+$//;
		print "# found $index for '$what' id $id\n"
		    if $debug & $DEBUG_INDEX;
		eval(<<EOC);
		if (defined(\$$index\{\$what\})) {
		    \$$index\{\$what\} .= "$;$docu_doc#$id";
		} else {
		    \$$index\{\$what\} = "$docu_doc#$id";
		}
EOC

		#
		# dirty hack to see if I can put an invisible anchor...
		#
		if ($html_element eq 'P' ||
		    $html_element eq 'LI' ||
		    $html_element eq 'DT' ||
		    $html_element eq 'DD' ||
		    $html_element eq 'ADDRESS' ||
		    $html_element eq 'B' ||
		    $html_element eq 'BLOCKQUOTE' ||
		    $html_element eq 'PRE' ||
		    $html_element eq 'SAMP') {
                    push(@lines, &anchor($id, '', $invisible_mark, !$in_pre));
                } elsif ($html_element eq 'body') {
		    push(@lines, &debug("<P>\n", __LINE__));
                    push(@lines, &anchor($id, '', $invisible_mark, !$in_pre));
		    &html_push('P');
		} elsif ($html_element eq 'DL' ||
			 $html_element eq 'UL' ||
			 $html_element eq 'OL' ) {
		    $deferred_ref .= &anchor($id, '', $invisible_mark, !$in_pre) . " ";
		}
		next;
	    }
	    # list item
	    if (/^\@itemx?\s+/) {
		$what = $';
		$what =~ s/\s+$//;
		if ($in_bibliography && $use_bibliography) {
		    if ($what =~ /^$BIBRE$/o) {
			$id = 'BIB' . ++$bib_num;
			$bib2href{$what} = "$docu_doc#$id";
			print "# found bibliography for '$what' id $id\n"
			    if $debug & $DEBUG_BIB;
			$what = &anchor($id, '', $what);
		    }
		} elsif ($in_glossary && $use_glossary) {
		    $id = 'GLOSS' . ++$gloss_num;
		    $entry = $what;
		    $entry =~ tr/A-Z/a-z/ unless $entry =~ /^[A-Z\s]+$/;
		    $gloss2href{$entry} = "$docu_doc#$id";
		    print "# found glossary for '$entry' id $id\n"
			if $debug & $DEBUG_GLOSS;
		    $what = &anchor($id, '', $what);
		}
		&html_pop_if('P');
		if ($html_element eq 'DL' || $html_element eq 'DD') {
		    if ($things_map{$in_table} && !$what) {
			# special case to allow @table @bullet for instance
			push(@lines, &debug("<DT>$things_map{$in_table}\n", __LINE__));
		    } else {
			push(@lines, &debug("<DT>\@$in_table\{$what\}\n", __LINE__));
		    }
		    push(@lines, "<DD>");
		    &html_push('DD') unless $html_element eq 'DD';
		    if ($table_type) { # add also an index
			unshift(@input_spool, "\@${table_type}index $what\n");
		    }
		} elsif ($html_element eq 'TABLE') {
		    push(@lines, &debug("<TR><TD>$what</TD>\n", __LINE__));
		    &html_push('TR');
		} elsif ($html_element eq 'TR') {
		    push(@lines, &debug("</TR>\n", __LINE__));
		    push(@lines, &debug("<TR><TD>$what</TD>\n", __LINE__));
		} else {
		    push(@lines, &debug("<LI>$what\n", __LINE__));
		    &html_push('LI') unless $html_element eq 'LI';
		}
		push(@lines, &html_debug("\n", __LINE__));
		if ($deferred_ref) {
		    push(@lines, &debug("$deferred_ref\n", __LINE__));
		    $deferred_ref = '';
		}
		next;
	    } elsif (/^\@tab\s+(.*)$/) {
		push(@lines, "<TD>$1</TD>\n");
		next;
	    }
	}
    }
    # paragraph separator
    if ($_ eq "\n") {
	next if $#lines >= 0 && $lines[$#lines] eq "\n";
	if ($html_element eq 'P') {