texi2html

unix上的ODBC实现

  #
  # 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/((^|[^\s*\@])(\@\@)*)\@c(omment)? .*/$1/;
  # non-@ substitutions cf. texinfmt.el
  # Since these changes break code examples in the source they were removed. David 990729
  #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 eq 'table') {
      $table_type = '';
    } elsif ($tag eq 'ftable') {
      $tag = 'table';
      $table_type = 'f';
    } elsif ($tag eq 'vtable') {
      $tag = 'table';
      $table_type = 'v';
    }
    # special cases
    if ($tag eq 'top' || ($tag eq 'node' && /^\s*\@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 $_ =~ /^\s*\@node\s$NODESRE$/o;
      $_ = &protect_html($_);	# if node contains '&' for instance
      s/^\s*\@node\s+//;
      ($node) = split(/,/);
      &normalise_node($node);
      if ($split_node) {
	($doc_node_name[$doc_num + 1] = $node) =~ s|[ /]|_|g;
	$doc_node_name_links[$doc_num + 1] = $current_chapter_link;
	&next_doc;
	push(@lines, $SPLITTAG) if $split_num++;
	push(@sections, $node);
      }
      next;
    } elsif ($tag eq 'include') {
      if (/^\s*\@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 (/^\s*\@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 (/^\s*\@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 (/^\s*\@[fv]?table\s+\@(\w+)\s*$/) {
	$in_table = $1;
	unshift(@tables, join($;, $table_type, $in_table));
	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 'multitable') {
      if (/^\s*\@multitable\s*\@columnfractions\s+([\.\d\s]+)\s*$/ ||
	  /^\s*\@multitable\s*({[^{}]+})+\s*$/)
      {
	$in_multitable = 1;
	html_push('TABLE');
	my($col_list) = $1;
	$multitable_cols = ($col_list =~ /\@columnfractions/ ? s/[\d.]+\s+//g :
			    s/{[^{}]+}//g);
	print "# Multitable with $multitable_cols columns\n"
	  if $debug and $DEBUG_USER;
	push(@lines, &debug("<TABLE BORDER WIDTH=\"100%\">\n", __LINE__));
      } else {
	warn "$ERROR Bad table line: $_";
      }
      next;
    } elsif ($tag eq 'synindex' || $tag eq 'syncodeindex') {
      if (/^\s*\@$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 (/^\s*\@$tag\s*{($NODERE)}\s*$/) {
	$setref = $1;
	$setref =~ s/\s+/ /g;	# normalize
	$setref =~ s/ $//;
	$node2sec{$setref} = $name;
	$node2href{$setref} = "$link_doc#$docid";
	push(@maybe_wrong_links, $setref);
      } else {
	warn "$ERROR Bad setref line: $_";
      }
      next;
    } elsif ($tag eq 'defindex' || $tag eq 'defcodeindex') {
      if (/^\s*\@$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/^\s*\@$tag\s+//;
	$tag = $def_map{$tag};
	$_ = "\@$tag $_";
	$tag =~ s/\s.*//;
      }
    } elsif (defined($user_sub{$tag})) {
      s/^\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/^\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 eq 'table' ||
	     $end_tag eq 'ftable' ||
	     $end_tag eq 'vtable') {
      shift(@tables);
      if (@tables) {
	($table_type, $in_table) = split($;, $tables[0]);
      } else {
	$in_table = 0;
	$table_type = '';
      }
      push(@lines, "</DL>\n");
      &html_pop_if('DD');
      &html_pop_if();
    } elsif ($end_tag eq 'multitable') {
      print "# end of multitable with $multitable_cols columns\n"
	if $debug and $DEBUG_USER;
      $in_multitable = 0;
      push(@lines, "</TD></TR>\n");
      &html_pop_if('TR');
      push(@lines, "</TABLE>\n");
&html_pop_if('TABLE');
    } 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/^\s*\@center\s+//g;
  s/^\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
  s|\s+\@tab\s*| </TD><TD> |g if ($in_multitable);

  #
  # analyze the tag again
  #
  if ($tag) {
    if (defined($sec2level{$tag}) && $sec2level{$tag} > 0) {
      if (/^\s*\@$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></P>\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) {
	      print "# Splitting at section $name\n"
		if $debug & $DEBUG_TOC;
	      ($doc_node_name[$doc_num + 1] = $node) =~ s|[ /]|_|g;
	      &next_doc;
	      push(@lines, $SPLITTAG) if $split_num++;
	      push(@sections, $name);
	    }
	  } elsif ($split_node && $opt_special_links) {
	    $toplevel = $level unless $toplevel;
	    if ($level == $toplevel) {
	      ($current_chapter_link = $node) =~ s|[ /]|_|g;
	      # Set this again to the right value.
	      $doc_node_name_links[$doc_num] = $current_chapter_link;
	      ($docu_doc, $link_doc) = &doc_name($doc_num);
	    }
	  }
	  $sec_num++;
	  # Was "SEC$sec_num"
	  ($docid = "$node") =~ s|[ /]|_|g;
	  ($tocid = "$node") =~ s|[ /]|_|g;
$docid = "SEC$sec_num" unless $docid;
$tocid = "SEC$sec_num" unless $tocid;
	  # 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} = "$link_doc#$docid";
	      push(@maybe_wrong_links, $node);
	      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, "$link_doc#$docid", $name, 1);
	  push(@toc_lines, &substitute_style($_));
	  # update DOC
	  push(@lines, &html_debug("\n", __LINE__));
	  &html_reset;
	  $_ =  "<H$level>".&anchor($docid,  $opt_empty_headers ? "" : "$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 /^\s*\@set\s+($VARRE)\s+(.*)$/o;
      delete $value{$1}, next if /^\s*\@clear\s+($VARRE)\s*$/o;
      # store things
      $value{'_setfilename'}   = $1, next if /^\s*\@setfilename\s+(.*)$/;
      $value{'_settitle'}      = $1, next if /^\s*\@settitle\s+(.*)$/;
      $value{'_author'}   .= "$1\n", next if /^\s*\@author\s+(.*)$/;
      $value{'_subtitle'} .= "$1\n", next if /^\s*\@subtitle\s+(.*)$/;
      $value{'_title'}    .= "$1\n", next if /^\s*\@title\s+(.*)$/;
      # index
      if (/^\s*\@(..?)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\} .= "$;$link_doc#$id";
 } else {
   \$$index\{\$what\} = "$link_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' ||
		   $html_element eq 'TR') {
	    $deferred_ref .=
	      &anchor($id, '', $invisible_mark, !$in_pre) . " ";
	  }
	next;
      }
      # list item
      if (/^\s*\@itemx?\s+/)
      {
	$what = $';
	$what =~ s/\s+$//;

	# add an index before the item if applicable
	if ($table_type ne '' && !$in_multitable) {
	  print "# Adding table index (type $table_type) for $what\n"
	    if $debug & $DEBUG_INDEX;
	  # This is realy ugly. We should do a pass before this to
	  # add index entrys before instead.
	  if ($global_added_this_index) {
	    $global_added_this_index = 0;
	  } else {
	    unshift(@input_spool, "\@${table_type}index $what\n", $_);
	    $global_added_this_index = 1;
	    next READ_LINE;
	  }
	}

	if ($in_bibliography && $use_bibliography) {
	  if ($what =~ /^$BIBRE$/o) {
	    $id = 'BIB' . ++$bib_num;
	    $bib2href{$what} = "$link_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} = "$link_doc#$id";
	  print "# found glossary for '$entry' id $id\n"
	    if $debug & $DEBUG_GLOSS;
	  $what = &anchor($id, '', $what);
	}
	if ($in_multitable)
	{
	  # All this is a **HACK**.
	  # It does only work for a FEW SIMPLE CASES !!!
	  push(@lines, &debug("</TD></TR>\n", __LINE__))
	    unless $html_element eq 'TABLE';
	  &html_pop_if('TR');
	  $what =~ s|\s+\@tab\s*| </TD><TD> |g;
	  push(@lines, &debug("<TR><TD>$what\n", __LINE__));
	  &html_push('TR');
	  if ($deferred_ref)
	  {
	    push(@lines, &debug("$deferred_ref\n", __LINE__));
	    $deferred_ref = '';
	  }
	  next;
	}
	else
	{
	  &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';
	    # Old index add was here
	  } 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;
	}
      }
    }
  }
  # paragraph separator
  if ($_ eq "\n") {
    next if $#lines >= 0 && $lines[$#lines] eq "\n";
    if ($html_element eq 'P') {
      push(@lines, "\n");
      $_ = &debug("</P>\n", __LINE__);
      &html_pop;
    }