summaryrefslogtreecommitdiff
path: root/web/glasgow/lit2x-0.16/literate/lit-2texi.lprl
diff options
context:
space:
mode:
Diffstat (limited to 'web/glasgow/lit2x-0.16/literate/lit-2texi.lprl')
-rw-r--r--web/glasgow/lit2x-0.16/literate/lit-2texi.lprl434
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}