home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / lyx21041.zip / XFree86 / lib / X11 / lyx / reLyX / CleanTeX.pm (.txt) < prev    next >
LaTeX Document  |  1999-03-21  |  12KB  |  293 lines
  1. # This file is part of reLyX
  2. # Copyright (c) 1998-9 Amir Karger karger@post.harvard.edu
  3. # You are free to use and modify this code under the terms of
  4. # the GNU General Public Licence version 2 or later.
  5. package CleanTeX;
  6. # This package prepares a LaTeX file for translation to LyX
  7. # - Translates some local commands (e.g., {\em blah} to {\emph{blah}})
  8. # - Prepares math mode stuff for LyX. LyX reads LaTeX math mode directly,
  9. #      so reLyX can basically copy all math mode exactly, but LyX is a
  10. #      bit stricter than LaTeX. E.g., translate 'x^2' -> 'x^{2}
  11. # - Removes optional arguments if LyX doesn't understand them, e.g. \\
  12. use strict;
  13. use Verbatim;
  14. ######
  15. # Global variables
  16. my $last_eaten; # last token we ate
  17. # List of commands for which LyX doesn't support the optional argument
  18. my @DeleteOptArg = map {"\\$_"} qw(\\ \\*
  19.               chapter section subsection subsubsection paragraph subparagraph
  20.           );
  21. my $debug_on; # was -d option given?
  22. #########################   PARSER INVOCATION   ################################
  23. sub call_parser {
  24. # This subroutine opens the TeX parser and processes the file.
  25. # Arg0 is the name of the input TeX file
  26. # Arg1 is the name of the output "clean" file
  27.     my ($InFileName, $OutFileName) = (shift,shift);
  28.     $debug_on = (defined($main::opt_d) && $main::opt_d);
  29.     my $zzz=$debug_on ? " TeX file ($InFileName --> $OutFileName)\n" :"... ";
  30.     print STDERR "Cleaning$zzz";
  31.     open (OUTFILE, ">$OutFileName") or die "problem opening $OutFileName: $!\n";
  32. # Create the list of tokens for the parser
  33. # Parts of the token list are swiped from TeX.pm
  34.     my %MyTokens = ( '{' => $Text::TeX::Tokens{'{'},
  35.              '}' => $Text::TeX::Tokens{'}'},
  36.              '$' => $Text::TeX::Tokens{'$'},
  37.              '$$' => $Text::TeX::Tokens{'$$'},
  38.              '\begin' => $Text::TeX::Tokens{'\begin'},
  39.              '\end' => $Text::TeX::Tokens{'\end'},
  40.            );
  41.     # Put local tokens, like \em, into %MyTokens
  42.     #Note: \cal is "local", although it's found in math mode
  43.     # (The "map" just puts a backslash in front of each word in the list)
  44.     my @LocalTokens = qw (em rm bf tt sf sc sl it
  45.              rmfamily ttfamily sffamily mdseries bfseries
  46.             upshape itshape slshape scshape cal
  47.             ); 
  48.     foreach (@LocalTokens) {
  49.     $MyTokens{"\\$_"} = $Text::TeX::Tokens{'\em'}
  50.     }
  51.     # Now add any commands
  52.     &ReadCommands::Merge(\%MyTokens);
  53. # Create the fileobject
  54.     my $file = new Text::TeX::OpenFile 
  55.        $InFileName,
  56.        'defaultact' => \&clean_tex,
  57.        'tokens' => \%MyTokens;
  58. # Now actually process the file
  59.     $file->process;
  60.     close OUTFILE;
  61.     #warn "Done cleaning TeX file\n";
  62. } # end sub call_parser
  63. #######################   MAIN TRANSLATING SUBROUTINE   ########################
  64. # Routine called by the TeX-parser to perform token-processing.
  65. sub clean_tex {
  66.     my($eaten,$txt) = (shift,shift);
  67.     my ($outstr, $type);
  68.     # Sub translate is given a string and one of the translation tables below.
  69.     # It returns the translation, or just the string if there's no translation
  70.     # Translation table for TT::Begin::Group tokens
  71.     my %begtranstbl = (
  72.             '$' => '\(', # LyX math mode doesn't
  73.             '$$' => '\[', # understand \$ or $$
  74.             );
  75.     # Translation table for TT::End::Group tokens
  76.     my %endtranstbl = (
  77.                '$' => '\)',
  78.                '$$' => '\]',
  79.                );
  80.     # Translation table for TT::Token tokens whose translations should
  81.     #    NOT have whitespace after them! See sub translate...
  82.     #   Note that tokens of type TT::EndLocal are always translated to '}'. So,
  83.     #   any token defined as a local token *must* be translated to something
  84.     #   with a '{' (e.g., '\em' -> '\emph{') or we'll have mismatched braces
  85.     my %no_ws_transtbl = (
  86.             '\em' => '\emph{',
  87.             '\rm' => '\textrm{',
  88.             '\bf' => '\textbf{',
  89.             '\tt' => '\texttt{',
  90.             '\sf' => '\textsf{',
  91.             '\sc' => '\textsc{',
  92.             '\sl' => '\textsl{',
  93.             '\it' => '\textit{',
  94.             '\rmfamily' => '\textrm{',
  95.             '\ttfamily' => '\texttt{',
  96.             '\sffamily' => '\textsf{',
  97.             '\mdseries' => '\textmd{',
  98.             '\bfseries' => '\textbf{',
  99.             '\upshape' => '\textup{',
  100.             '\itshape' => '\textit{',
  101.             '\slshape' => '\textsl{',
  102.             '\scshape' => '\textsc{',
  103.             '\cal' => '\mathcal{',
  104.             );
  105.     # a faux "switch" statement.  sets $_ for later use in pattern
  106.     # matching.
  107.     $type = ref($eaten);
  108.     $type =~ s/^Text::TeX::// or die "Non-Text::TeX object";
  109.     my $printstr = ""; # default for undefined printstrs etc.
  110.     SWITCH: for ($type) {
  111.        # Handle blank lines.
  112.        if (/Paragraph/) {
  113.            last SWITCH;
  114.        }
  115.        # Handle the end of a local font command - insert a '}'
  116.        if (/EndLocal/) {
  117.            # we could just say $printstr='}'
  118.            $printstr = &translate('}', \%endtranstbl);
  119.            last SWITCH;
  120.        }
  121.        # $eaten->exact_print is undefined for previous environments
  122.        $outstr = $eaten->exact_print;
  123.        if (! defined $outstr) { # comment at end of paragraph
  124.            warn "Weird undefined token $eaten!" unless $eaten->comment;
  125.            last SWITCH;
  126.         }
  127.        # Handle LaTeX tokens
  128.        if (/^Token$/) {
  129.            my $realtok = $eaten->print; # w/out whitespace
  130.            # If a comment is its own paragraph, print nothing
  131.            last SWITCH unless defined($realtok);
  132.            # Special handling for \verb and \verb*
  133.            if ($realtok =~ /^\\verb\*?/) {
  134.                $printstr = &Verbatim::copy_verb($txt,$eaten);
  135.            last SWITCH;
  136.            }
  137.            # Translate token if necessary, or just print it
  138.            # "no_ws" is HACK to remove whitespace, so '\em ' -> '\emph{'
  139.            $printstr = &translate($outstr, \%no_ws_transtbl, "no_ws");
  140.            # Ignore optional argument(s) if necessary
  141.            $printstr .= &handle_opt_args($eaten,$txt);
  142.            last SWITCH;
  143.        }
  144.        # Tokens taking arguments, like '^'
  145.        # ADD '{' if there isn't one before the argument!
  146.        if (/^BegArgsToken$/) {
  147.            $printstr = $outstr;
  148.            # Ignore optional argument(s) if necessary
  149.            $printstr .= &handle_opt_args($eaten,$txt);
  150.            # Add beginning brace before the 1st argument if there isn't one
  151.            my $tok = $txt->lookAheadToken;
  152.            $printstr .= '{' unless ($tok =~ /\{/);
  153.            last SWITCH;
  154.        }
  155.        # End of one argument, beginning of next
  156.        # Note: by default ArgToken,EndArgsToken print nothing
  157.        # ADD '}' if there isn't one after the last argument
  158.        # Then read and print any optional arguments which may exist
  159.        #    between this argument the next (we must do this here or we would
  160.        #    add a '{' before an optional argument!)
  161.        # ADD '{' if there isn't one before the next argument!
  162.        # (just like we do in BegArgsToken and EndArgsToken)
  163.        if (/^ArgToken$/) {
  164.            $printstr = $outstr; # = ''
  165.            # Add '}' after the argument that ended if necessary
  166.            $printstr .= '}' unless $last_eaten->print eq "\}";
  167.            # Eat and print any optional arguments
  168.            $printstr .= &handle_opt_args($eaten,$txt);
  169.            # Add '{' before the next argument if necessary
  170.            my $tok = $txt->lookAheadToken;
  171.            $printstr .= '{' unless ($tok =~ /\{/);
  172.            last SWITCH;
  173.        }
  174.        # End of tokens taking arguments, like '^'
  175.        #     ADD '}' if there isn't one after the last argument, i.e., 
  176.        # if the previous token *wasn't* a '}'
  177.        #     Kludge: for TeX style \input command ("\input foo" with no
  178.        # braces) we need to read the whole filename, but parser will have
  179.        # read only one char. So read in the rest of the filename before
  180.        # printing the '}'.
  181.        if (/^EndArgsToken$/) {
  182.            $printstr = $outstr; # = ''
  183.            unless ($last_eaten->print eq "\}") {
  184.            my $s = $eaten->base_token;
  185.            if ($s->print eq "\\input") {
  186.                my $t = $txt->lookAheadToken;
  187.                # For one-char filename (a.tex) do nothing
  188.                if ($t =~ /^[\w.\-]/) {
  189.                my $u = $txt->eatMultiToken;
  190.                $t = $u->print;
  191.                $t =~ s/\s+//g;
  192.                $printstr .= $t;
  193.             # TeX \input always adds .tex ending
  194.             $printstr .= ".tex";
  195.             }
  196.            $printstr .= '}';
  197.            # Don't bother eating optional args coming after the last
  198.            # required arg: they'll just be copied as text
  199.            last SWITCH;
  200.        }
  201.        # Handle opening groups, like '{' and '$'.
  202.        if (/Begin::Group$/) {
  203.            $printstr = &translate($outstr,\%begtranstbl);
  204.            last SWITCH;
  205.        }
  206.        # Handle closing groups, like '}' and '$'.
  207.        if (/End::Group$/) {
  208.            $printstr = &translate($outstr, \%endtranstbl);
  209.            last SWITCH;
  210.        }
  211.        if (/Begin::Group::Args/) {
  212.            my $env = $eaten->environment;
  213.            $printstr = $outstr;
  214.            if ($env eq "verbatim" || $env eq "reLyXskip") {
  215.            # copy everything up to "\end{foo}"
  216.                $printstr .= &Verbatim::copy_verbatim($txt, $eaten);
  217.            }
  218.            last SWITCH;
  219.        }
  220.        if  (/End::Group::Args/) {
  221.            $printstr = $outstr;
  222.            last SWITCH;
  223.        }
  224.        if (/Text/) {
  225.            $printstr = $outstr;
  226.            last SWITCH;
  227.        }
  228.        # The default action - print the string.
  229.        $printstr = $outstr;
  230.     } # end SWITCH:for ($type)
  231.     # Actually print the string
  232.     if (defined $printstr) { 
  233.     print OUTFILE $printstr;
  234.     $last_eaten = $eaten; #save for next time
  235.     } else {warn "Undefined printstr";}
  236. } # end sub clean_tex
  237. ####################   TRANSLATOR SUBROUTINES    ###############################
  238. sub translate {
  239. # Replace a string (possibly with whitespace around it) with another
  240. # Arg0 is a string, Arg1 is a reference to a hash containing translations
  241. # If a token not in the table is passed in, do nothing
  242. # If Arg2 is defined AND the token is known, then remove whitespace from
  243. #     the end of the translated token. This is a HACK to do '\em ' -> '\emph{'
  244. # Return the string, possibly modified
  245.     my ($tokstr, $transref) = (shift, shift);
  246.     my $remove_ws = shift;
  247.     my %transtable = %$transref;
  248.     # remove whitespace from the string (since transtable doesn't have it)
  249.     my $stripstr = $tokstr;
  250.     $stripstr =~ s/^\s*(\S+)\s*$/$1/ or warn "couldn't strip token";
  251.     if ( exists $transtable{$stripstr} ) {
  252.          # use \Q or \, (, $, and [ will be misinterpreted
  253.         $tokstr =~ s/\Q$stripstr\E/$transtable{$stripstr}/;
  254.     # remove whitespace?
  255.     if (defined $remove_ws) {
  256.         $tokstr =~ s/\s*$//;
  257.     }
  258.     return $tokstr;
  259. sub handle_opt_args {
  260. # read and concatenate OR IGNORE optional arguments
  261. # Arg0 is a BegArgsToken or ArgToken
  262.     my ($eaten,$fileobject) = (shift,shift);
  263.     my $outstr = "";
  264.     # If at end of paragraph, don't bother looking for optArgs
  265.     return "" unless $fileobject->lookAheadToken;
  266.     # Get the next argument(s) expected for this token == /^o*[rR]?$/
  267.     # If there are no args expected, just return
  268.     my $curr_args = $eaten->next_args($fileobject) or return "";
  269.     # Now print or ignore any optional arguments
  270.     # If there's an 'r' in curr_args, we're done for now
  271.     my $foo;
  272.     my $token_name = $eaten->token_name; # (needed for EndArgsToken, e.g.)
  273.     while ($curr_args =~ s/^o//) {
  274.         my $opt = $fileobject->eatOptionalArgument;
  275.     # Print any initial space before the optional argument
  276.         if ($foo = $opt->exact_print) {
  277.         if ($foo =~ /^(\s+)/) {
  278.             $outstr .= $1;
  279.         }
  280.     # Print the argument or ignore it
  281.         if ($opt->print) {
  282.         if (grep /^\Q$token_name\E$/, @DeleteOptArg) {
  283.             print "Optional argument '",$opt->print,
  284.                "' to macro $token_name ignored\n";
  285.         } else {
  286.             $outstr .= "[" . $opt->print . "]";
  287.         }
  288.         } # Was an optional argument found?
  289.     }
  290.     return $outstr;
  291. } # end sub handle_opt_args
  292. 1; # return true value to calling program
  293.