diff options
Diffstat (limited to 'web/glasgow/lit2x-0.16/literate/lit-2texi.lprl')
-rw-r--r-- | web/glasgow/lit2x-0.16/literate/lit-2texi.lprl | 434 |
1 files changed, 434 insertions, 0 deletions
diff --git a/web/glasgow/lit2x-0.16/literate/lit-2texi.lprl b/web/glasgow/lit2x-0.16/literate/lit-2texi.lprl new file mode 100644 index 0000000000..d63c19c654 --- /dev/null +++ b/web/glasgow/lit2x-0.16/literate/lit-2texi.lprl @@ -0,0 +1,434 @@ +\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} |