From 99a58e51f593cec317076429bf73efd4b784d3b8 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sun, 19 Dec 2010 10:13:55 -0800 Subject: [PATCH] LaTeX writer: Modified to use Pretty. Improved footnote formatting, removed spurious blank lines. --- src/Text/Pandoc/Writers/LaTeX.hs | 64 +++++++++--------- tests/writer.latex | 107 ++++++++++--------------------- 2 files changed, 65 insertions(+), 106 deletions(-) diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 5a203fd23..0c35c5811 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2006-2010 John MacFarlane @@ -32,10 +33,10 @@ import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Pandoc.Templates import Text.Printf ( printf ) -import Data.List ( (\\), isSuffixOf, isPrefixOf, intersperse, intercalate ) +import Data.List ( (\\), isSuffixOf, isPrefixOf, intercalate ) import Data.Char ( toLower, isPunctuation ) import Control.Monad.State -import Text.PrettyPrint.HughesPJ hiding ( Str ) +import Text.Pandoc.Pretty import System.FilePath (dropExtension) data WriterState = @@ -71,17 +72,21 @@ pandocToLaTeX options (Pandoc (Meta title authors date) blocks) = do "{report}" `isSuffixOf` x) when (any usesBookClass (lines template)) $ modify $ \s -> s{stBook = True} - titletext <- liftM render $ inlineListToLaTeX title - authorsText <- mapM (liftM render . inlineListToLaTeX) authors - dateText <- liftM render $ inlineListToLaTeX date + opts <- liftM stOptions get + let colwidth = if writerWrapText opts + then Just $ writerColumns opts + else Nothing + titletext <- liftM (render colwidth) $ inlineListToLaTeX title + authorsText <- mapM (liftM (render colwidth) . inlineListToLaTeX) authors + dateText <- liftM (render colwidth) $ inlineListToLaTeX date let (blocks', lastHeader) = if writerCiteMethod options == Citeproc then (blocks, []) else case last blocks of Header 1 il -> (init blocks, il) _ -> (blocks, []) body <- blockListToLaTeX blocks' - biblioTitle <- liftM render $ inlineListToLaTeX lastHeader - let main = render body + biblioTitle <- liftM (render colwidth) $ inlineListToLaTeX lastHeader + let main = render colwidth body st <- get let biblioFiles = intercalate "," $ map dropExtension $ writerBiblioFiles options citecontext = case writerCiteMethod options of @@ -152,20 +157,15 @@ deVerb (other:rest) = other:(deVerb rest) blockToLaTeX :: Block -- ^ Block to convert -> State WriterState Doc blockToLaTeX Null = return empty -blockToLaTeX (Plain lst) = do - st <- get - let opts = stOptions st - wrapTeXIfNeeded opts True inlineListToLaTeX lst +blockToLaTeX (Plain lst) = inlineListToLaTeX lst blockToLaTeX (Para [Image txt (src,tit)]) = do capt <- inlineListToLaTeX txt img <- inlineToLaTeX (Image txt (src,tit)) return $ text "\\begin{figure}[htb]" $$ text "\\centering" $$ img $$ - (text "\\caption{" <> capt <> char '}') $$ text "\\end{figure}\n" + (text "\\caption{" <> capt <> char '}') $$ text "\\end{figure}" $$ blankline blockToLaTeX (Para lst) = do - st <- get - let opts = stOptions st - result <- wrapTeXIfNeeded opts True inlineListToLaTeX lst - return $ result <> char '\n' + result <- inlineListToLaTeX lst + return $ result <> blankline blockToLaTeX (BlockQuote lst) = do contents <- blockListToLaTeX lst return $ text "\\begin{quote}" $$ contents $$ text "\\end{quote}" @@ -181,8 +181,8 @@ blockToLaTeX (CodeBlock (_,classes,_) str) = do modify $ \s -> s{ stVerbInNote = True } return "Verbatim" else return "verbatim" - return $ text ("\\begin{" ++ env ++ "}\n") <> text str <> - text ("\n\\end{" ++ env ++ "}") + return $ "\\begin{" <> text env <> "}" $$ flush (text str) $$ + "\\end{" <> text env <> "}" $$ cr -- final cr needed because of footnotes blockToLaTeX (RawHtml _) = return empty blockToLaTeX (BulletList lst) = do items <- mapM listItemToLaTeX lst @@ -211,8 +211,8 @@ blockToLaTeX (DefinitionList lst) = do items <- mapM defListItemToLaTeX lst return $ text "\\begin{description}" $$ vcat items $$ text "\\end{description}" -blockToLaTeX HorizontalRule = return $ text $ - "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n" +blockToLaTeX HorizontalRule = return $ + "\\begin{center}\\rule{3in}{0.4pt}\\end{center}" $$ blankline blockToLaTeX (Header level lst) = do let lst' = deVerb lst txt <- inlineListToLaTeX lst' @@ -229,7 +229,7 @@ blockToLaTeX (Header level lst) = do let stuffing = optional <> char '{' <> txt <> char '}' book <- liftM stBook get let level' = if book then level - 1 else level - let headerWith x y = text x <> y <> char '\n' + let headerWith x y = text x <> y $$ blankline return $ case level' of 0 -> headerWith "\\chapter" stuffing 1 -> headerWith "\\section" stuffing @@ -237,7 +237,7 @@ blockToLaTeX (Header level lst) = do 3 -> headerWith "\\subsubsection" stuffing 4 -> headerWith "\\paragraph" stuffing 5 -> headerWith "\\subparagraph" stuffing - _ -> txt <> char '\n' + _ -> txt $$ blankline blockToLaTeX (Table caption aligns widths heads rows) = do headers <- if all null heads then return empty @@ -246,13 +246,13 @@ blockToLaTeX (Table caption aligns widths heads rows) = do rows' <- mapM tableRowToLaTeX rows let colDescriptors = concat $ zipWith toColDescriptor widths aligns let tableBody = text ("\\begin{tabular}{" ++ colDescriptors ++ "}") $$ - headers $$ vcat rows' $$ text "\\end{tabular}" + headers $$ vcat rows' $$ text "\\end{tabular}" let centered txt = text "\\begin{center}" $$ txt $$ text "\\end{center}" modify $ \s -> s{ stTable = True } return $ if isEmpty captionText - then centered tableBody <> char '\n' - else text "\\begin{table}[h]" $$ centered tableBody $$ - inCmd "caption" captionText $$ text "\\end{table}\n" + then centered tableBody $$ blankline + else text "\\begin{table}[h]" $$ centered tableBody $$ + inCmd "caption" captionText $$ text "\\end{table}" $$ blankline toColDescriptor :: Double -> Alignment -> String toColDescriptor 0 align = @@ -285,7 +285,7 @@ listItemToLaTeX lst = blockListToLaTeX lst >>= return . (text "\\item" $$) . defListItemToLaTeX :: ([Inline], [[Block]]) -> State WriterState Doc defListItemToLaTeX (term, defs) = do term' <- inlineListToLaTeX $ deVerb term - def' <- liftM (vcat . intersperse (text "")) $ mapM blockListToLaTeX defs + def' <- liftM vsep $ mapM blockListToLaTeX defs return $ text "\\item[" <> term' <> text "]" $$ def' -- | Convert list of inline elements to LaTeX. @@ -360,7 +360,7 @@ inlineToLaTeX (Math DisplayMath str) = return $ text "\\[" <> text str <> text " inlineToLaTeX (TeX str) = return $ text str inlineToLaTeX (HtmlInline _) = return empty inlineToLaTeX (LineBreak) = return $ text "\\\\" -inlineToLaTeX Space = return $ char ' ' +inlineToLaTeX Space = return space inlineToLaTeX (Link txt (src, _)) = case txt of [Code x] | x == src -> -- autolink @@ -373,15 +373,11 @@ inlineToLaTeX (Image _ (source, _)) = do modify $ \s -> s{ stGraphics = True } return $ text $ "\\includegraphics{" ++ source ++ "}" inlineToLaTeX (Note contents) = do - st <- get - put (st {stInNote = True}) + modify (\s -> s{stInNote = True}) contents' <- blockListToLaTeX contents modify (\s -> s {stInNote = False}) - let rawnote = stripTrailingNewlines $ render contents' -- note: a \n before } is needed when note ends with a Verbatim environment - let optNewline = "\\end{Verbatim}" `isSuffixOf` rawnote - return $ text "\\footnote{" <> - text rawnote <> (if optNewline then char '\n' else empty) <> char '}' + return $ text "\\footnote{" <> nest 2 contents' <> char '}' citationsToNatbib :: [Citation] -> State WriterState Doc diff --git a/tests/writer.latex b/tests/writer.latex index 33c52eadd..374815f63 100644 --- a/tests/writer.latex +++ b/tests/writer.latex @@ -36,8 +36,8 @@ \begin{document} \maketitle -This is a set of tests for pandoc. Most of them are adapted from -John Gruber's markdown test suite. +This is a set of tests for pandoc. Most of them are adapted from John Gruber's +markdown test suite. \begin{center}\rule{3in}{0.4pt}\end{center} @@ -69,9 +69,9 @@ with no blank line Here's a regular paragraph. -In Markdown 1.0.0 and earlier. Version 8. This line turns into a -list item. Because a hard-wrapped line in the middle of a paragraph -looked like a list item. +In Markdown 1.0.0 and earlier. Version 8. This line turns into a list item. +Because a hard-wrapped line in the middle of a paragraph looked like a list +item. Here's one with a bullet. * criminey. @@ -161,13 +161,10 @@ Asterisks loose: \begin{itemize} \item asterisk 1 - \item asterisk 2 - \item asterisk 3 - \end{itemize} Pluses tight: @@ -184,13 +181,10 @@ Pluses loose: \begin{itemize} \item Plus 1 - \item Plus 2 - \item Plus 3 - \end{itemize} Minuses tight: @@ -207,13 +201,10 @@ Minuses loose: \begin{itemize} \item Minus 1 - \item Minus 2 - \item Minus 3 - \end{itemize} \subsection{Ordered} @@ -242,26 +233,20 @@ Loose using tabs: \begin{enumerate}[1.] \item First - \item Second - \item Third - \end{enumerate} and using spaces: \begin{enumerate}[1.] \item One - \item Two - \item Three - \end{enumerate} Multiple paragraphs: @@ -269,15 +254,11 @@ Multiple paragraphs: \item Item 1, graf one. - Item 1. graf two. The quick brown fox jumped over the lazy dog's - back. - + Item 1. graf two. The quick brown fox jumped over the lazy dog's back. \item Item 2. - \item Item 3. - \end{enumerate} \subsection{Nested} @@ -316,7 +297,6 @@ Same thing but with paragraphs: \begin{enumerate}[1.] \item First - \item Second: @@ -330,24 +310,20 @@ Same thing but with paragraphs: \end{itemize} \item Third - \end{enumerate} \subsection{Tabs and spaces} \begin{itemize} \item this is a list item indented with tabs - \item this is a list item indented with spaces \begin{itemize} \item this is an example list item indented with tabs - \item this is an example list item indented with spaces - \end{itemize} \end{itemize} \subsection{Fancy list markers} @@ -487,13 +463,11 @@ Multiple definitions, loose: \item[apple] red fruit - computer \item[orange] orange fruit - bank \end{description} @@ -503,7 +477,6 @@ Blank line after term, indented marker, alternate markers: \item[apple] red fruit - computer \item[orange] @@ -583,20 +556,17 @@ So is \textbf{\emph{this}} word. So is \textbf{\emph{this}} word. -This is code: \verb!>!, \verb!$!, \verb!\!, \verb!\$!, -\verb!!. +This is code: \verb!>!, \verb!$!, \verb!\!, \verb!\$!, \verb!!. \sout{This is \emph{strikeout}.} -Superscripts: a\textsuperscript{bc}d -a\textsuperscript{\emph{hello}} a\textsuperscript{hello~there}. +Superscripts: a\textsuperscript{bc}d a\textsuperscript{\emph{hello}} +a\textsuperscript{hello~there}. -Subscripts: H\textsubscr{2}O, H\textsubscr{23}O, -H\textsubscr{many~of~them}O. +Subscripts: H\textsubscr{2}O, H\textsubscr{23}O, H\textsubscr{many~of~them}O. -These should not be superscripts or subscripts, because of the -unescaped spaces: a\^{}b c\^{}d, a\ensuremath{\sim}b -c\ensuremath{\sim}d. +These should not be superscripts or subscripts, because of the unescaped +spaces: a\^{}b c\^{}d, a\ensuremath{\sim}b c\ensuremath{\sim}d. \begin{center}\rule{3in}{0.4pt}\end{center} @@ -640,8 +610,7 @@ Ellipses\ldots{}and\ldots{}and\ldots{}. Here's some display math: \[\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}\] \item - Here's one that has a line break in it: - $\alpha + \omega \times x^2$. + Here's one that has a line break in it: $\alpha + \omega \times x^2$. \end{itemize} These shouldn't be math: @@ -649,8 +618,8 @@ These shouldn't be math: \item To get the famous equation, write \verb!$e = mc^2$!. \item - \$22,000 is a \emph{lot} of money. So is \$34,000. (It worked if - ``lot'' is emphasized.) + \$22,000 is a \emph{lot} of money. So is \$34,000. (It worked if ``lot'' is + emphasized.) \item Shoes (\$20) and socks (\$5). \item @@ -777,16 +746,15 @@ Foo \href{/url/}{biz}. \subsection{With ampersands} -Here's a -\href{http://example.com/?foo=1&bar=2}{link with an ampersand in the URL}. +Here's a \href{http://example.com/?foo=1&bar=2}{link with an ampersand in the +URL}. Here's a link with an amersand in the link text: \href{http://att.com/}{AT\&T}. Here's an \href{/script?foo=1&bar=2}{inline link}. -Here's an -\href{/script?foo=1&bar=2}{inline link in pointy braces}. +Here's an \href{/script?foo=1&bar=2}{inline link in pointy braces}. \subsection{Autolinks} @@ -830,37 +798,32 @@ Here is a movie \includegraphics{movie.jpg} icon. \section{Footnotes} -Here is a footnote reference,% -\footnote{Here is the footnote. It can go anywhere after the footnote -reference. It need not be placed at the end of the document.} -and another.% -\footnote{Here's the long note. This one contains multiple blocks. +Here is a footnote reference,\footnote{Here is the footnote. It can go + anywhere after the footnote reference. It need not be placed at the end of + the document.} and another.\footnote{Here's the long note. This one contains + multiple blocks. -Subsequent blocks are indented to show that they belong to the -footnote (as with list items). + Subsequent blocks are indented to show that they belong to the footnote (as + with list items). -\begin{Verbatim} + \begin{Verbatim} { } -\end{Verbatim} -If you want, you can indent every line, but you can also be lazy -and just indent the first line of each block.} -This should \emph{not} be a footnote reference, because it contains -a space.{[}\^{}my note{]} Here is an inline note.% -\footnote{This is \emph{easier} to type. Inline notes may contain -\href{http://google.com}{links} and \verb!]! verbatim characters, -as well as {[}bracketed text{]}.} + \end{Verbatim} + If you want, you can indent every line, but you can also be lazy and just + indent the first line of each block.} This should \emph{not} be a footnote +reference, because it contains a space.{[}\^{}my note{]} Here is an inline +note.\footnote{This is \emph{easier} to type. Inline notes may contain + \href{http://google.com}{links} and \verb!]! verbatim characters, as well as + {[}bracketed text{]}.} \begin{quote} -Notes can go in quotes.% -\footnote{In quote.} +Notes can go in quotes.\footnote{In quote.} \end{quote} \begin{enumerate}[1.] \item - And in list items.% - \footnote{In list.} + And in list items.\footnote{In list.} \end{enumerate} -This paragraph should not be part of the note, as it is not -indented. +This paragraph should not be part of the note, as it is not indented. \end{document}