diff options
Diffstat (limited to 'web/glasgow/lit2x-0.16/literate/lit2pgm.BOOT')
-rw-r--r-- | web/glasgow/lit2x-0.16/literate/lit2pgm.BOOT | 385 |
1 files changed, 385 insertions, 0 deletions
diff --git a/web/glasgow/lit2x-0.16/literate/lit2pgm.BOOT b/web/glasgow/lit2x-0.16/literate/lit2pgm.BOOT new file mode 100644 index 0000000000..b2dea81d65 --- /dev/null +++ b/web/glasgow/lit2x-0.16/literate/lit2pgm.BOOT @@ -0,0 +1,385 @@ +eval "exec perl -S $0 $*" + if $running_under_some_random_shell; +# +############# +# magic version for booting... +########### +# line 27 "lit2stuff.lprl" +$Pgm = $0; $Pgm =~ s/.*\/([^\/]+)$/\1/; + +# an initial -A<name> option overrides the name +if ($#ARGV >= 0 && $ARGV[0] =~ /^-A(lit2)(pgm|texi|latex)$/) { + $Pgm = $1.$2; + shift(@ARGV); +} +$Lit2pgm = ($Pgm eq 'lit2pgm') ? 1 : 0; +$Lit2latex = ($Pgm eq 'lit2latex') ? 1 : 0; +$Lit2texi = ($Pgm eq 'lit2texi') ? 1 : 0; +$Lit2depend = ($Pgm eq 'mkdependlit') ? 1 : 0; +$Lit2changelog = ($Pgm eq 'lit2changelog') ? 1 : 0; +die "$Pgm: must be invoked as lit2pgm, lit2texi, lit2latex, mkdependlit, or lit2changelog (or use -A<name>)\n" + if (!($Lit2pgm || $Lit2latex || $Lit2texi || $Lit2depend || $Lit2changelog)); + +# $Lit2what will be set after we know $Quick_lit2pgm + +$Status = 0; # just used for exit() status +# line 53 "lit2stuff.lprl" +do 'getopts.pl' || die "Giant error 'do'ing getopts.pl: $@"; +$Usage = "usage: $Pgm ". + '[-i input-file] '. + '[-I LITINPUTS-path-additions] '. + '[-o output-file] '; +$Usage .= '[-cdnqv] '. + '[-r ribbons] '. + "[input-file]\n" if $Lit2pgm; +$Usage .= '[-cdLnOSv] '. + '[-N infofilename] '. + '[-[lx] language] '. + '[-s stop-list-file] '. + "[input-file]\n" if $Lit2texi; +$Usage .= '[-cdnOSv] '. + '[-g node-name] '. + '[-[lptx] language] '. + '[-s stop-list-file] '. + "[input-file]\n" if $Lit2latex; +$Usage .= '[-dv] '. + "[input-file]\n" if $Lit2depend; +$Usage .= '[-dnv] '. + "[input-file]\n" if $Lit2changelog; + +if ( ($Lit2pgm && ! &Getopts('cdH:I:i:no:qr:v')) + || ($Lit2texi && ! &Getopts('cdH:I:i:Ll:nN:Oo:Ss:vx:')) + || ($Lit2latex && ! &Getopts('cdg:H:I:i:l:no:Op:Ss:t:vx:')) + || ($Lit2depend && ! &Getopts('dH:I:i:o:v')) + || ($Lit2changelog && ! &Getopts('dH:I:i:no:v'))) { + print STDERR $Usage; + exit 1; +} elsif ($#ARGV > 0) { + print STDERR "$Pgm: cannot have more than one input file: @ARGV \n"; + print STDERR $Usage; + exit 1; +} +# SHARED OPTIONS +$Debugging = ($opt_d) ? 1 : 0; +$Verbose = ($Debugging | $opt_v) ? 1 : 0; +$Input_file = ($opt_i) ? $opt_i : ''; +# -o <output file> handled after deciding if linking + +$Litinputs = '.'; +$Litinputs_adds = ($opt_I) ? $opt_I : ''; +$Litinputs = "$Litinputs_adds:$Litinputs" if $Litinputs && $Litinputs_adds; + +# where all the assisting code is found (HARDWIRED) +if ($opt_H) { + # no error checking; you get what you deserve + ($LIB_ARCH_DIR,$LIB_DIR) = split(/:/,$opt_H); +} else { +# boot changes... + $LIB_ARCH_DIR = '.'; + $LIB_DIR = '.'; +} +unshift(@INC, $LIB_DIR); # adding to; for .prl libraries sucked in at runtime +# +# now the (derived) names of all the helpers +$Lit_inputter = "$LIB_DIR/lit-inputter"; +$Lit_deatify = "$LIB_ARCH_DIR/lit-deatify"; +$Lit_verb2latex = "$LIB_ARCH_DIR/lit-verb2latex"; + +# finish knowing myself; must agree with lit-deatify.llex +# boot change +$Quick_lit2pgm = 1; # ($opt_q) ? 1 : 0; +$Lit2what = 1; # if $Quick_lit2pgm; + +# LESS SHARED OPTIONS +$Grab_node = ($opt_g) ? $opt_g : 'Top'; +$Infofilename = ($opt_N) ? $opt_N : ''; # see do_setfilename +$Follow_inputs = ($opt_n) ? 1 : 0; +$Show_node_owner= ($opt_O) ? 1 : 0; +$Opt_node_links = ($opt_L) ? 1 : 0; +$Standalone_doc = ($opt_S) ? 1 : 0; + +$Stoplist_file = ($opt_s) ? $opt_s : ''; +# for now, stop lists are simply words to be ignored +if ($Stoplist_file) { + if ( ! -f $Stoplist_file) { + ¬_OK('','',"stop-list file does not exist: $Stoplist_file\n"); + } else { + open(STOPF,"<$Stoplist_file") || die "Can't open file: $Stoplist_file\n"; + while (<STOPF>) { + chop; + $IGNORE_WD{$_} = 1; # no questions asked... + } + close(STOPF); + } +} + +$Ribbons_to_get = ($opt_r) ? $opt_r : 'main'; +$Ribbons_to_get =~ s/\s*,\s*/,/g; # remove spaces around commas + +# figure out what we're doing and the input and output files... +if ( ! $Input_file ) { + if ($#ARGV == 0) { + $Input_file = $ARGV[0]; + } else { + $Input_file = '-'; # stdin; hmm... + } +} + +($Inputfile_root,$Inputfile_suff) = &root_and_suffix($Input_file); + +# are we "processing" and/or "linking" ? +if ( ! ($Lit2texi || $Lit2latex)) { # that's easy... + $Processing = 1; + $Linking = 0; +} else { + $Processing = 1 if $Inputfile_suff !~ /^(itxi|itex|texi|tex)$/; + $Linking = ($opt_c) ? 0 : 1; +} + +# table of input-suffixes -> output-suffixes (for "processing"); +# cf. tables in &check_language_stuff +$ISUFF2OSUFF{'lit'} = ''; +$ISUFF2OSUFF{'lhs'} = 'hs'; +$ISUFF2OSUFF{'lit.hs'} = 'hs'; +$ISUFF2OSUFF{'lprl'} = 'prl'; +$ISUFF2OSUFF{'llex'} = 'lex'; + +# guess the output filenames (for "processing" and "linking") +if ( $opt_o ) { + if ( $Linking ) { + $Link_outfile = $opt_o; + } else { + $Proc_outfile = $opt_o; + } +} +if ( !defined($Proc_outfile) ) { + if ($Linking) { # got to put it _somewhere_ + $Proc_outfile = "/usr/tmp/lit2stuff-po.$$"; + + } elsif ($Lit2pgm) { # try to be clever + if (defined($ISUFF2OSUFF{$Inputfile_suff})) { + $Proc_outfile = $Inputfile_root; + $Proc_outfile .= '.'.$ISUFF2OSUFF{$Inputfile_suff} + if $ISUFF2OSUFF{$Inputfile_suff}; + } else { + print STDERR "$Pgm: don't know the file suffix: $Inputfile_suff\n"; + $Proc_outfile = '-'; # stdout will do + } + + } elsif ($Lit2texi) { + $Proc_outfile = $Inputfile_root . '.itxi'; + + } elsif ($Lit2latex) { + $Proc_outfile = $Inputfile_root . '.itex'; + + } else { + $Proc_outfile = '-'; # stdout + } +} +# messing with Link_outfile deferred to later... + +&check_language_stuff(); +exit $Status if $Status; # don't proceed if errors + +print STDERR "Language info: code=$Code_lang, xref=$Lang_xref, ", + "typeset=$Lang_typeset, pagebreak=$Lang_pagebreak\n" + if $Verbose; + +# now we know the program, the options, and the language info, we load +# the other (non-language-related) pieces of perl code (roll-your-own +# dynamic linking...) +# if ( ! $Quick_lit2pgm) { +# do 'lit-globals.prl' || die "Giant error 'do'ing lit-globals.prl: $@"; +# do 'lit-reader.prl' || die "Giant error 'do'ing lit-reader.prl: $@"; +#} +#if ($Lit2pgm) { +# if (! $Quick_lit2pgm) { # i.e., the slow one +# do 'lit-2pgm.prl' || die "Giant error 'do'ing lit-2pgm.prl: $@"; +# } +# boot changes +# # we _always_ need something for line directives +# do "lit-2pgm-$Code_lang.prl" +# || die "Giant error 'do'ing lit-2pgm-$Code_lang.prl: $@"; +# +#} else { +# die "can't use lit2pgm.BOOT except for lit2pgm'ming" +#} + +# NOW WE START DRIVING... + +# first: we handle "quick" lit2pgm +if ($Quick_lit2pgm) { + + # check that no incompatible lit2pgm options were used + die "Can only get ribbon 'main' with lit2pgm -q option\n" + if ($Ribbons_to_get ne 'main'); + die "Can't follow \\input{}s with lit2pgm -q option\n" + if ($Follow_inputs); + + $pipe_string = "$Lit_deatify $Verbose 0 $Lit2what $Input_file | expand"; + print STDERR "QUICK LIT2PGM:in=$pipe_string\n" if $Verbose; + print STDERR " out=$Proc_outfile\n" if $Verbose; + &do_std_opens($pipe_string,$Proc_outfile); + + # this "quick" loop does as little as possible + while (<INPIPE>) { + if ( /^srcfile!_!(.*)!_!(.*)!_!/) { +# boot change: +# print &mk_line_directive($1,$2); +; + } else { + print $_ ; + } + } + &do_std_closes(); + exit $Status; +} + +# continue with various kinds of "processing" ... + +if ($Lit2pgm) { + print STDERR "LIT2PGM:out=$Proc_outfile\n" if $Verbose; + &spit_out_ribbons_code(split(/,/, $Ribbons_to_get)); + &do_std_closes(); + exit $Status; +} + +# line 418 "lit2stuff.lprl" +sub check_language_stuff { + + # fixed tables of "language"-related info + + $ISUFF2LANG{'lit'} = 'none'; + $ISUFF2LANG{'lc'} = 'c'; + $ISUFF2LANG{'lhs'} = 'hs'; + $ISUFF2LANG{'lit.hs'}='hs'; + $ISUFF2LANG{'lprl'} = 'prl'; + $ISUFF2LANG{'llex'} = 'lex'; + + $STD_LANGS = 'none,c,hs,prl,lex'; # fully supported (?) + + $XREF_HINTS = ''; # could have more... + $PAGEBREAK_HINTS = ''; + $TYPESET_HINTS = ''; + + $Code_lang = + ($opt_l) ? $opt_l + : (defined($ISUFF2LANG{$Inputfile_suff})) ? $ISUFF2LANG{$Inputfile_suff} + : 'none'; + $Lang_pagebreak = ($opt_p) ? $opt_p : ''; + $Lang_typeset = ($opt_t) ? $opt_t : ''; + $Lang_xref = ($opt_x) ? $opt_x : ''; + + ¬_OK("","","xref hints unknown: $Lang_xref\n") + if $Lang_xref && index( $XREF_HINTS, $Lang_xref ) < 0; + ¬_OK("","","pagebreak hints unknown: $Lang_pagebreak\n") + if $Lang_pagebreak && index( $PAGEBREAK_HINTS, $Lang_pagebreak ) < 0; + ¬_OK("","","typeset hints unknown: $Lang_typeset\n") + if $Lang_typeset && index( $TYPESET_HINTS, $Lang_typeset ) < 0; +} +# line 472 "lit2stuff.lprl" +sub do_std_opens { # opens INPIPE, and OUTF; selects the latter + + local($pipe_string,$output_file) = @_; + + # check it output is to a pipe + $output_file = ">$output_file" if $output_file !~ /^\|/; + + open(INPIPE, "$pipe_string |") + || die "$Pgm: can't start prefilter pipe: $pipe_string\n"; + open(OUTF, "$output_file") + || die "$Pgm: can't open output file: $output_file\n"; + select(OUTF); +} + +sub do_std_closes { # closes INPIPE and OUTF; re-selects STDOUT + + close(INPIPE); + # most regrettably, this only tells if the _last_ thing + # in the pipeline croaked... + if ($? >> 8) { + print STDERR "$Pgm: error(s) from prefilter pipe\n"; + unlink("/usr/tmp/lit2stuff-po.$$"); # this might exist... + exit 1; + } + close(OUTF); + if ($? >> 8) { + print STDERR "$Pgm: error in closing output file: $?\n"; + unlink("/usr/tmp/lit2stuff-po.$$"); # this might exist... + exit 1; + } + select(STDOUT); +} + +sub not_OK { # report error, increment $Status, but keep going + local($srcfilename, $srclineno, $msg) = @_; + if ($srcfilename) { # not always there + print STDERR "$srcfilename:$srclineno: $msg"; + } else { + print STDERR "$Pgm: $msg"; + } + $Status++; +} + +sub filter_string { + local($filter, $string) = @_; + + open(FILT, "| $filter > /tmp/lit$$") || die "Can't open in filter_string\n"; + print FILT $string; + close(FILT); + if ($? >> 8) { # something went wrong in the pipe ??? + print STDERR "$Pgm: error(s) in/from filter: $filter\n"; + } + local($filtered_string) = `cat /tmp/lit$$`; + unlink("/tmp/lit$$"); + $filtered_string; +} + +sub deatified2verb_nl { # lit-deatify put 'em in; now we take 'em out + local($_) = @_; + + s/\001newline\003/\n/g; # _WITH_ newlines + s/\001lbrace\003/\{/g; + s/\001rbrace\003/\}/g; + s/\001rbracket\003/\]/g; + + $_; +} + +sub deatified2verb { # without newlines + local($_) = @_; + + $_ = &deatified2verb_nl($_); + + s/\n/ /g; # the difference; to SPACES + $_; +} + +sub de_newlined { + local($_) = @_; + + s/\n/\001newline\003/g; + $_; +} + +sub root_and_suffix { + local($filename) = @_; + local($root,$suffix); + + # find the file's "suffix" (NB: *.lit.hs has a 6-letter suffix) + if ($filename =~ /\.(lit\.[^\.\/]+)$/) { # cf \input handling in reader + $suffix = $1; + ($root = $filename) =~ s/\.(lit\.[^\.\/]+)$//; + + } elsif ($filename =~ /\.([^\.\/]+)$/) { + $suffix = $1; + ($root = $filename) =~ s/\.([^\.\/]+)$//; + + } else { + # should there be a warning or something here? + $root = '???'; + $suffix = '???'; + } + ($root, $suffix); +} + |