diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/LaTeX.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 920 |
1 files changed, 552 insertions, 368 deletions
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 88934eb44..f61c878e5 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, - PatternGuards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE ScopedTypeVariables #-} {- -Copyright (C) 2006-2015 John MacFarlane <jgm@berkeley.edu> +Copyright (C) 2006-2018 John MacFarlane <jgm@berkeley.edu> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -20,7 +21,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.LaTeX - Copyright : Copyright (C) 2006-2015 John MacFarlane + Copyright : Copyright (C) 2006-2018 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley.edu> @@ -29,37 +30,44 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' format into LaTeX. -} -module Text.Pandoc.Writers.LaTeX ( writeLaTeX ) where +module Text.Pandoc.Writers.LaTeX ( + writeLaTeX + , writeBeamer + ) where +import Control.Applicative ((<|>)) +import Control.Monad.State.Strict +import Data.Aeson (FromJSON, object, (.=)) +import Data.Char (isAlphaNum, isAscii, isDigit, isLetter, isPunctuation, ord, + toLower) +import Data.List (foldl', intercalate, intersperse, isInfixOf, nubBy, + stripPrefix, (\\)) +import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe, isNothing) +import Data.Text (Text) +import qualified Data.Text as T +import Network.URI (unEscapeString) +import Text.Pandoc.BCP47 (Lang (..), getLang, renderLang) +import Text.Pandoc.Class (PandocMonad, report, toLang) import Text.Pandoc.Definition -import Text.Pandoc.Walk -import Text.Pandoc.Shared -import Text.Pandoc.Writers.Shared +import Text.Pandoc.Highlighting (formatLaTeXBlock, formatLaTeXInline, highlight, + styleToLaTeX, toListingsLanguage) +import Text.Pandoc.ImageSize +import Text.Pandoc.Logging import Text.Pandoc.Options -import Text.Pandoc.Templates -import Text.Printf ( printf ) -import Network.URI ( isURI, unEscapeString ) -import Data.Aeson (object, (.=), FromJSON) -import Data.List ( (\\), isInfixOf, stripPrefix, intercalate, intersperse, - nub, nubBy, foldl' ) -import Data.Char ( toLower, isPunctuation, isAscii, isLetter, isDigit, - ord, isAlphaNum ) -import Data.Maybe ( fromMaybe, isJust, catMaybes ) -import qualified Data.Text as T -import Control.Applicative ((<|>)) -import Control.Monad.State -import qualified Text.Parsec as P import Text.Pandoc.Pretty -import Text.Pandoc.ImageSize +import Text.Pandoc.Shared import Text.Pandoc.Slides -import Text.Pandoc.Highlighting (highlight, styleToLaTeX, - formatLaTeXInline, formatLaTeXBlock, - toListingsLanguage) +import Text.Pandoc.Templates +import Text.Pandoc.Walk +import Text.Pandoc.Writers.Shared +import qualified Text.Parsec as P +import Text.Printf (printf) data WriterState = WriterState { stInNote :: Bool -- true if we're in a note , stInQuote :: Bool -- true if in a blockquote , stInMinipage :: Bool -- true if in minipage , stInHeading :: Bool -- true if in a section heading + , stInItem :: Bool -- true if in \item[..] , stNotes :: [Doc] -- notes in a minipage , stOLLevel :: Int -- level of ordered list nesting , stOptions :: WriterOptions -- writer options, so they don't have to be parameter @@ -74,49 +82,75 @@ data WriterState = , stHighlighting :: Bool -- true if document has highlighted code , stIncremental :: Bool -- true if beamer lists should be displayed bit by bit , stInternalLinks :: [String] -- list of internal link targets - , stUsesEuro :: Bool -- true if euro symbol used + , stBeamer :: Bool -- produce beamer + , stEmptyLine :: Bool -- true if no content on line } +startingState :: WriterOptions -> WriterState +startingState options = WriterState { + stInNote = False + , stInQuote = False + , stInMinipage = False + , stInHeading = False + , stInItem = False + , stNotes = [] + , stOLLevel = 1 + , stOptions = options + , stVerbInNote = False + , stTable = False + , stStrikeout = False + , stUrl = False + , stGraphics = False + , stLHS = False + , stBook = case writerTopLevelDivision options of + TopLevelPart -> True + TopLevelChapter -> True + _ -> False + , stCsquotes = False + , stHighlighting = False + , stIncremental = writerIncremental options + , stInternalLinks = [] + , stBeamer = False + , stEmptyLine = True } + -- | Convert Pandoc to LaTeX. -writeLaTeX :: WriterOptions -> Pandoc -> String +writeLaTeX :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeLaTeX options document = - evalState (pandocToLaTeX options document) $ - WriterState { stInNote = False, stInQuote = False, - stInMinipage = False, stInHeading = False, - stNotes = [], stOLLevel = 1, - stOptions = options, stVerbInNote = False, - stTable = False, stStrikeout = False, - stUrl = False, stGraphics = False, - stLHS = False, - stBook = (case writerTopLevelDivision options of - TopLevelPart -> True - TopLevelChapter -> True - _ -> False), - stCsquotes = False, stHighlighting = False, - stIncremental = writerIncremental options, - stInternalLinks = [], stUsesEuro = False } - -pandocToLaTeX :: WriterOptions -> Pandoc -> State WriterState String + evalStateT (pandocToLaTeX options document) $ + startingState options + +-- | Convert Pandoc to LaTeX Beamer. +writeBeamer :: PandocMonad m => WriterOptions -> Pandoc -> m Text +writeBeamer options document = + evalStateT (pandocToLaTeX options document) $ + (startingState options){ stBeamer = True } + +type LW m = StateT WriterState m + +pandocToLaTeX :: PandocMonad m + => WriterOptions -> Pandoc -> LW m Text pandocToLaTeX options (Pandoc meta blocks) = do -- Strip off final 'references' header if --natbib or --biblatex let method = writerCiteMethod options let blocks' = if method == Biblatex || method == Natbib then case reverse blocks of - (Div (_,["references"],_) _):xs -> reverse xs - _ -> blocks + Div (_,["references"],_) _:xs -> reverse xs + _ -> blocks else blocks -- see if there are internal links - let isInternalLink (Link _ _ ('#':xs,_)) = [xs] - isInternalLink _ = [] + let isInternalLink (Link _ _ ('#':xs,_)) = [xs] + isInternalLink _ = [] modify $ \s -> s{ stInternalLinks = query isInternalLink blocks' } - let template = maybe "" id $ writerTemplate options + let template = fromMaybe "" $ writerTemplate options -- set stBook depending on documentclass let colwidth = if writerWrapText options == WrapAuto then Just $ writerColumns options else Nothing + let render' :: Doc -> Text + render' = render colwidth metadata <- metaToJSON options - (fmap (render colwidth) . blockListToLaTeX) - (fmap (render colwidth) . inlineListToLaTeX) + (fmap render' . blockListToLaTeX) + (fmap render' . inlineListToLaTeX) meta let bookClasses = ["memoir","book","report","scrreprt","scrbook"] let documentClass = case P.parse pDocumentClass "template" template of @@ -143,25 +177,38 @@ pandocToLaTeX options (Pandoc meta blocks) = do else case last blocks' of Header 1 _ il -> (init blocks', il) _ -> (blocks', []) - blocks''' <- if writerBeamer options + beamer <- gets stBeamer + blocks''' <- if beamer then toSlides blocks'' else return blocks'' body <- mapM (elementToLaTeX options) $ hierarchicalize blocks''' - (biblioTitle :: String) <- liftM (render colwidth) $ inlineListToLaTeX lastHeader - let main = render colwidth $ vsep body + (biblioTitle :: Text) <- render' <$> inlineListToLaTeX lastHeader + let main = render' $ vsep body st <- get titleMeta <- stringToLaTeX TextString $ stringify $ docTitle meta authorsMeta <- mapM (stringToLaTeX TextString . stringify) $ docAuthors meta - let docLangs = nub $ query (extract "lang") blocks + docLangs <- catMaybes <$> + mapM (toLang . Just) (ordNub (query (extract "lang") blocks)) let hasStringValue x = isJust (getField x metadata :: Maybe String) - let geometryFromMargins = intercalate [','] $ catMaybes $ - map (\(x,y) -> + let geometryFromMargins = intercalate [','] $ mapMaybe (\(x,y) -> ((x ++ "=") ++) <$> getField y metadata) [("lmargin","margin-left") ,("rmargin","margin-right") ,("tmargin","margin-top") ,("bmargin","margin-bottom") ] + let toPolyObj lang = object [ "name" .= T.pack name + , "options" .= T.pack opts ] + where + (name, opts) = toPolyglossia lang + mblang <- toLang $ case getLang options meta of + Just l -> Just l + Nothing | null docLangs -> Nothing + | otherwise -> Just "en" + -- we need a default here since lang is used in template conditionals + + let dirs = query (extract "dir") blocks + let context = defField "toc" (writerTableOfContents options) $ defField "toc-depth" (show (writerTOCDepth options - if stBook st @@ -170,7 +217,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do defField "body" main $ defField "title-meta" titleMeta $ defField "author-meta" (intercalate "; " authorsMeta) $ - defField "documentclass" (if writerBeamer options + defField "documentclass" (if beamer then ("beamer" :: String) else if stBook st then "book" @@ -183,12 +230,14 @@ pandocToLaTeX options (Pandoc meta blocks) = do defField "lhs" (stLHS st) $ defField "graphics" (stGraphics st) $ defField "book-class" (stBook st) $ - defField "euro" (stUsesEuro st) $ defField "listings" (writerListings options || stLHS st) $ - defField "beamer" (writerBeamer options) $ + defField "beamer" beamer $ (if stHighlighting st - then defField "highlighting-macros" (styleToLaTeX - $ writerHighlightStyle options ) + then case writerHighlightStyle options of + Just sty -> + defField "highlighting-macros" + (styleToLaTeX sty) + Nothing -> id else id) $ (case writerCiteMethod options of Natbib -> defField "biblio-title" biblioTitle . @@ -196,26 +245,26 @@ pandocToLaTeX options (Pandoc meta blocks) = do Biblatex -> defField "biblio-title" biblioTitle . defField "biblatex" True _ -> id) $ - -- set lang to something so polyglossia/babel is included - defField "lang" (if null docLangs then ""::String else "en") $ - defField "otherlangs" docLangs $ defField "colorlinks" (any hasStringValue ["citecolor", "urlcolor", "linkcolor", "toccolor"]) $ - defField "dir" (if (null $ query (extract "dir") blocks) - then ""::String - else "ltr") $ + (if null dirs + then id + else defField "dir" ("ltr" :: String)) $ defField "section-titles" True $ defField "geometry" geometryFromMargins $ + (case getField "papersize" metadata of + -- uppercase a4, a5, etc. + Just (('A':d:ds) :: String) + | all isDigit (d:ds) -> resetField "papersize" + (('a':d:ds) :: String) + _ -> id) metadata - let toPolyObj lang = object [ "name" .= T.pack name - , "options" .= T.pack opts ] - where - (name, opts) = toPolyglossia lang - let lang = maybe [] (splitBy (=='-')) $ getField "lang" context - otherlangs = maybe [] (map $ splitBy (=='-')) $ getField "otherlangs" context let context' = - defField "babel-lang" (toBabel lang) - $ defField "babel-otherlangs" (map toBabel otherlangs) + -- note: lang is used in some conditionals in the template, + -- so we need to set it if we have any babel/polyglossia: + maybe id (defField "lang" . renderLang) mblang + $ maybe id (defField "babel-lang" . toBabel) mblang + $ defField "babel-otherlangs" (map toBabel docLangs) $ defField "babel-newcommands" (concatMap (\(poly, babel) -> -- \textspanish and \textgalician are already used by babel -- save them as \oritext... and let babel use that @@ -227,31 +276,30 @@ pandocToLaTeX options (Pandoc meta blocks) = do "\\AddBabelHook{" ++ poly ++ "}{afterextras}" ++ "{\\renewcommand{\\text" ++ poly ++ "}[2][]{\\foreignlanguage{" ++ poly ++ "}{##2}}}\n" - else "\\newcommand{\\text" ++ poly ++ "}[2][]{\\foreignlanguage{" - ++ babel ++ "}{#2}}\n" ++ - "\\newenvironment{" ++ poly ++ "}[2][]{\\begin{otherlanguage}{" - ++ babel ++ "}}{\\end{otherlanguage}}\n" + else (if poly == "latin" -- see #4161 + then "\\providecommand{\\textlatin}{}\n\\renewcommand" + else "\\newcommand") ++ "{\\text" ++ poly ++ + "}[2][]{\\foreignlanguage{" ++ babel ++ "}{#2}}\n" ++ + "\\newenvironment{" ++ poly ++ + "}[2][]{\\begin{otherlanguage}{" ++ + babel ++ "}}{\\end{otherlanguage}}\n" ) -- eliminate duplicates that have same polyglossia name $ nubBy (\a b -> fst a == fst b) -- find polyglossia and babel names of languages used in the document - $ map (\l -> - let lng = splitBy (=='-') l - in (fst $ toPolyglossia lng, toBabel lng) - ) - docLangs ) - $ defField "polyglossia-lang" (toPolyObj lang) - $ defField "polyglossia-otherlangs" (map toPolyObj otherlangs) - $ defField "latex-dir-rtl" (case (getField "dir" context)::Maybe String of - Just "rtl" -> True - _ -> False) - $ context - return $ case writerTemplate options of - Nothing -> main - Just tpl -> renderTemplate' tpl context' + $ map (\l -> (fst $ toPolyglossia l, toBabel l)) docLangs + ) + $ maybe id (defField "polyglossia-lang" . toPolyObj) mblang + $ defField "polyglossia-otherlangs" (map toPolyObj docLangs) + $ + defField "latex-dir-rtl" + (getField "dir" context == Just ("rtl" :: String)) context + case writerTemplate options of + Nothing -> return main + Just tpl -> renderTemplate' tpl context' -- | Convert Elements to LaTeX -elementToLaTeX :: WriterOptions -> Element -> State WriterState Doc +elementToLaTeX :: PandocMonad m => WriterOptions -> Element -> LW m Doc elementToLaTeX _ (Blk block) = blockToLaTeX block elementToLaTeX opts (Sec level _ (id',classes,_) title' elements) = do modify $ \s -> s{stInHeading = True} @@ -266,18 +314,15 @@ data StringContext = TextString deriving (Eq) -- escape things as needed for LaTeX -stringToLaTeX :: StringContext -> String -> State WriterState String +stringToLaTeX :: PandocMonad m => StringContext -> String -> LW m String stringToLaTeX _ [] = return "" stringToLaTeX ctx (x:xs) = do opts <- gets stOptions rest <- stringToLaTeX ctx xs - let ligatures = writerTeXLigatures opts && ctx == TextString + let ligatures = isEnabled Ext_smart opts && ctx == TextString let isUrl = ctx == URLString - when (x == '€') $ - modify $ \st -> st{ stUsesEuro = True } return $ case x of - '€' -> "\\euro{}" ++ rest '{' -> "\\{" ++ rest '}' -> "\\}" ++ rest '`' | ctx == CodeString -> "\\textasciigrave{}" ++ rest @@ -311,26 +356,30 @@ stringToLaTeX ctx (x:xs) = do '\x2013' | ligatures -> "--" ++ rest _ -> x : rest -toLabel :: String -> State WriterState String +toLabel :: PandocMonad m => String -> LW m String toLabel z = go `fmap` stringToLaTeX URLString z where go [] = "" go (x:xs) | (isLetter x || isDigit x) && isAscii x = x:go xs - | elem x ("_-+=:;." :: String) = x:go xs + | x `elem` ("_-+=:;." :: String) = x:go xs | otherwise = "ux" ++ printf "%x" (ord x) ++ go xs -- | Puts contents into LaTeX command. inCmd :: String -> Doc -> Doc inCmd cmd contents = char '\\' <> text cmd <> braces contents -toSlides :: [Block] -> State WriterState [Block] +toSlides :: PandocMonad m => [Block] -> LW m [Block] toSlides bs = do opts <- gets stOptions let slideLevel = fromMaybe (getSlideLevel bs) $ writerSlideLevel opts let bs' = prepSlides slideLevel bs - concat `fmap` (mapM (elementToBeamer slideLevel) $ hierarchicalize bs') + concat `fmap` mapM (elementToBeamer slideLevel) (hierarchicalize bs') -elementToBeamer :: Int -> Element -> State WriterState [Block] +elementToBeamer :: PandocMonad m => Int -> Element -> LW m [Block] +elementToBeamer _slideLevel (Blk (Div attr bs)) = do + -- make sure we support "blocks" inside divs + bs' <- concat `fmap` mapM (elementToBeamer 0) (hierarchicalize bs) + return [Div attr bs'] elementToBeamer _slideLevel (Blk b) = return [b] elementToBeamer slideLevel (Sec lvl _num (ident,classes,kvs) tit elts) | lvl > slideLevel = do @@ -340,7 +389,7 @@ elementToBeamer slideLevel (Sec lvl _num (ident,classes,kvs) tit elts) : bs ++ [RawBlock "latex" "\\end{block}"] | lvl < slideLevel = do bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts - return $ (Header lvl (ident,classes,kvs) tit) : bs + return $ Header lvl (ident,classes,kvs) tit : bs | otherwise = do -- lvl == slideLevel -- note: [fragile] is required or verbatim breaks let hasCodeBlock (CodeBlock _ _) = [True] @@ -349,19 +398,28 @@ elementToBeamer slideLevel (Sec lvl _num (ident,classes,kvs) tit elts) hasCode _ = [] let fragile = "fragile" `elem` classes || not (null $ query hasCodeBlock elts ++ query hasCode elts) - let frameoptions = ["allowdisplaybreaks", "allowframebreaks", + let frameoptions = ["allowdisplaybreaks", "allowframebreaks", "fragile", "b", "c", "t", "environment", "label", "plain", "shrink", "standout"] - let optionslist = ["fragile" | fragile] ++ + let optionslist = ["fragile" | fragile && isNothing (lookup "fragile" kvs)] ++ [k | k <- classes, k `elem` frameoptions] ++ [k ++ "=" ++ v | (k,v) <- kvs, k `elem` frameoptions] let options = if null optionslist then "" else "[" ++ intercalate "," optionslist ++ "]" - let slideStart = Para $ RawInline "latex" ("\\begin{frame}" ++ options) : - if tit == [Str "\0"] -- marker for hrule - then [] - else (RawInline "latex" "{") : tit ++ [RawInline "latex" "}"] + let latex = RawInline (Format "latex") + slideTitle <- + if tit == [Str "\0"] -- marker for hrule + then return [] + else + if null ident + then return $ latex "{" : tit ++ [latex "}"] + else do + ref <- toLabel ident + return $ latex ("{%\n\\protect\\hypertarget{" ++ + ref ++ "}{%\n") : tit ++ [latex "}}"] + let slideStart = Para $ + RawInline "latex" ("\\begin{frame}" ++ options) : slideTitle let slideEnd = RawBlock "latex" "\\end{frame}" -- now carve up slide into blocks if there are sections inside bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts @@ -376,43 +434,89 @@ isListBlock _ = False isLineBreakOrSpace :: Inline -> Bool isLineBreakOrSpace LineBreak = True isLineBreakOrSpace SoftBreak = True -isLineBreakOrSpace Space = True -isLineBreakOrSpace _ = False +isLineBreakOrSpace Space = True +isLineBreakOrSpace _ = False -- | Convert Pandoc block element to LaTeX. -blockToLaTeX :: Block -- ^ Block to convert - -> State WriterState Doc +blockToLaTeX :: PandocMonad m + => Block -- ^ Block to convert + -> LW m Doc blockToLaTeX Null = return empty -blockToLaTeX (Div (identifier,classes,kvs) bs) = do - beamer <- writerBeamer `fmap` gets stOptions - ref <- toLabel identifier - let linkAnchor = if null identifier - then empty - else "\\hypertarget" <> braces (text ref) <> - braces empty - let align dir txt = inCmd "begin" dir $$ txt $$ inCmd "end" dir - let wrapDir = case lookup "dir" kvs of - Just "rtl" -> align "RTL" - Just "ltr" -> align "LTR" - _ -> id - wrapLang txt = case lookup "lang" kvs of - Just lng -> let (l, o) = toPolyglossiaEnv lng - ops = if null o - then "" - else brackets $ text o - in inCmd "begin" (text l) <> ops - $$ blankline <> txt <> blankline - $$ inCmd "end" (text l) - Nothing -> txt - wrapNotes txt = if beamer && "notes" `elem` classes +blockToLaTeX (Div (identifier,classes,kvs) bs) + | "incremental" `elem` classes = do + let classes' = filter ("incremental"/=) classes + beamer <- gets stBeamer + if beamer + then do oldIncremental <- gets stIncremental + modify $ \s -> s{ stIncremental = True } + result <- blockToLaTeX $ Div (identifier,classes',kvs) bs + modify $ \s -> s{ stIncremental = oldIncremental } + return result + else blockToLaTeX $ Div (identifier,classes',kvs) bs + | "nonincremental" `elem` classes = do + let classes' = filter ("nonincremental"/=) classes + beamer <- gets stBeamer + if beamer + then do oldIncremental <- gets stIncremental + modify $ \s -> s{ stIncremental = False } + result <- blockToLaTeX $ Div (identifier,classes',kvs) bs + modify $ \s -> s{ stIncremental = oldIncremental } + return result + else blockToLaTeX $ Div (identifier,classes',kvs) bs + | otherwise = do + beamer <- gets stBeamer + linkAnchor' <- hypertarget True identifier empty + -- see #2704 for the motivation for adding \leavevmode: + let linkAnchor = + case bs of + Para _ : _ + | not (isEmpty linkAnchor') + -> "\\leavevmode" <> linkAnchor' <> "%" + _ -> linkAnchor' + let align dir txt = inCmd "begin" dir $$ txt $$ inCmd "end" dir + lang <- toLang $ lookup "lang" kvs + let wrapColumns = if "columns" `elem` classes + then \contents -> + inCmd "begin" "columns" <> brackets "T" + $$ contents + $$ inCmd "end" "columns" + else id + wrapColumn = if "column" `elem` classes + then \contents -> + let fromPct xs = + case reverse xs of + '%':ds -> '0':'.': reverse ds + _ -> xs + w = maybe "0.48" fromPct (lookup "width" kvs) + in inCmd "begin" "column" <> + braces (text w <> "\\textwidth") + $$ contents + $$ inCmd "end" "column" + else id + wrapDir = case lookup "dir" kvs of + Just "rtl" -> align "RTL" + Just "ltr" -> align "LTR" + _ -> id + wrapLang txt = case lang of + Just lng -> let (l, o) = toPolyglossiaEnv lng + ops = if null o + then "" + else brackets $ text o + in inCmd "begin" (text l) <> ops + $$ blankline <> txt <> blankline + $$ inCmd "end" (text l) + Nothing -> txt + wrapNotes txt = if beamer && "notes" `elem` classes then "\\note" <> braces txt -- speaker notes else linkAnchor $$ txt - fmap (wrapDir . wrapLang . wrapNotes) $ blockListToLaTeX bs + (wrapColumns . wrapColumn . wrapDir . wrapLang . wrapNotes) + <$> blockListToLaTeX bs blockToLaTeX (Plain lst) = inlineListToLaTeX $ dropWhile isLineBreakOrSpace lst -- title beginning with fig: indicates that the image is a figure blockToLaTeX (Para [Image attr@(ident, _, _) txt (src,'f':'i':'g':':':tit)]) = do inNote <- gets stInNote + inMinipage <- gets stInMinipage modify $ \st -> st{ stInMinipage = True, stNotes = [] } capt <- inlineListToLaTeX txt notes <- gets stNotes @@ -426,25 +530,26 @@ blockToLaTeX (Para [Image attr@(ident, _, _) txt (src,'f':'i':'g':':':tit)]) = d let footnotes = notesToLaTeX notes lab <- labelFor ident let caption = "\\caption" <> captForLof <> braces capt <> lab - figure <- hypertarget ident (cr <> - "\\begin{figure}" $$ "\\centering" $$ img $$ - caption $$ "\\end{figure}" <> cr) - return $ if inNote - -- can't have figures in notes + innards <- hypertarget True ident $ + "\\centering" $$ img $$ caption <> cr + let figure = cr <> "\\begin{figure}" $$ innards $$ "\\end{figure}" + return $ if inNote || inMinipage + -- can't have figures in notes or minipage (here, table cell) + -- http://www.tex.ac.uk/FAQ-ouparmd.html then "\\begin{center}" $$ img $+$ capt $$ "\\end{center}" else figure $$ footnotes -- . . . indicates pause in beamer slides blockToLaTeX (Para [Str ".",Space,Str ".",Space,Str "."]) = do - beamer <- writerBeamer `fmap` gets stOptions + beamer <- gets stBeamer if beamer then blockToLaTeX (RawBlock "latex" "\\pause") else inlineListToLaTeX [Str ".",Space,Str ".",Space,Str "."] blockToLaTeX (Para lst) = inlineListToLaTeX $ dropWhile isLineBreakOrSpace lst -blockToLaTeX (LineBlock lns) = do +blockToLaTeX (LineBlock lns) = blockToLaTeX $ linesToPara lns blockToLaTeX (BlockQuote lst) = do - beamer <- writerBeamer `fmap` gets stOptions + beamer <- gets stBeamer case lst of [b] | beamer && isListBlock b -> do oldIncremental <- gets stIncremental @@ -460,11 +565,11 @@ blockToLaTeX (BlockQuote lst) = do return $ "\\begin{quote}" $$ contents $$ "\\end{quote}" blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do opts <- gets stOptions - ref <- toLabel identifier - let linkAnchor = if null identifier + lab <- labelFor identifier + linkAnchor' <- hypertarget True identifier lab + let linkAnchor = if isEmpty linkAnchor' then empty - else "\\hypertarget" <> braces (text ref) <> - braces ("\\label" <> braces (text ref)) + else linkAnchor' <> "%" let lhsCodeBlock = do modify $ \s -> s{ stLHS = True } return $ flush (linkAnchor $$ "\\begin{code}" $$ text str $$ @@ -479,6 +584,7 @@ blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do text str $$ text ("\\end{" ++ env ++ "}")) <> cr let listingsCodeBlock = do st <- get + ref <- toLabel identifier let params = if writerListings (stOptions st) then (case getListingsLanguage classes of Just l -> [ "language=" ++ mbBraced l ] @@ -495,9 +601,6 @@ blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do else [ "label=" ++ ref ]) else [] - mbBraced x = if not (all isAlphaNum x) - then "{" <> x <> "}" - else x printParams | null params = empty | otherwise = brackets $ hcat (intersperse ", " @@ -505,24 +608,34 @@ blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do return $ flush ("\\begin{lstlisting}" <> printParams $$ text str $$ "\\end{lstlisting}") $$ cr let highlightedCodeBlock = - case highlight formatLaTeXBlock ("",classes,keyvalAttr) str of - Nothing -> rawCodeBlock - Just h -> modify (\st -> st{ stHighlighting = True }) >> - return (flush $ linkAnchor $$ text (T.unpack h)) + case highlight (writerSyntaxMap opts) + formatLaTeXBlock ("",classes,keyvalAttr) str of + Left msg -> do + unless (null msg) $ + report $ CouldNotHighlight msg + rawCodeBlock + Right h -> do + st <- get + when (stInNote st) $ modify (\s -> s{ stVerbInNote = True }) + modify (\s -> s{ stHighlighting = True }) + return (flush $ linkAnchor $$ text (T.unpack h)) case () of _ | isEnabled Ext_literate_haskell opts && "haskell" `elem` classes && - "literate" `elem` classes -> lhsCodeBlock - | writerListings opts -> listingsCodeBlock - | writerHighlight opts && not (null classes) -> highlightedCodeBlock - | otherwise -> rawCodeBlock -blockToLaTeX (RawBlock f x) + "literate" `elem` classes -> lhsCodeBlock + | writerListings opts -> listingsCodeBlock + | not (null classes) && isJust (writerHighlightStyle opts) + -> highlightedCodeBlock + | otherwise -> rawCodeBlock +blockToLaTeX b@(RawBlock f x) | f == Format "latex" || f == Format "tex" = return $ text x - | otherwise = return empty + | otherwise = do + report $ BlockNotRendered b + return empty blockToLaTeX (BulletList []) = return empty -- otherwise latex error blockToLaTeX (BulletList lst) = do incremental <- gets stIncremental - beamer <- writerBeamer `fmap` gets stOptions + beamer <- gets stBeamer let inc = if beamer && incremental then "[<+->]" else "" items <- mapM listItemToLaTeX lst let spacing = if isTightList lst @@ -538,6 +651,7 @@ blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do put $ st {stOLLevel = oldlevel + 1} items <- mapM listItemToLaTeX lst modify (\s -> s {stOLLevel = oldlevel}) + let beamer = stBeamer st let tostyle x = case numstyle of Decimal -> "\\arabic" <> braces x UpperRoman -> "\\Roman" <> braces x @@ -547,15 +661,24 @@ blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do Example -> "\\arabic" <> braces x DefaultStyle -> "\\arabic" <> braces x let todelim x = case numdelim of - OneParen -> x <> ")" - TwoParens -> parens x - Period -> x <> "." - _ -> x <> "." + OneParen -> x <> ")" + TwoParens -> parens x + Period -> x <> "." + _ -> x <> "." + let exemplar = case numstyle of + Decimal -> "1" + UpperRoman -> "I" + LowerRoman -> "i" + UpperAlpha -> "A" + LowerAlpha -> "a" + Example -> "1" + DefaultStyle -> "1" let enum = text $ "enum" ++ map toLower (toRomanNumeral oldlevel) - let stylecommand = if numstyle == DefaultStyle && numdelim == DefaultDelim - then empty - else "\\def" <> "\\label" <> enum <> - braces (todelim $ tostyle enum) + let stylecommand + | numstyle == DefaultStyle && numdelim == DefaultDelim = empty + | beamer = brackets (todelim exemplar) + | otherwise = "\\def" <> "\\label" <> enum <> + braces (todelim $ tostyle enum) let resetcounter = if start == 1 || oldlevel > 4 then empty else "\\setcounter" <> braces enum <> @@ -579,7 +702,8 @@ blockToLaTeX (DefinitionList lst) = do else empty return $ text ("\\begin{description}" ++ inc) $$ spacing $$ vcat items $$ "\\end{description}" -blockToLaTeX HorizontalRule = return $ +blockToLaTeX HorizontalRule = + return "\\begin{center}\\rule{0.5\\linewidth}{\\linethickness}\\end{center}" blockToLaTeX (Header level (id',classes,_) lst) = do modify $ \s -> s{stInHeading = True} @@ -587,33 +711,34 @@ blockToLaTeX (Header level (id',classes,_) lst) = do modify $ \s -> s{stInHeading = False} return hdr blockToLaTeX (Table caption aligns widths heads rows) = do - headers <- if all null heads - then return empty - else do - contents <- (tableRowToLaTeX True aligns widths) heads - return ("\\toprule" $$ contents $$ "\\midrule") - let endhead = if all null heads - then empty - else text "\\endhead" - let endfirsthead = if all null heads - then empty - else text "\\endfirsthead" + let toHeaders hs = do contents <- tableRowToLaTeX True aligns widths hs + return ("\\toprule" $$ contents $$ "\\midrule") + let removeNote (Note _) = Span ("", [], []) [] + removeNote x = x captionText <- inlineListToLaTeX caption + firsthead <- if isEmpty captionText || all null heads + then return empty + else ($$ text "\\endfirsthead") <$> toHeaders heads + head' <- if all null heads + then return "\\toprule" + -- avoid duplicate notes in head and firsthead: + else toHeaders (if isEmpty firsthead + then heads + else walk removeNote heads) let capt = if isEmpty captionText then empty - else text "\\caption" <> braces captionText <> "\\tabularnewline" - $$ headers - $$ endfirsthead + else text "\\caption" <> + braces captionText <> "\\tabularnewline" rows' <- mapM (tableRowToLaTeX False aligns widths) rows - let colDescriptors = text $ concat $ map toColDescriptor aligns + let colDescriptors = text $ concatMap toColDescriptor aligns modify $ \s -> s{ stTable = True } return $ "\\begin{longtable}[]" <> braces ("@{}" <> colDescriptors <> "@{}") -- the @{} removes extra space at beginning and end $$ capt - $$ (if all null heads then "\\toprule" else empty) - $$ headers - $$ endhead + $$ firsthead + $$ head' + $$ "\\endhead" $$ vcat rows' $$ "\\bottomrule" $$ "\\end{longtable}" @@ -626,14 +751,16 @@ toColDescriptor align = AlignCenter -> "c" AlignDefault -> "l" -blockListToLaTeX :: [Block] -> State WriterState Doc -blockListToLaTeX lst = vsep `fmap` mapM blockToLaTeX lst +blockListToLaTeX :: PandocMonad m => [Block] -> LW m Doc +blockListToLaTeX lst = + vsep `fmap` mapM (\b -> setEmptyLine True >> blockToLaTeX b) lst -tableRowToLaTeX :: Bool +tableRowToLaTeX :: PandocMonad m + => Bool -> [Alignment] -> [Double] -> [[Block]] - -> State WriterState Doc + -> LW m Doc tableRowToLaTeX header aligns widths cols = do -- scale factor compensates for extra space between columns -- so the whole table isn't larger than columnwidth @@ -643,9 +770,9 @@ tableRowToLaTeX header aligns widths cols = do isSimple [] = True isSimple _ = False -- simple tables have to have simple cells: - let widths' = if not (all isSimple cols) + let widths' = if all (== 0) widths && not (all isSimple cols) then replicate (length aligns) - (0.97 / fromIntegral (length aligns)) + (scaleFactor / fromIntegral (length aligns)) else map (scaleFactor *) widths cells <- mapM (tableCellToLaTeX header) $ zip3 widths' aligns cols return $ hsep (intersperse "&" cells) <> "\\tabularnewline" @@ -672,10 +799,10 @@ fixLineBreaks' ils = case splitBy (== LineBreak) ils of -- math breaks in simple tables. displayMathToInline :: Inline -> Inline displayMathToInline (Math DisplayMath x) = Math InlineMath x -displayMathToInline x = x +displayMathToInline x = x -tableCellToLaTeX :: Bool -> (Double, Alignment, [Block]) - -> State WriterState Doc +tableCellToLaTeX :: PandocMonad m => Bool -> (Double, Alignment, [Block]) + -> LW m Doc tableCellToLaTeX _ (0, _, blocks) = blockListToLaTeX $ walk fixLineBreaks $ walk displayMathToInline blocks tableCellToLaTeX header (width, align, blocks) = do @@ -691,7 +818,7 @@ tableCellToLaTeX header (width, align, blocks) = do AlignDefault -> "\\raggedright" return $ ("\\begin{minipage}" <> valign <> braces (text (printf "%.2f\\columnwidth" width)) <> - (halign <> "\\strut" <> cr <> cellContents <> "\\strut" <> cr) <> + (halign <> cr <> cellContents <> "\\strut" <> cr) <> "\\end{minipage}") $$ notesToLaTeX notes @@ -708,19 +835,22 @@ notesToLaTeX ns = (case length ns of $ map (\x -> "\\footnotetext" <> braces x) $ reverse ns) -listItemToLaTeX :: [Block] -> State WriterState Doc +listItemToLaTeX :: PandocMonad m => [Block] -> LW m Doc listItemToLaTeX lst -- we need to put some text before a header if it's the first -- element in an item. This will look ugly in LaTeX regardless, but -- this will keep the typesetter from throwing an error. - | ((Header _ _ _) :_) <- lst = - blockListToLaTeX lst >>= return . (text "\\item ~" $$) . (nest 2) + | (Header{} :_) <- lst = + blockListToLaTeX lst >>= return . (text "\\item ~" $$) . nest 2 | otherwise = blockListToLaTeX lst >>= return . (text "\\item" $$) . - (nest 2) + nest 2 -defListItemToLaTeX :: ([Inline], [[Block]]) -> State WriterState Doc +defListItemToLaTeX :: PandocMonad m => ([Inline], [[Block]]) -> LW m Doc defListItemToLaTeX (term, defs) = do + -- needed to turn off 'listings' because it breaks inside \item[...]: + modify $ \s -> s{stInItem = True} term' <- inlineListToLaTeX term + modify $ \s -> s{stInItem = False} -- put braces around term if it contains an internal link, -- since otherwise we get bad bracket interactions: \item[\hyperref[..] let isInternalLink (Link _ _ ('#':_,_)) = True @@ -730,32 +860,33 @@ defListItemToLaTeX (term, defs) = do else term' def' <- liftM vsep $ mapM blockListToLaTeX defs return $ case defs of - (((Header _ _ _) : _) : _) -> + ((Header{} : _) : _) -> "\\item" <> brackets term'' <> " ~ " $$ def' _ -> "\\item" <> brackets term'' $$ def' -- | Craft the section header, inserting the secton reference, if supplied. -sectionHeader :: Bool -- True for unnumbered +sectionHeader :: PandocMonad m + => Bool -- True for unnumbered -> [Char] -> Int -> [Inline] - -> State WriterState Doc + -> LW m Doc sectionHeader unnumbered ident level lst = do txt <- inlineListToLaTeX lst plain <- stringToLaTeX TextString $ concatMap stringify lst - let removeInvalidInline (Note _) = [] + let removeInvalidInline (Note _) = [] removeInvalidInline (Span (id', _, _) _) | not (null id') = [] - removeInvalidInline (Image _ _ _) = [] - removeInvalidInline x = [x] + removeInvalidInline Image{} = [] + removeInvalidInline x = [x] let lstNoNotes = foldr (mappend . (\x -> walkM removeInvalidInline x)) mempty lst txtNoNotes <- inlineListToLaTeX lstNoNotes -- footnotes in sections don't work (except for starred variants) -- unless you specify an optional argument: -- \section[mysec]{mysec\footnote{blah}} - optional <- if unnumbered || lstNoNotes == lst || lstNoNotes == [] + optional <- if unnumbered || lstNoNotes == lst || null lstNoNotes then return empty - else do + else return $ brackets txtNoNotes let contents = if render Nothing txt == plain then braces txt @@ -767,7 +898,8 @@ sectionHeader unnumbered ident level lst = do let topLevelDivision = if book && writerTopLevelDivision opts == TopLevelDefault then TopLevelChapter else writerTopLevelDivision opts - let level' = if writerBeamer opts && + beamer <- gets stBeamer + let level' = if beamer && topLevelDivision `elem` [TopLevelPart, TopLevelChapter] -- beamer has parts but no chapters then if level == 1 then -1 else level - 1 @@ -794,7 +926,8 @@ sectionHeader unnumbered ident level lst = do lab <- labelFor ident let star = if unnumbered && level' < 4 then text "*" else empty let stuffing = star <> optional <> contents - stuffing' <- hypertarget ident $ text ('\\':sectionType) <> stuffing <> lab + stuffing' <- hypertarget True ident $ + text ('\\':sectionType) <> stuffing <> lab return $ if level' > 5 then txt else prefix $$ stuffing' @@ -804,28 +937,28 @@ sectionHeader unnumbered ident level lst = do braces txtNoNotes else empty -hypertarget :: String -> Doc -> State WriterState Doc -hypertarget ident x = do +hypertarget :: PandocMonad m => Bool -> String -> Doc -> LW m Doc +hypertarget _ "" x = return x +hypertarget addnewline ident x = do ref <- text `fmap` toLabel ident - internalLinks <- gets stInternalLinks - return $ - if ident `elem` internalLinks - then text "\\hypertarget" + return $ text "\\hypertarget" <> braces ref - <> braces x - else x + <> braces ((if addnewline && not (isEmpty x) + then ("%" <> cr) + else empty) <> x) -labelFor :: String -> State WriterState Doc +labelFor :: PandocMonad m => String -> LW m Doc labelFor "" = return empty labelFor ident = do ref <- text `fmap` toLabel ident return $ text "\\label" <> braces ref -- | Convert list of inline elements to LaTeX. -inlineListToLaTeX :: [Inline] -- ^ Inlines to convert - -> State WriterState Doc +inlineListToLaTeX :: PandocMonad m + => [Inline] -- ^ Inlines to convert + -> LW m Doc inlineListToLaTeX lst = - mapM inlineToLaTeX (fixBreaks $ fixLineInitialSpaces lst) + mapM inlineToLaTeX (fixLineInitialSpaces lst) >>= return . hcat -- nonbreaking spaces (~) in LaTeX don't work after line breaks, -- so we turn nbsps after hard breaks to \hspace commands. @@ -837,43 +970,35 @@ inlineListToLaTeX lst = fixNbsps s = let (ys,zs) = span (=='\160') s in replicate (length ys) hspace ++ [Str zs] hspace = RawInline "latex" "\\hspace*{0.333em}" - -- linebreaks after blank lines cause problems: - fixBreaks [] = [] - fixBreaks ys@(LineBreak : LineBreak : _) = - case span (== LineBreak) ys of - (lbs, rest) -> RawInline "latex" - ("\\\\[" ++ show (length lbs) ++ - "\\baselineskip]") : fixBreaks rest - fixBreaks (y:ys) = y : fixBreaks ys isQuoted :: Inline -> Bool isQuoted (Quoted _ _) = True -isQuoted _ = False +isQuoted _ = False -- | Convert inline element to LaTeX -inlineToLaTeX :: Inline -- ^ Inline to convert - -> State WriterState Doc +inlineToLaTeX :: PandocMonad m + => Inline -- ^ Inline to convert + -> LW m Doc inlineToLaTeX (Span (id',classes,kvs) ils) = do - ref <- toLabel id' - let linkAnchor = if null id' - then empty - else "\\protect\\hypertarget" <> braces (text ref) <> - braces empty + linkAnchor <- hypertarget False id' empty + lang <- toLang $ lookup "lang" kvs let cmds = ["textup" | "csl-no-emph" `elem` classes] ++ ["textnormal" | "csl-no-strong" `elem` classes || "csl-no-smallcaps" `elem` classes] ++ ["RL" | ("dir", "rtl") `elem` kvs] ++ ["LR" | ("dir", "ltr") `elem` kvs] ++ - (case lookup "lang" kvs of - Just lng -> let (l, o) = toPolyglossia $ splitBy (=='-') lng + (case lang of + Just lng -> let (l, o) = toPolyglossia lng ops = if null o then "" else ("[" ++ o ++ "]") in ["text" ++ l ++ ops] Nothing -> []) contents <- inlineListToLaTeX ils - return $ linkAnchor <> - if null cmds - then braces contents - else foldr inCmd contents cmds + return $ (if null id' + then empty + else "\\protect" <> linkAnchor) <> + (if null cmds + then braces contents + else foldr inCmd contents cmds) inlineToLaTeX (Emph lst) = inlineListToLaTeX lst >>= return . inCmd "emph" inlineToLaTeX (Strong lst) = @@ -886,7 +1011,7 @@ inlineToLaTeX (Strikeout lst) = do return $ inCmd "sout" contents inlineToLaTeX (Superscript lst) = inlineListToLaTeX lst >>= return . inCmd "textsuperscript" -inlineToLaTeX (Subscript lst) = do +inlineToLaTeX (Subscript lst) = inlineListToLaTeX lst >>= return . inCmd "textsubscript" inlineToLaTeX (SmallCaps lst) = inlineListToLaTeX lst >>= return . inCmd "textsc" @@ -901,26 +1026,39 @@ inlineToLaTeX (Cite cits lst) = do inlineToLaTeX (Code (_,classes,_) str) = do opts <- gets stOptions inHeading <- gets stInHeading + inItem <- gets stInItem + let listingsCode = do + let listingsopt = case getListingsLanguage classes of + Just l -> "[language=" ++ mbBraced l ++ "]" + Nothing -> "" + inNote <- gets stInNote + when inNote $ modify $ \s -> s{ stVerbInNote = True } + let chr = case "!\"&'()*,-./:;?@_" \\ str of + (c:_) -> c + [] -> '!' + let str' = escapeStringUsing (backslashEscapes "\\{}%~_&") str + -- we always put lstinline in a dummy 'passthrough' command + -- (defined in the default template) so that we don't have + -- to change the way we escape characters depending on whether + -- the lstinline is inside another command. See #1629: + return $ text $ "\\passthrough{\\lstinline" ++ listingsopt ++ [chr] ++ str' ++ [chr] ++ "}" + let rawCode = liftM (text . (\s -> "\\texttt{" ++ escapeSpaces s ++ "}")) + $ stringToLaTeX CodeString str + where escapeSpaces = concatMap + (\c -> if c == ' ' then "\\ " else [c]) + let highlightCode = + case highlight (writerSyntaxMap opts) + formatLaTeXInline ("",classes,[]) str of + Left msg -> do + unless (null msg) $ report $ CouldNotHighlight msg + rawCode + Right h -> modify (\st -> st{ stHighlighting = True }) >> + return (text (T.unpack h)) case () of - _ | writerListings opts && not inHeading -> listingsCode - | writerHighlight opts && not (null classes) -> highlightCode + _ | writerListings opts && not (inHeading || inItem) -> listingsCode + | isJust (writerHighlightStyle opts) && not (null classes) + -> highlightCode | otherwise -> rawCode - where listingsCode = do - inNote <- gets stInNote - when inNote $ modify $ \s -> s{ stVerbInNote = True } - let chr = case "!\"&'()*,-./:;?@_" \\ str of - (c:_) -> c - [] -> '!' - return $ text $ "\\lstinline" ++ [chr] ++ str ++ [chr] - highlightCode = do - case highlight formatLaTeXInline ("",classes,[]) str of - Nothing -> rawCode - Just h -> modify (\st -> st{ stHighlighting = True }) >> - return (text (T.unpack h)) - rawCode = liftM (text . (\s -> "\\texttt{" ++ escapeSpaces s ++ "}")) - $ stringToLaTeX CodeString str - where - escapeSpaces = concatMap (\c -> if c == ' ' then "\\ " else [c]) inlineToLaTeX (Quoted qt lst) = do contents <- inlineListToLaTeX lst csquotes <- liftM stCsquotes get @@ -928,32 +1066,43 @@ inlineToLaTeX (Quoted qt lst) = do if csquotes then return $ "\\enquote" <> braces contents else do - let s1 = if (not (null lst)) && (isQuoted (head lst)) + let s1 = if not (null lst) && isQuoted (head lst) then "\\," else empty - let s2 = if (not (null lst)) && (isQuoted (last lst)) + let s2 = if not (null lst) && isQuoted (last lst) then "\\," else empty let inner = s1 <> contents <> s2 return $ case qt of DoubleQuote -> - if writerTeXLigatures opts + if isEnabled Ext_smart opts then text "``" <> inner <> text "''" else char '\x201C' <> inner <> char '\x201D' SingleQuote -> - if writerTeXLigatures opts + if isEnabled Ext_smart opts then char '`' <> inner <> char '\'' else char '\x2018' <> inner <> char '\x2019' -inlineToLaTeX (Str str) = liftM text $ stringToLaTeX TextString str -inlineToLaTeX (Math InlineMath str) = +inlineToLaTeX (Str str) = do + setEmptyLine False + liftM text $ stringToLaTeX TextString str +inlineToLaTeX (Math InlineMath str) = do + setEmptyLine False return $ "\\(" <> text str <> "\\)" -inlineToLaTeX (Math DisplayMath str) = +inlineToLaTeX (Math DisplayMath str) = do + setEmptyLine False return $ "\\[" <> text str <> "\\]" -inlineToLaTeX (RawInline f str) +inlineToLaTeX il@(RawInline f str) | f == Format "latex" || f == Format "tex" - = return $ text str - | otherwise = return empty -inlineToLaTeX (LineBreak) = return $ "\\\\" <> cr + = do + setEmptyLine False + return $ text str + | otherwise = do + report $ InlineNotRendered il + return empty +inlineToLaTeX LineBreak = do + emptyLine <- gets stEmptyLine + setEmptyLine True + return $ (if emptyLine then "~" else "") <> "\\\\" <> cr inlineToLaTeX SoftBreak = do wrapText <- gets (writerWrapText . stOptions) case wrapText of @@ -982,19 +1131,32 @@ inlineToLaTeX (Link _ txt (src, _)) = src' <- stringToLaTeX URLString (escapeURI src) return $ text ("\\href{" ++ src' ++ "}{") <> contents <> char '}' +inlineToLaTeX il@(Image _ _ ('d':'a':'t':'a':':':_, _)) = do + report $ InlineNotRendered il + return empty inlineToLaTeX (Image attr _ (source, _)) = do + setEmptyLine False modify $ \s -> s{ stGraphics = True } opts <- gets stOptions let showDim dir = let d = text (show dir) <> "=" - in case (dimension dir attr) of + in case dimension dir attr of Just (Pixel a) -> [d <> text (showInInch opts (Pixel a)) <> "in"] Just (Percent a) -> - [d <> text (showFl (a / 100)) <> "\\textwidth"] + [d <> text (showFl (a / 100)) <> + case dir of + Width -> "\\textwidth" + Height -> "\\textheight" + ] Just dim -> [d <> text (show dim)] Nothing -> - [] + case dir of + Width | isJust (dimension Height attr) -> + [d <> "\\textwidth"] + Height | isJust (dimension Width attr) -> + [d <> "\\textheight"] + _ -> [] dimList = showDim Width ++ showDim Height dims = if null dimList then empty @@ -1008,6 +1170,7 @@ inlineToLaTeX (Image attr _ (source, _)) = do (if inHeading then "\\protect\\includegraphics" else "\\includegraphics") <> dims <> braces (text source'') inlineToLaTeX (Note contents) = do + setEmptyLine False inMinipage <- gets stInMinipage modify (\s -> s{stInNote = True}) contents' <- blockListToLaTeX contents @@ -1016,9 +1179,9 @@ inlineToLaTeX (Note contents) = do (CodeBlock _ _ : _) -> cr _ -> empty let noteContents = nest 2 contents' <> optnl - opts <- gets stOptions + beamer <- gets stBeamer -- in beamer slides, display footnote from current overlay forward - let beamerMark = if writerBeamer opts + let beamerMark = if beamer then text "<.->" else empty modify $ \st -> st{ stNotes = noteContents : stNotes st } @@ -1035,8 +1198,12 @@ protectCode (x@(Code _ _) : xs) = ltx "\\mbox{" : x : ltx "}" : xs where ltx = RawInline (Format "latex") protectCode (x : xs) = x : protectCode xs -citationsToNatbib :: [Citation] -> State WriterState Doc -citationsToNatbib (one:[]) +setEmptyLine :: PandocMonad m => Bool -> LW m () +setEmptyLine b = modify $ \st -> st{ stEmptyLine = b } + +citationsToNatbib :: PandocMonad m => [Citation] -> LW m Doc +citationsToNatbib + [one] = citeCommand c p s k where Citation { citationId = k @@ -1046,8 +1213,8 @@ citationsToNatbib (one:[]) } = one c = case m of - AuthorInText -> "citet" - SuppressAuthor -> "citeyearpar" + AuthorInText -> "citet" + SuppressAuthor -> "citeyearpar" NormalCitation -> "citep" citationsToNatbib cits @@ -1056,9 +1223,11 @@ citationsToNatbib cits where noPrefix = all (null . citationPrefix) noSuffix = all (null . citationSuffix) - ismode m = all (((==) m) . citationMode) - p = citationPrefix $ head $ cits - s = citationSuffix $ last $ cits + ismode m = all ((==) m . citationMode) + p = citationPrefix $ + head cits + s = citationSuffix $ + last cits ks = intercalate ", " $ map citationId cits citationsToNatbib (c:cs) | citationMode c == AuthorInText = do @@ -1082,17 +1251,20 @@ citationsToNatbib cits = do SuppressAuthor -> citeCommand "citeyear" p s k NormalCitation -> citeCommand "citealp" p s k -citeCommand :: String -> [Inline] -> [Inline] -> String -> State WriterState Doc +citeCommand :: PandocMonad m + => String -> [Inline] -> [Inline] -> String -> LW m Doc citeCommand c p s k = do args <- citeArguments p s k return $ text ("\\" ++ c) <> args -citeArguments :: [Inline] -> [Inline] -> String -> State WriterState Doc +citeArguments :: PandocMonad m + => [Inline] -> [Inline] -> String -> LW m Doc citeArguments p s k = do let s' = case s of - (Str (x:[]) : r) | isPunctuation x -> dropWhile (== Space) r + (Str + [x] : r) | isPunctuation x -> dropWhile (== Space) r (Str (x:xs) : r) | isPunctuation x -> Str xs : r - _ -> s + _ -> s pdoc <- inlineListToLaTeX p sdoc <- inlineListToLaTeX s' let optargs = case (isEmpty pdoc, isEmpty sdoc) of @@ -1101,8 +1273,9 @@ citeArguments p s k = do (_ , _ ) -> brackets pdoc <> brackets sdoc return $ optargs <> braces (text k) -citationsToBiblatex :: [Citation] -> State WriterState Doc -citationsToBiblatex (one:[]) +citationsToBiblatex :: PandocMonad m => [Citation] -> LW m Doc +citationsToBiblatex + [one] = citeCommand cmd p s k where Citation { citationId = k @@ -1133,15 +1306,20 @@ citationsToBiblatex _ = return empty -- Determine listings language from list of class attributes. getListingsLanguage :: [String] -> Maybe String -getListingsLanguage [] = Nothing -getListingsLanguage (x:xs) = toListingsLanguage x <|> getListingsLanguage xs +getListingsLanguage xs + = foldr ((<|>) . toListingsLanguage) Nothing xs + +mbBraced :: String -> String +mbBraced x = if not (all isAlphaNum x) + then "{" <> x <> "}" + else x -- Extract a key from divs and spans extract :: String -> Block -> [String] extract key (Div attr _) = lookKey key attr -extract key (Plain ils) = concatMap (extractInline key) ils -extract key (Para ils) = concatMap (extractInline key) ils -extract key (Header _ _ ils) = concatMap (extractInline key) ils +extract key (Plain ils) = query (extractInline key) ils +extract key (Para ils) = query (extractInline key) ils +extract key (Header _ _ ils) = query (extractInline key) ils extract _ _ = [] -- Extract a key from spans @@ -1154,85 +1332,95 @@ lookKey :: String -> Attr -> [String] lookKey key (_,_,kvs) = maybe [] words $ lookup key kvs -- In environments \Arabic instead of \arabic is used -toPolyglossiaEnv :: String -> (String, String) +toPolyglossiaEnv :: Lang -> (String, String) toPolyglossiaEnv l = - case toPolyglossia $ (splitBy (=='-')) l of + case toPolyglossia l of ("arabic", o) -> ("Arabic", o) x -> x -- Takes a list of the constituents of a BCP 47 language code and -- converts it to a Polyglossia (language, options) tuple -- http://mirrors.ctan.org/macros/latex/contrib/polyglossia/polyglossia.pdf -toPolyglossia :: [String] -> (String, String) -toPolyglossia ("ar":"DZ":_) = ("arabic", "locale=algeria") -toPolyglossia ("ar":"IQ":_) = ("arabic", "locale=mashriq") -toPolyglossia ("ar":"JO":_) = ("arabic", "locale=mashriq") -toPolyglossia ("ar":"LB":_) = ("arabic", "locale=mashriq") -toPolyglossia ("ar":"LY":_) = ("arabic", "locale=libya") -toPolyglossia ("ar":"MA":_) = ("arabic", "locale=morocco") -toPolyglossia ("ar":"MR":_) = ("arabic", "locale=mauritania") -toPolyglossia ("ar":"PS":_) = ("arabic", "locale=mashriq") -toPolyglossia ("ar":"SY":_) = ("arabic", "locale=mashriq") -toPolyglossia ("ar":"TN":_) = ("arabic", "locale=tunisia") -toPolyglossia ("de":"1901":_) = ("german", "spelling=old") -toPolyglossia ("de":"AT":"1901":_) = ("german", "variant=austrian, spelling=old") -toPolyglossia ("de":"AT":_) = ("german", "variant=austrian") -toPolyglossia ("de":"CH":"1901":_) = ("german", "variant=swiss, spelling=old") -toPolyglossia ("de":"CH":_) = ("german", "variant=swiss") -toPolyglossia ("de":_) = ("german", "") -toPolyglossia ("dsb":_) = ("lsorbian", "") -toPolyglossia ("el":"polyton":_) = ("greek", "variant=poly") -toPolyglossia ("en":"AU":_) = ("english", "variant=australian") -toPolyglossia ("en":"CA":_) = ("english", "variant=canadian") -toPolyglossia ("en":"GB":_) = ("english", "variant=british") -toPolyglossia ("en":"NZ":_) = ("english", "variant=newzealand") -toPolyglossia ("en":"UK":_) = ("english", "variant=british") -toPolyglossia ("en":"US":_) = ("english", "variant=american") -toPolyglossia ("grc":_) = ("greek", "variant=ancient") -toPolyglossia ("hsb":_) = ("usorbian", "") -toPolyglossia ("la":"x":"classic":_) = ("latin", "variant=classic") -toPolyglossia ("sl":_) = ("slovenian", "") -toPolyglossia x = (commonFromBcp47 x, "") +toPolyglossia :: Lang -> (String, String) +toPolyglossia (Lang "ar" _ "DZ" _) = ("arabic", "locale=algeria") +toPolyglossia (Lang "ar" _ "IQ" _) = ("arabic", "locale=mashriq") +toPolyglossia (Lang "ar" _ "JO" _) = ("arabic", "locale=mashriq") +toPolyglossia (Lang "ar" _ "LB" _) = ("arabic", "locale=mashriq") +toPolyglossia (Lang "ar" _ "LY" _) = ("arabic", "locale=libya") +toPolyglossia (Lang "ar" _ "MA" _) = ("arabic", "locale=morocco") +toPolyglossia (Lang "ar" _ "MR" _) = ("arabic", "locale=mauritania") +toPolyglossia (Lang "ar" _ "PS" _) = ("arabic", "locale=mashriq") +toPolyglossia (Lang "ar" _ "SY" _) = ("arabic", "locale=mashriq") +toPolyglossia (Lang "ar" _ "TN" _) = ("arabic", "locale=tunisia") +toPolyglossia (Lang "de" _ _ vars) + | "1901" `elem` vars = ("german", "spelling=old") +toPolyglossia (Lang "de" _ "AT" vars) + | "1901" `elem` vars = ("german", "variant=austrian, spelling=old") +toPolyglossia (Lang "de" _ "AT" _) = ("german", "variant=austrian") +toPolyglossia (Lang "de" _ "CH" vars) + | "1901" `elem` vars = ("german", "variant=swiss, spelling=old") +toPolyglossia (Lang "de" _ "CH" _) = ("german", "variant=swiss") +toPolyglossia (Lang "de" _ _ _) = ("german", "") +toPolyglossia (Lang "dsb" _ _ _) = ("lsorbian", "") +toPolyglossia (Lang "el" _ "polyton" _) = ("greek", "variant=poly") +toPolyglossia (Lang "en" _ "AU" _) = ("english", "variant=australian") +toPolyglossia (Lang "en" _ "CA" _) = ("english", "variant=canadian") +toPolyglossia (Lang "en" _ "GB" _) = ("english", "variant=british") +toPolyglossia (Lang "en" _ "NZ" _) = ("english", "variant=newzealand") +toPolyglossia (Lang "en" _ "UK" _) = ("english", "variant=british") +toPolyglossia (Lang "en" _ "US" _) = ("english", "variant=american") +toPolyglossia (Lang "grc" _ _ _) = ("greek", "variant=ancient") +toPolyglossia (Lang "hsb" _ _ _) = ("usorbian", "") +toPolyglossia (Lang "la" _ _ vars) + | "x-classic" `elem` vars = ("latin", "variant=classic") +toPolyglossia (Lang "sl" _ _ _) = ("slovenian", "") +toPolyglossia x = (commonFromBcp47 x, "") -- Takes a list of the constituents of a BCP 47 language code and -- converts it to a Babel language string. -- http://mirrors.ctan.org/macros/latex/required/babel/base/babel.pdf -- List of supported languages (slightly outdated): -- http://tug.ctan.org/language/hyph-utf8/doc/generic/hyph-utf8/hyphenation.pdf -toBabel :: [String] -> String -toBabel ("de":"1901":_) = "german" -toBabel ("de":"AT":"1901":_) = "austrian" -toBabel ("de":"AT":_) = "naustrian" -toBabel ("de":"CH":"1901":_) = "swissgerman" -toBabel ("de":"CH":_) = "nswissgerman" -toBabel ("de":_) = "ngerman" -toBabel ("dsb":_) = "lowersorbian" -toBabel ("el":"polyton":_) = "polutonikogreek" -toBabel ("en":"AU":_) = "australian" -toBabel ("en":"CA":_) = "canadian" -toBabel ("en":"GB":_) = "british" -toBabel ("en":"NZ":_) = "newzealand" -toBabel ("en":"UK":_) = "british" -toBabel ("en":"US":_) = "american" -toBabel ("fr":"CA":_) = "canadien" -toBabel ("fra":"aca":_) = "acadian" -toBabel ("grc":_) = "polutonikogreek" -toBabel ("hsb":_) = "uppersorbian" -toBabel ("la":"x":"classic":_) = "classiclatin" -toBabel ("sl":_) = "slovene" -toBabel x = commonFromBcp47 x +toBabel :: Lang -> String +toBabel (Lang "de" _ "AT" vars) + | "1901" `elem` vars = "austrian" + | otherwise = "naustrian" +toBabel (Lang "de" _ "CH" vars) + | "1901" `elem` vars = "swissgerman" + | otherwise = "nswissgerman" +toBabel (Lang "de" _ _ vars) + | "1901" `elem` vars = "german" + | otherwise = "ngerman" +toBabel (Lang "dsb" _ _ _) = "lowersorbian" +toBabel (Lang "el" _ _ vars) + | "polyton" `elem` vars = "polutonikogreek" +toBabel (Lang "en" _ "AU" _) = "australian" +toBabel (Lang "en" _ "CA" _) = "canadian" +toBabel (Lang "en" _ "GB" _) = "british" +toBabel (Lang "en" _ "NZ" _) = "newzealand" +toBabel (Lang "en" _ "UK" _) = "british" +toBabel (Lang "en" _ "US" _) = "american" +toBabel (Lang "fr" _ "CA" _) = "canadien" +toBabel (Lang "fra" _ _ vars) + | "aca" `elem` vars = "acadian" +toBabel (Lang "grc" _ _ _) = "polutonikogreek" +toBabel (Lang "hsb" _ _ _) = "uppersorbian" +toBabel (Lang "la" _ _ vars) + | "x-classic" `elem` vars = "classiclatin" +toBabel (Lang "sl" _ _ _) = "slovene" +toBabel x = commonFromBcp47 x -- Takes a list of the constituents of a BCP 47 language code -- and converts it to a string shared by Babel and Polyglossia. -- https://tools.ietf.org/html/bcp47#section-2.1 -commonFromBcp47 :: [String] -> String -commonFromBcp47 [] = "" -commonFromBcp47 ("pt":"BR":_) = "brazil" +commonFromBcp47 :: Lang -> String +commonFromBcp47 (Lang "pt" _ "BR" _) = "brazil" -- Note: documentation says "brazilian" works too, but it doesn't seem to work -- on some systems. See #2953. -commonFromBcp47 ("sr":"Cyrl":_) = "serbianc" -commonFromBcp47 ("zh":"Latn":"pinyin":_) = "pinyin" -commonFromBcp47 x = fromIso $ head x +commonFromBcp47 (Lang "sr" "Cyrl" _ _) = "serbianc" +commonFromBcp47 (Lang "zh" "Latn" _ vars) + | "pinyin" `elem` vars = "pinyin" +commonFromBcp47 (Lang l _ _ _) = fromIso l where fromIso "af" = "afrikaans" fromIso "am" = "amharic" @@ -1316,10 +1504,6 @@ commonFromBcp47 x = fromIso $ head x fromIso "vi" = "vietnamese" fromIso _ = "" -deNote :: Inline -> Inline -deNote (Note _) = RawInline (Format "latex") "" -deNote x = x - pDocumentOptions :: P.Parsec String () [String] pDocumentOptions = do P.char '[' |