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.
7 # This package prepares a LaTeX file for translation to LyX
8 # - Translates some local commands (e.g., {\em blah} to {\emph{blah}})
9 # - Prepares math mode stuff for LyX. LyX reads LaTeX math mode directly,
10 # so reLyX can basically copy all math mode exactly, but LyX is a
11 # bit stricter than LaTeX. E.g., translate 'x^2' -> 'x^{2}
12 # - Removes optional arguments if LyX doesn't understand them, e.g. \\
20 my $last_eaten; # last token we ate
22 # List of commands for which LyX doesn't support the optional argument
23 my @DeleteOptArg = map {"\\$_"} qw(\\ \\*
24 chapter section subsection subsubsection paragraph subparagraph
27 my $debug_on; # was -d option given?
29 ######################### PARSER INVOCATION ################################
31 # This subroutine opens the TeX parser and processes the file.
32 # Arg0 is the name of the input TeX file
33 # Arg1 is the name of the output "clean" file
35 my ($InFileName, $OutFileName) = (shift,shift);
37 $debug_on = (defined($main::opt_d) && $main::opt_d);
38 my $zzz=$debug_on ? " TeX file ($InFileName --> $OutFileName)\n" :"... ";
39 print STDERR "Cleaning$zzz";
40 open (OUTFILE, ">$OutFileName") or die "problem opening $OutFileName: $!\n";
42 # Create the list of tokens for the parser
43 # Parts of the token list are swiped from TeX.pm
44 my %MyTokens = ( '{' => $Text::TeX::Tokens{'{'},
45 '}' => $Text::TeX::Tokens{'}'},
46 '$' => $Text::TeX::Tokens{'$'},
47 '$$' => $Text::TeX::Tokens{'$$'},
48 '\begin' => $Text::TeX::Tokens{'\begin'},
49 '\end' => $Text::TeX::Tokens{'\end'},
52 # Put local tokens, like \em, into %MyTokens
53 #Note: \cal is "local", although it's found in math mode
54 # (The "map" just puts a backslash in front of each word in the list)
55 my @LocalTokens = qw (em rm bf tt sf sc sl it
56 rmfamily ttfamily sffamily mdseries bfseries
57 upshape itshape slshape scshape cal
59 foreach (@LocalTokens) {
60 $MyTokens{"\\$_"} = $Text::TeX::Tokens{'\em'}
62 # Now add any commands
63 &ReadCommands::Merge(\%MyTokens);
65 # Create the fileobject
66 my $file = new Text::TeX::OpenFile
68 'defaultact' => \&clean_tex,
69 'tokens' => \%MyTokens;
71 # Now actually process the file
74 #warn "Done cleaning TeX file\n";
75 } # end sub call_parser
78 ####################### MAIN TRANSLATING SUBROUTINE ########################
79 # Routine called by the TeX-parser to perform token-processing.
81 my($eaten,$txt) = (shift,shift);
84 # Sub translate is given a string and one of the translation tables below.
85 # It returns the translation, or just the string if there's no translation
86 # Translation table for TT::Begin::Group tokens
88 '$' => '\(', # LyX math mode doesn't
89 '$$' => '\[', # understand \$ or $$
92 # Translation table for TT::End::Group tokens
98 # Translation table for TT::Token tokens whose translations should
99 # NOT have whitespace after them! See sub translate...
100 # Note that tokens of type TT::EndLocal are always translated to '}'. So,
101 # any token defined as a local token *must* be translated to something
102 # with a '{' (e.g., '\em' -> '\emph{') or we'll have mismatched braces
103 my %no_ws_transtbl = (
112 '\rmfamily' => '\textrm{',
113 '\ttfamily' => '\texttt{',
114 '\sffamily' => '\textsf{',
115 '\mdseries' => '\textmd{',
116 '\bfseries' => '\textbf{',
117 '\upshape' => '\textup{',
118 '\itshape' => '\textit{',
119 '\slshape' => '\textsl{',
120 '\scshape' => '\textsc{',
121 '\cal' => '\mathcal{',
125 # a faux "switch" statement. sets $_ for later use in pattern
128 $type =~ s/^Text::TeX::// or die "Non-Text::TeX object";
129 my $printstr = ""; # default for undefined printstrs etc.
130 SWITCH: for ($type) {
131 # Handle blank lines.
136 # Handle the end of a local font command - insert a '}'
138 # we could just say $printstr='}'
139 $printstr = &translate('}', \%endtranstbl);
143 # $eaten->exact_print is undefined for previous environments
144 $outstr = $eaten->exact_print;
145 if (! defined $outstr) { # comment at end of paragraph
146 warn "Weird undefined token $eaten!" unless $eaten->comment;
150 # Handle LaTeX tokens
152 my $realtok = $eaten->print; # w/out whitespace
153 # If a comment is its own paragraph, print nothing
154 last SWITCH unless defined($realtok);
155 # Special handling for \verb and \verb*
156 if ($realtok =~ /^\\verb\*?/) {
157 $printstr = &Verbatim::copy_verb($txt,$eaten);
161 # Translate token if necessary, or just print it
162 # "no_ws" is HACK to remove whitespace, so '\em ' -> '\emph{'
163 $printstr = &translate($outstr, \%no_ws_transtbl, "no_ws");
165 # Ignore optional argument(s) if necessary
166 $printstr .= &handle_opt_args($eaten,$txt);
171 # Tokens taking arguments, like '^'
172 # ADD '{' if there isn't one before the argument!
173 if (/^BegArgsToken$/) {
176 # Ignore optional argument(s) if necessary
177 $printstr .= &handle_opt_args($eaten,$txt);
179 # Add beginning brace before the 1st argument if there isn't one
180 my $tok = $txt->lookAheadToken;
181 $printstr .= '{' unless ($tok =~ /\{/);
185 # End of one argument, beginning of next
186 # Note: by default ArgToken,EndArgsToken print nothing
187 # ADD '}' if there isn't one after the last argument
188 # Then read and print any optional arguments which may exist
189 # between this argument the next (we must do this here or we would
190 # add a '{' before an optional argument!)
191 # ADD '{' if there isn't one before the next argument!
192 # (just like we do in BegArgsToken and EndArgsToken)
194 $printstr = $outstr; # = ''
196 # Add '}' after the argument that ended if necessary
197 $printstr .= '}' unless $last_eaten->print eq "\}";
199 # Eat and print any optional arguments
200 $printstr .= &handle_opt_args($eaten,$txt);
202 # Add '{' before the next argument if necessary
203 my $tok = $txt->lookAheadToken;
204 $printstr .= '{' unless ($tok =~ /\{/);
208 # End of tokens taking arguments, like '^'
209 # ADD '}' if there isn't one after the last argument, i.e.,
210 # if the previous token *wasn't* a '}'
211 # Kludge: for TeX style \input command ("\input foo" with no
212 # braces) we need to read the whole filename, but parser will have
213 # read only one char. So read in the rest of the filename before
215 if (/^EndArgsToken$/) {
216 $printstr = $outstr; # = ''
218 unless ($last_eaten->print eq "\}") {
219 my $s = $eaten->base_token;
220 if ($s->print eq "\\input") {
221 my $t = $txt->lookAheadToken;
222 # For one-char filename (a.tex) do nothing
223 if ($t =~ /^[\w.\-]/) {
224 my $u = $txt->eatMultiToken;
229 # TeX \input always adds .tex ending
236 # Don't bother eating optional args coming after the last
237 # required arg: they'll just be copied as text
241 # Handle opening groups, like '{' and '$'.
242 if (/Begin::Group$/) {
243 $printstr = &translate($outstr,\%begtranstbl);
247 # Handle closing groups, like '}' and '$'.
249 $printstr = &translate($outstr, \%endtranstbl);
253 if (/Begin::Group::Args/) {
254 my $env = $eaten->environment;
256 if ($env eq "verbatim" || $env eq "reLyXskip") {
257 # copy everything up to "\end{foo}"
258 $printstr .= &Verbatim::copy_verbatim($txt, $eaten);
263 if (/End::Group::Args/) {
273 # The default action - print the string.
275 } # end SWITCH:for ($type)
277 # Actually print the string
278 if (defined $printstr) {
279 print OUTFILE $printstr;
280 $last_eaten = $eaten; #save for next time
281 } else {warn "Undefined printstr";}
283 } # end sub clean_tex
285 #################### TRANSLATOR SUBROUTINES ###############################
287 # Replace a string (possibly with whitespace around it) with another
288 # Arg0 is a string, Arg1 is a reference to a hash containing translations
289 # If a token not in the table is passed in, do nothing
290 # If Arg2 is defined AND the token is known, then remove whitespace from
291 # the end of the translated token. This is a HACK to do '\em ' -> '\emph{'
292 # Return the string, possibly modified
293 my ($tokstr, $transref) = (shift, shift);
294 my $remove_ws = shift;
295 my %transtable = %$transref;
297 # remove whitespace from the string (since transtable doesn't have it)
298 my $stripstr = $tokstr;
299 $stripstr =~ s/^\s*(\S+)\s*$/$1/ or warn "couldn't strip token";
300 if ( exists $transtable{$stripstr} ) {
301 # use \Q or \, (, $, and [ will be misinterpreted
302 $tokstr =~ s/\Q$stripstr\E/$transtable{$stripstr}/;
305 if (defined $remove_ws) {
313 sub handle_opt_args {
314 # read and concatenate OR IGNORE optional arguments
315 # Arg0 is a BegArgsToken or ArgToken
316 my ($eaten,$fileobject) = (shift,shift);
319 # If at end of paragraph, don't bother looking for optArgs
320 return "" unless $fileobject->lookAheadToken;
322 # Get the next argument(s) expected for this token == /^o*[rR]?$/
323 # If there are no args expected, just return
324 my $curr_args = $eaten->next_args($fileobject) or return "";
326 # Now print or ignore any optional arguments
327 # If there's an 'r' in curr_args, we're done for now
329 my $token_name = $eaten->token_name; # (needed for EndArgsToken, e.g.)
330 while ($curr_args =~ s/^o//) {
331 my $opt = $fileobject->eatOptionalArgument;
332 # Print any initial space before the optional argument
333 if ($foo = $opt->exact_print) {
334 if ($foo =~ /^(\s+)/) {
339 # Print the argument or ignore it
341 if (grep /^\Q$token_name\E$/, @DeleteOptArg) {
342 print "Optional argument '",$opt->print,
343 "' to macro $token_name ignored\n";
345 $outstr .= "[" . $opt->print . "]";
347 } # Was an optional argument found?
351 } # end sub handle_opt_args
353 1; # return true value to calling program