texi2html

unix上的ODBC实现

  } 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 /^\s*\@menu\b/;
  $in_menu = 0, push(@lines2, &debug("</UL>\n", __LINE__)), next if /^\s*\@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 (/^\s*\@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;
    }
    $last_letter = undef;
    foreach $key (sort byalpha @keys) {
      $letter = substr($key2alpha{$key}, 0, 1);
      $letter = substr($key2alpha{$key}, 0, 2) if $letter eq $;;
      $letter = " " unless $letter =~ /[a-zA-Z]/;
      if (!defined($last_letter) || $letter ne $last_letter) {
	push(@lines2, "</DIR>\n") if defined($last_letter);
	push(@lines2, "<H2>" . &protect_html(uc($letter)) . "</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';
    } elsif ($type eq 'u') {
      $type = 'See ';
    } 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
  #
  # This checked for NAME="SEC\d". The current version is probably broken.
  unless (/^<H\d><A NAME=\"/) {
    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 (toc) 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 (foot) 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;
    # Remove added links part
    if (open(FILE, ">$docu_doc")) {
      print "# creating $docu_doc... ($section)\n" if $verbose;
      &print_header("$title - $section") unless $opt_empty_headers;
      $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 unless $opt_empty_headers;
      &print_ruler unless $opt_empty_headers;
      # find corresponding lines
      @tmp_lines = ();
      while (@doc_lines) {
	$_ = shift(@doc_lines);
	last if ($_ eq $SPLITTAG);
	push(@tmp_lines, $_);
      }
      &print(*tmp_lines, FILE);
      &print_ruler unless $opt_empty_headers;
      print FILE $navigation unless $opt_empty_headers;
      &print_footer unless $opt_empty_headers;
      close(FILE);
    } else {
      warn "$ERROR Can't write (doc) 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 (doc2) 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;
      }
      $match =~ s/^\s*\@/X/;
      $_ = "$before$match$after";
      redo;
    }
  }

  foreach (sort(keys(%seen))) {
    if ($verbose) {
      print "$_\n";
      print $context{$_};
    } else {
      print "$_ ($seen{$_})\n";
    }
  }
}

sub open
{
  local($name) = @_;

  ++$fh_name;
  if (open($fh_name, $name)) {
    unshift(@fhs, $fh_name);
  } else {
    warn "$ERROR Can't read file $name: $!\n";
  }
}

sub init_input
{
  @fhs = ();			# hold the file handles to read
  @input_spool = ();		# spooled lines to read
  $fh_name = 'FH000';
  &open($docu);
}