\section[lit2texi_only]{Code for generating Texinfo files}

\begin{code}
sub texinfoize_text {
    # is given deatified text
    # returns text and index entries
    #
    local($srcfilename,$srclineno,$_) = @_;
    local($idx_real)  = '';
    local($idx_maybe) = '';

    # do \MathMode, \tr, and \codeInText first because they might be
    # inside other things

    while (/\\MathMode\{([^\}]*)\}/) { # I like this easy stuff
	local($guts) = $1;

	# arrows to start with...
	$guts =~ s/\\leftarrow/->/g;
	$guts =~ s/\\Leftarrow/=>/g;
	$guts =~ s/\\rightarrow/<-/g;
	$guts =~ s/\\Rightarrow/<=/g;
	$guts =~ s/\\leftrightarrow/<->/g;
	$guts =~ s/\\Leftrightarrow/<=>/g;
	$guts =~ s/\\longleftarrow/-->/g;
	$guts =~ s/\\Longleftarrow/==>/g;
	$guts =~ s/\\longrightarrow/<--/g;
	$guts =~ s/\\Longrightarrow/<==/g;
	$guts =~ s/\\longleftrightarrow/<-->/g;
	$guts =~ s/\\Longleftrightarrow/<==>/g;

	$guts =~ s/\\alpha/alpha/g;
	$guts =~ s/\\beta/beta/g;

	s/\\MathMode\{([^\}]*)\}/$guts/;
    }

    while (/\\(pl|tr)\{([^\}]*)\}/) {
	local($plain_or_typing) = $1;
	local($guts)		= $2;

	$guts =~ s/\\/\001backslash\003/g;
	$guts =~ s/\~/\001twiddle\003/g;
	$guts =~ s/\@/\\\@/g;
	$guts =~ s/\001lbrace\003/\\\001lbrace\003/g;
	$guts =~ s/\001rbrace\003/\\\001rbrace\003/g;
	# protect the following for now ... (see below)
	$guts =~ s/\`\`/\001tex-open-double-quotes\003/g;
	$guts =~ s/\'\'/\001tex-close-double-quotes\003/g;

	s/\\(pl|tr)\{[^\}]*\}/\\w\{$guts\}/
	    if $plain_or_typing eq 'pl';
	s/\\(pl|tr)\{[^\}]*\}/\\w\{\\samp\{$guts\}\}/
	    if $plain_or_typing eq 'tr';
    }

    while (/\\codeInText\{([^\}]*)\}/) {
	local($raw_code) = $1;
	local($indexing) = 1;

	$raw_code =~ s/\\\@/\@/g; # remove the one kind of escape

	if ($raw_code =~ /\001noindex\003/) {
	    $indexing = 0;
	    $raw_code =~ s/\001noindex\003//;
	}

	$munged_code = $raw_code;
	$munged_code =~ s/\\/\001backslash\003/g;
	$munged_code =~ s/\~/\001twiddle\003/g;
	$munged_code =~ s/\@/\\\@/g; # now put it back in
	$munged_code =~ s/\001lbrace\003/\\\001lbrace\003/g;
	$munged_code =~ s/\001rbrace\003/\\\001rbrace\003/g;

	if ($indexing) {
	    local($cdefs, $cuses) = &add_code_interests(-1,-1,&deatified2verb($raw_code));
	    local($c);
	    # index all defs and uses
	    foreach $c (split(/\001/, $cdefs)) {
		if ($c) {
		    $idx_real .= "\\cindex ".&mk_texi_index_entry("$c [def]")."\n";
		}
	    }
	    # uses are only indexed if the defined thing is known
	    # can't be done until link time
	    foreach $c (split(/\001/, $cuses)) {
		if ($c) {
		    $idx_maybe .= "\001index_uses\003$c\n";
		}
	    }
	}
	# this really should use &mk_code_frag ...

	s/\\codeInText\{[^\}]*\}/\\w\{\\samp\{$munged_code\}\}/;
    }

    if (/\\maketitle\n/) {
	local($title_stuff) = '';
	$title_stuff .= "\\center $Doc_title\n" if $Doc_title;
	$title_stuff .= "\n\\center $Doc_author\n" if $Doc_author;
	$title_stuff .= "\n\\center $Doc_date\n" if $Doc_date;
	$title_stuff .= "\n" if ($Doc_title || $Doc_author || $Doc_date);
	if ($title_stuff ne '') {
	    print STDERR "$Pgm: warning: an unfixed perl 4.035 crashes here!\n";
	    print STDERR "(a patch for perl is distributed with Glasgow Haskell)\n";
# what happened to idx stuff ?
	    $title_stuff = &texinfoize_text($srcfilename, ($srclineno + $i), $title_stuff);
	}
	s/\\maketitle\n/$title_stuff/;
    }

    while (/\\heading\{([^\}]+)\}\n/) {
	local($title)    = &deatified2verb($1);
	s/\\heading\{([^\}]+)\}\n/\\heading $title\n/;
    }

    while (/\\index\{([^\}]+)\}/) {
	local($guts) = &deatified2verb($1);
	
	$guts =~ s/\\@/\@/g;	# de-escape them
	$guts =~ s/\\!/\!/g;
	$guts =  &mk_texi_index_entry($guts);

	$idx_real .= "\\cindex " . $guts . "\n";
	s/\\index\{([^\}]+)\}//;
    }

    s/\\item\s+([^\[\n])/\\item\n\1/g; # must be first for \item

    # the following will get messed up if you do:
    #	\item [ ......... ]  .......]

    while (/\\item\s*\[(.+)\]\s*\n/) {
	local($item_tag) = &deatified2verb($1);
	s/\\item\s*\[(.+)\]\s*\n/\\item $item_tag\n/;
    }
    while (/\\item\s*\[(.+)\]\s*(\S)/) {
	local($item_tag) = &deatified2verb($1);
	s/\\item\s*\[(.+)\]\s*(\S)/\\item $item_tag\n\2/;
    }

    while (/\\centerline\{([^\}]+)\}\n/) {
	local($center_text) = &deatified2verb($1);
	s/\\centerline\{([^\}]+)\}\n/\\center $center_text\n/;
    }

    while (/\\node\{([^\}]+)\}\n/) {
	local($node_text) = &deatified2verb($1);
	s/\\node\{([^\}]+)\}\n/\\node $node_text\n/;
    }

    s/\\(begin|end)\{document\}\n//g;
    s/\\begin\{description\}/\\table \\asis/g;
    s/\\end\{description\}/\\end table/g;
    s/\\begin\{enumerate\}/\\enumerate/g;
    s/\\end\{enumerate\}/\\end enumerate/g;
    s/\\begin\{itemi[sz]e\}/\\itemize \\bullet/g;
    s/\\end\{itemi[sz]e\}/\\end itemize/g;
    s/\\begin\{quotation\}/\\quotation/g;
    s/\\end\{quotation\}/\\end quotation/g;
    s/\\begin\{display\}/\n\\display/g;
    s/\\end\{display\}/\\end display\n/g;
    s/\\begin\{flushdisplay\}/\n\\format/g;
    s/\\end\{flushdisplay\}/\\end format\n/g;
    s/\\begin\{comment\}/\\quotation\nCOMMENT:-----------------------\n/g;  # need more here?
    s/\\end\{comment\}/-------------------------------\n\\end quotation/g;

    # check for unknown environments (only at beginning of lines; easier)
    #  mark good ones as \begin!_/\end!_
    #        bad ones as \begin!!/\end!!
    while (/^\\(begin|end)\{([A-Za-z]+)\}/) {
	if ( $KNOWN_ENV{$2} ) { # good
	    s/\\(begin|end)\{([A-Za-z]+)\}/\\\1!_\{\2\}/;
	} else { # bad
	    s/\\(begin|end)\{([A-Za-z]+)\}/\\\1!!\{\2\}/;
	}
    }
    # put begin/end display around bad ones and escape magic chars
    while (/\\(begin|end)!!\{([A-Za-z]+)\}/) {
	local($begin_or_end) = $1;
	local($env_name)     = $2;

	local($new_stuff) = "\\display\n" if $begin_or_end eq 'begin';
	$new_stuff	 .= "\001backslash\003$begin_or_end\001lbrace\003$env_name\001rbrace\003\n";
	$new_stuff	 .= "\\end display\n" if $begin_or_end eq 'end';
	s/\\(begin|end)!!\{([A-Za-z]+)\}/$new_stuff/;
    }
    # unmark good ones
    s/\\(begin|end)!_\{([A-Za-z]+)\}/\\\1\{\2\}/g;

    local($_) = &fiddle_sectiontypes($_);

    # comments were mainly handled in lit-deatify
    s/\\\%/\%/g; # remaining percent signs needn't be escaped

    # now some easy ones
    s/\\\&/\&/g;
    s/\\\_/\_/g;
    s/\\\#/\#/g;
    s/\\\$/\$/g;
    s/\\pounds\s*([0-9\?][0-9KkMm\.\,\?]*[0-9KkMm\?])/\1 pounds/g;
    s/\{\\em\s*/@emph\{/g;
    s/\\\///g;
    s/\{\\tt\s*/@kbd\{/g;
    s/\{\\sc\s*/@sc\{/g;
    s/``/"/g;	# except the ones in \tr and \pl (sigh)
    s/''/"/g;
    s/\001tex-open-double-quotes\003/``/g;
    s/\001tex-close-double-quotes\003/''/g;

    s/([^\\ ])~/\1 /g; # I expect to be beaten by twiddles...

    s/([^-])---([^-])/\1 -- \2/g; # I don't like what makeinfo does

    # 	I prefer to go after specific cases, e.g., \ref's below
    # accents
    s/\\"\\i/i/g; # dotless i
    s/\\"//g;
    s/\\`//g;
    s/\\'//g;
    # \refs and \pagerefs
    s/[ ~]\\ref\{/ \\xref\{/g;
    s/^\\ref\{/\\xref\{/g;
    s/[ ~]\\pageref\{/ \\xref\{/g; # good luck...
    s/^\\pageref\{/\\xref\{/g;

    # \xref handling must be deferred to link time

    (&slashes2ats($_), (&slashes2ats($idx_real) . $idx_maybe));
}

sub slashes2ats { # and also the magic \001?\003 things put in by deatify; sigh
    local($_) = @_;

    $_ = &deatified2verb_nl($_);

    s/\\/\@/g;
    s/\001backslash\003/\\/g; # those meant to survive...
    s/\001twiddle\003/\~/g;

    $_;
}

sub texinfoize_verb {
    local($_) = @_;

    s/\@/\@\@/g;
    s/\{/\@\{/g;
    s/\}/\@\}/g;

    $_;
}

sub texinfoize_code { # same as verb for now
    local($_) = @_;

    s/\@/\@\@/g;
    s/\{/\@\{/g;
    s/\}/\@\}/g;

    $_;
}

sub texinfoize_table_body {
    # is given deatified text
    # returns text and index entries
    local($_) = @_;

    # convert &'s and \\'s to something hidden
    s/^\&/\\tabularAnd/;
    s/([^\\])\&/\1\\tabularAnd/g;
    s/\\\\/\\tabularNewline/g;

    local($ret_text,$ret_idxstuff) = &texinfoize_text('???','???',$_);
    ($ret_text,$ret_idxstuff);
}

sub texinfoize_tabular {
    local($_) = @_;

    # newlines serve no purpose here
    s/\n//g;

    # split into "rows" based on \\
    local(@row) = split(/\@tabularNewline/, $_);
    local($r);

    # find maximum column widths
    local(@col_width) = ();
    foreach $r (@row) {
#	$r =~ s/\\&/\001and\003/g; # avoid escaped ampersands
    	local(@row_col) = split(/\@tabularAnd/, $r);
	local($rc_no);
	for ($rc_no = 0; $rc_no <= $#row_col; $rc_no++) {
	    # strip leading/trailing whitespace
	    $row_col[$rc_no] =~ s/^\s+//;
	    $row_col[$rc_no] =~ s/\s+$//;
	    # \hline's throw the count off
	    $row_col[$rc_no] =~ s/\@hline//g;
#	    # convert funny ampersands
#	    $row_col[$rc_no] =~ s/\001and\003/&/g;
    	    if (!defined($col_width[$rc_no]) 
		|| length($row_col[$rc_no]) > $col_width[$rc_no]) {
		$col_width[$rc_no] = length($row_col[$rc_no]);
    	    }
	}
    }
    # and the total width ... (2 each for intercolumn gaps)
    local($total_width) = 0;
    local($cw);
    foreach $cw (@col_width) {
    	$total_width += $cw;
    }
    $total_width += ($#col_width * 2);
    local($hline_text) = ('-' x $total_width)."\n";

    # now we know widths, let's make new text accordingly
    local($outtext) = '';
    foreach $r (@row) {
	# escaped ampersands already under control
    	local(@row_col) = split(/\@tabularAnd/, $r);
	local($rc_no);
	for ($rc_no = 0; $rc_no <= $#row_col; $rc_no++) {
	    # strip leading/trailing whitespace
	    $row_col[$rc_no] =~ s/^\s+//;
	    $row_col[$rc_no] =~ s/\s+$//;

	    # handle \hline's (AT BEGINNING OF LINE ONLY)
	    while ($row_col[$rc_no] =~ /^\@hline\s*/) {
		$outtext .= $hline_text;
		$row_col[$rc_no] =~ s/^\@hline\s*//;
	    }
	    # and now the rest of the line...
#	    # convert funny ampersands
#	    $row_col[$rc_no] =~ s/\001and\003/&/g;

	    # only left justify for now
	    $outtext .= sprintf("%-".$col_width[$rc_no]."s  ", $row_col[$rc_no]);
	}
	$outtext .= "\n";
    }

    &slashes2ats($outtext);
}

sub mk_texi_index_entry {
    local($raw_text) = @_;
    local(@sub_entries) = split(/\001idxsubitem\003/, $raw_text);
    local($sube,$sortstuff,$printstuff);

    foreach $sube (@sub_entries) {
	if ($sube =~ /(.*[^\\])\001idxsort\003(.*)/) {
	    $sortstuff  = $1;
	    $printstuff = $2;
	} else {
	    $sortstuff  = '';
	    $printstuff = $sube;
	}
	$sortstuff =~ s/\\/\001backslash\003/g;
	$sortstuff =~ s/\@/\@\@/g;
	$sortstuff =~ s/\{/\\\001lbrace\003/g;
	$sortstuff =~ s/\}/\\\001rbrace\003/g;

	$printstuff =~ s/\\/\001backslash\003/g;
	$printstuff =~ s/\@/\@\@/g;
	$printstuff =~ s/\{/\\\001lbrace\003/g;
	$printstuff =~ s/\}/\\\001rbrace\003/g;

	if ($sortstuff) {
	    $sube = "$sortstuff\\@_sep_\\@$printstuff";
	} else {
	    $sube = $printstuff;
	}
    }
    # stick it back together for makeindex
    join(' -- ',@sub_entries);
}

sub mk_line_directive {
    local($filename,$lineno) = @_;

    ( (! $filename) ? '' : "\@srcfilename $filename\n\@srclineno $lineno\n");
}

sub std_print_code_blk {
    local($codetxt) = @_;

    # language specific
    local($newtxt,$idx_list) = &rm_embedded_stuff($codetxt);

    print "\@format\n";
    print '-' x 70, "\n";	# 70 lets us still fit in 80 cols, even w/ some indentation
    print &texinfoize_code($newtxt);
    print '-' x 70, "\n";
    print "\@end format\n";

    local($i);
    foreach $i (split(/\002/, $idx_list )) {
	print "\@cindex ".&mk_texi_index_entry($i)."\n"  if $i;
    }
}

sub std_mk_code_frag {
    local($codetxt) = @_;

    "\@w\@samp\{" . &texinfoize_code($codetxt) . "\}\}";
}

sub gen_texinfo_table_of_contents_lines { # used by linker
    push(@Menu_lines, "Detailed table of contents:\n\n");
    
    local($s) = 0;

    while ($s <= $#Sec_depth) {
	next if $Sec_abs_depth[$s] <= 0 || ! $Sec_nodename[$s];
	next if $Sec_title[$s] =~ /\001starred\003/;

	# take it's numstr, throw away all the 0 pieces
	# use the length of what's left as how much to indent
	# (pretty terrible, eh?)
	local($magic_str) = $Sec_numstr[$s];
	$magic_str =~ s/^[0\.]+\.//;
	$magic_str =~ s/\.[0\.]+$//;

	push(@Menu_lines,
	 '*'.(' ' x length($magic_str)).$Sec_nodename[$s].':: '.$Sec_title[$s]."\n");
    } continue {
	$s++;
    }
}

# a trailing 1 makes this file's "do"ing a success
1;
\end{code}