lyx_mirror/lib/reLyX/CleanTeX.pm

354 lines
11 KiB
Perl
Raw Normal View History

# This file is part of reLyX
# Copyright (c) 1998-9 Amir Karger karger@post.harvard.edu
# You are free to use and modify this code under the terms of
# the GNU General Public Licence version 2 or later.
package CleanTeX;
# This package prepares a LaTeX file for translation to LyX
# - Translates some local commands (e.g., {\em blah} to {\emph{blah}})
# - Prepares math mode stuff for LyX. LyX reads LaTeX math mode directly,
# so reLyX can basically copy all math mode exactly, but LyX is a
# bit stricter than LaTeX. E.g., translate 'x^2' -> 'x^{2}
# - Removes optional arguments if LyX doesn't understand them, e.g. \\
use strict;
use Verbatim;
######
# Global variables
my $last_eaten; # last token we ate
# List of commands for which LyX doesn't support the optional argument
my @DeleteOptArg = map {"\\$_"} qw(\\ \\*
chapter section subsection subsubsection paragraph subparagraph
);
my $debug_on; # was -d option given?
######################### PARSER INVOCATION ################################
sub call_parser {
# This subroutine opens the TeX parser and processes the file.
# Arg0 is the name of the input TeX file
# Arg1 is the name of the output "clean" file
my ($InFileName, $OutFileName) = (shift,shift);
$debug_on = (defined($main::opt_d) && $main::opt_d);
my $zzz=$debug_on ? " TeX file ($InFileName --> $OutFileName)\n" :"... ";
print STDERR "Cleaning$zzz";
open (OUTFILE, ">$OutFileName") or die "problem opening $OutFileName: $!\n";
# Create the list of tokens for the parser
# Parts of the token list are swiped from TeX.pm
my %MyTokens = ( '{' => $Text::TeX::Tokens{'{'},
'}' => $Text::TeX::Tokens{'}'},
'$' => $Text::TeX::Tokens{'$'},
'$$' => $Text::TeX::Tokens{'$$'},
'\begin' => $Text::TeX::Tokens{'\begin'},
'\end' => $Text::TeX::Tokens{'\end'},
);
# Put local tokens, like \em, into %MyTokens
#Note: \cal is "local", although it's found in math mode
# (The "map" just puts a backslash in front of each word in the list)
my @LocalTokens = qw (em rm bf tt sf sc sl it
rmfamily ttfamily sffamily mdseries bfseries
upshape itshape slshape scshape cal
);
foreach (@LocalTokens) {
$MyTokens{"\\$_"} = $Text::TeX::Tokens{'\em'}
}
# Now add any commands
&ReadCommands::Merge(\%MyTokens);
# Create the fileobject
my $file = new Text::TeX::OpenFile
$InFileName,
'defaultact' => \&clean_tex,
'tokens' => \%MyTokens;
# Now actually process the file
$file->process;
close OUTFILE;
#warn "Done cleaning TeX file\n";
} # end sub call_parser
####################### MAIN TRANSLATING SUBROUTINE ########################
# Routine called by the TeX-parser to perform token-processing.
sub clean_tex {
my($eaten,$txt) = (shift,shift);
my ($outstr, $type);
# Sub translate is given a string and one of the translation tables below.
# It returns the translation, or just the string if there's no translation
# Translation table for TT::Begin::Group tokens
my %begtranstbl = (
'$' => '\(', # LyX math mode doesn't
'$$' => '\[', # understand \$ or $$
);
# Translation table for TT::End::Group tokens
my %endtranstbl = (
'$' => '\)',
'$$' => '\]',
);
# Translation table for TT::Token tokens whose translations should
# NOT have whitespace after them! See sub translate...
# Note that tokens of type TT::EndLocal are always translated to '}'. So,
# any token defined as a local token *must* be translated to something
# with a '{' (e.g., '\em' -> '\emph{') or we'll have mismatched braces
my %no_ws_transtbl = (
'\em' => '\emph{',
'\rm' => '\textrm{',
'\bf' => '\textbf{',
'\tt' => '\texttt{',
'\sf' => '\textsf{',
'\sc' => '\textsc{',
'\sl' => '\textsl{',
'\it' => '\textit{',
'\rmfamily' => '\textrm{',
'\ttfamily' => '\texttt{',
'\sffamily' => '\textsf{',
'\mdseries' => '\textmd{',
'\bfseries' => '\textbf{',
'\upshape' => '\textup{',
'\itshape' => '\textit{',
'\slshape' => '\textsl{',
'\scshape' => '\textsc{',
'\cal' => '\mathcal{',
);
# a faux "switch" statement. sets $_ for later use in pattern
# matching.
$type = ref($eaten);
$type =~ s/^Text::TeX::// or die "Non-Text::TeX object";
my $printstr = ""; # default for undefined printstrs etc.
SWITCH: for ($type) {
# Handle blank lines.
if (/Paragraph/) {
last SWITCH;
}
# Handle the end of a local font command - insert a '}'
if (/EndLocal/) {
# we could just say $printstr='}'
$printstr = &translate('}', \%endtranstbl);
last SWITCH;
}
# $eaten->exact_print is undefined for previous environments
$outstr = $eaten->exact_print;
if (! defined $outstr) { # comment at end of paragraph
warn "Weird undefined token $eaten!" unless $eaten->comment;
last SWITCH;
}
# Handle LaTeX tokens
if (/^Token$/) {
my $realtok = $eaten->print; # w/out whitespace
# If a comment is its own paragraph, print nothing
last SWITCH unless defined($realtok);
# Special handling for \verb and \verb*
if ($realtok =~ /^\\verb\*?/) {
$printstr = &Verbatim::copy_verb($txt,$eaten);
last SWITCH;
}
# Translate token if necessary, or just print it
# "no_ws" is HACK to remove whitespace, so '\em ' -> '\emph{'
$printstr = &translate($outstr, \%no_ws_transtbl, "no_ws");
# Ignore optional argument(s) if necessary
$printstr .= &handle_opt_args($eaten,$txt);
last SWITCH;
}
# Tokens taking arguments, like '^'
# ADD '{' if there isn't one before the argument!
if (/^BegArgsToken$/) {
$printstr = $outstr;
# Ignore optional argument(s) if necessary
$printstr .= &handle_opt_args($eaten,$txt);
# Add beginning brace before the 1st argument if there isn't one
my $tok = $txt->lookAheadToken;
$printstr .= '{' unless ($tok =~ /\{/);
last SWITCH;
}
# End of one argument, beginning of next
# Note: by default ArgToken,EndArgsToken print nothing
# ADD '}' if there isn't one after the last argument
# Then read and print any optional arguments which may exist
# between this argument the next (we must do this here or we would
# add a '{' before an optional argument!)
# ADD '{' if there isn't one before the next argument!
# (just like we do in BegArgsToken and EndArgsToken)
if (/^ArgToken$/) {
$printstr = $outstr; # = ''
# Add '}' after the argument that ended if necessary
$printstr .= '}' unless $last_eaten->print eq "\}";
# Eat and print any optional arguments
$printstr .= &handle_opt_args($eaten,$txt);
# Add '{' before the next argument if necessary
my $tok = $txt->lookAheadToken;
$printstr .= '{' unless ($tok =~ /\{/);
last SWITCH;
}
# End of tokens taking arguments, like '^'
# ADD '}' if there isn't one after the last argument, i.e.,
# if the previous token *wasn't* a '}'
# Kludge: for TeX style \input command ("\input foo" with no
# braces) we need to read the whole filename, but parser will have
# read only one char. So read in the rest of the filename before
# printing the '}'.
if (/^EndArgsToken$/) {
$printstr = $outstr; # = ''
unless ($last_eaten->print eq "\}") {
my $s = $eaten->base_token;
if ($s->print eq "\\input") {
my $t = $txt->lookAheadToken;
# For one-char filename (a.tex) do nothing
if ($t =~ /^[\w.\-]/) {
my $u = $txt->eatMultiToken;
$t = $u->print;
$t =~ s/\s+//g;
$printstr .= $t;
}
# TeX \input always adds .tex ending
$printstr .= ".tex";
}
$printstr .= '}';
}
# Don't bother eating optional args coming after the last
# required arg: they'll just be copied as text
last SWITCH;
}
# Handle opening groups, like '{' and '$'.
if (/Begin::Group$/) {
$printstr = &translate($outstr,\%begtranstbl);
last SWITCH;
}
# Handle closing groups, like '}' and '$'.
if (/End::Group$/) {
$printstr = &translate($outstr, \%endtranstbl);
last SWITCH;
}
if (/Begin::Group::Args/) {
my $env = $eaten->environment;
$printstr = $outstr;
if ($env eq "verbatim" || $env eq "reLyXskip") {
# copy everything up to "\end{foo}"
$printstr .= &Verbatim::copy_verbatim($txt, $eaten);
}
last SWITCH;
}
if (/End::Group::Args/) {
$printstr = $outstr;
last SWITCH;
}
if (/Text/) {
$printstr = $outstr;
last SWITCH;
}
# The default action - print the string.
$printstr = $outstr;
} # end SWITCH:for ($type)
# Actually print the string
if (defined $printstr) {
print OUTFILE $printstr;
$last_eaten = $eaten; #save for next time
} else {warn "Undefined printstr";}
} # end sub clean_tex
#################### TRANSLATOR SUBROUTINES ###############################
sub translate {
# Replace a string (possibly with whitespace around it) with another
# Arg0 is a string, Arg1 is a reference to a hash containing translations
# If a token not in the table is passed in, do nothing
# If Arg2 is defined AND the token is known, then remove whitespace from
# the end of the translated token. This is a HACK to do '\em ' -> '\emph{'
# Return the string, possibly modified
my ($tokstr, $transref) = (shift, shift);
my $remove_ws = shift;
my %transtable = %$transref;
# remove whitespace from the string (since transtable doesn't have it)
my $stripstr = $tokstr;
$stripstr =~ s/^\s*(\S+)\s*$/$1/ or warn "couldn't strip token";
if ( exists $transtable{$stripstr} ) {
# use \Q or \, (, $, and [ will be misinterpreted
$tokstr =~ s/\Q$stripstr\E/$transtable{$stripstr}/;
# remove whitespace?
if (defined $remove_ws) {
$tokstr =~ s/\s*$//;
}
}
return $tokstr;
}
sub handle_opt_args {
# read and concatenate OR IGNORE optional arguments
# Arg0 is a BegArgsToken or ArgToken
my ($eaten,$fileobject) = (shift,shift);
my $outstr = "";
# If at end of paragraph, don't bother looking for optArgs
return "" unless $fileobject->lookAheadToken;
# Get the next argument(s) expected for this token == /^o*[rR]?$/
# If there are no args expected, just return
my $curr_args = $eaten->next_args($fileobject) or return "";
# Now print or ignore any optional arguments
# If there's an 'r' in curr_args, we're done for now
my $foo;
my $token_name = $eaten->token_name; # (needed for EndArgsToken, e.g.)
while ($curr_args =~ s/^o//) {
my $opt = $fileobject->eatOptionalArgument;
# Print any initial space before the optional argument
if ($foo = $opt->exact_print) {
if ($foo =~ /^(\s+)/) {
$outstr .= $1;
}
}
# Print the argument or ignore it
if ($opt->print) {
if (grep /^\Q$token_name\E$/, @DeleteOptArg) {
print "Optional argument '",$opt->print,
"' to macro $token_name ignored\n";
} else {
$outstr .= "[" . $opt->print . "]";
}
} # Was an optional argument found?
}
return $outstr;
} # end sub handle_opt_args
1; # return true value to calling program