diff options
Diffstat (limited to 'src/Text/Pandoc/Writers')
30 files changed, 494 insertions, 318 deletions
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index 46dbe6eaf..112f8b657 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -37,7 +37,7 @@ that it has omitted the construct. AsciiDoc: <http://www.methods.co.nz/asciidoc/> -} module Text.Pandoc.Writers.AsciiDoc (writeAsciiDoc) where -import Control.Monad.State +import Control.Monad.State.Strict import Data.Aeson (Result (..), Value (String), fromJSON, toJSON) import Data.Char (isPunctuation, isSpace) import Data.List (intercalate, intersperse, stripPrefix) @@ -105,7 +105,7 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do $ metadata' case writerTemplate opts of Nothing -> return main - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context -- | Escape special characters for AsciiDoc. escapeString :: String -> String diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs index ed316ced9..63249a7ce 100644 --- a/src/Text/Pandoc/Writers/CommonMark.hs +++ b/src/Text/Pandoc/Writers/CommonMark.hs @@ -32,7 +32,7 @@ CommonMark: <http://commonmark.org> module Text.Pandoc.Writers.CommonMark (writeCommonMark) where import CMark -import Control.Monad.State (State, get, modify, runState) +import Control.Monad.State.Strict (State, get, modify, runState) import Data.Foldable (foldrM) import Data.Text (Text) import qualified Data.Text as T @@ -58,9 +58,9 @@ writeCommonMark opts (Pandoc meta blocks) = do (inlinesToCommonMark opts) meta let context = defField "body" main $ metadata - return $ case writerTemplate opts of - Nothing -> main - Just tpl -> renderTemplate' tpl context + case writerTemplate opts of + Nothing -> return main + Just tpl -> renderTemplate' tpl context processNotes :: Inline -> State [[Block]] Inline processNotes (Note bs) = do diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 2da6a7f9a..3c901cab6 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {- Copyright (C) 2007-2017 John MacFarlane <jgm@berkeley.edu> @@ -29,12 +30,13 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' format into ConTeXt. -} module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where -import Control.Monad.State +import Control.Monad.State.Strict import Data.Char (ord) import Data.List (intercalate, intersperse) import Data.Maybe (catMaybes) import Data.Text (Text) import Network.URI (unEscapeString) +import Text.Pandoc.BCP47 import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Logging import Text.Pandoc.Definition @@ -88,6 +90,7 @@ pandocToConTeXt options (Pandoc meta blocks) = do ,("top","margin-top") ,("bottom","margin-bottom") ] + mblang <- fromBCP47 (getLang options meta) let context = defField "toc" (writerTableOfContents options) $ defField "placelist" (intercalate ("," :: String) $ take (writerTOCDepth options + @@ -100,14 +103,17 @@ pandocToConTeXt options (Pandoc meta blocks) = do $ defField "body" main $ defField "layout" layoutFromMargins $ defField "number-sections" (writerNumberSections options) + $ maybe id (defField "context-lang") mblang + $ (case getField "papersize" metadata of + Just ("a4" :: String) -> resetField "papersize" + ("A4" :: String) + _ -> id) $ metadata - let context' = defField "context-lang" (maybe "" (fromBcp47 . splitBy (=='-')) $ - getField "lang" context) - $ defField "context-dir" (toContextDir $ getField "dir" context) - $ context - return $ case writerTemplate options of - Nothing -> main - Just tpl -> renderTemplate' tpl context' + let context' = defField "context-dir" (toContextDir + $ getField "dir" context) context + case writerTemplate options of + Nothing -> return main + Just tpl -> renderTemplate' tpl context' toContextDir :: Maybe String -> String toContextDir (Just "rtl") = "r2l" @@ -186,6 +192,7 @@ blockToConTeXt b@(RawBlock _ _ ) = do return empty blockToConTeXt (Div (ident,_,kvs) bs) = do let align dir txt = "\\startalignment[" <> dir <> "]" $$ txt $$ "\\stopalignment" + mblang <- fromBCP47 (lookup "lang" kvs) let wrapRef txt = if null ident then txt else ("\\reference" <> brackets (text $ toLabel ident) <> @@ -194,9 +201,9 @@ blockToConTeXt (Div (ident,_,kvs) bs) = do Just "rtl" -> align "righttoleft" Just "ltr" -> align "lefttoright" _ -> id - wrapLang txt = case lookup "lang" kvs of + wrapLang txt = case mblang of Just lng -> "\\start\\language[" - <> text (fromBcp47' lng) <> "]" $$ txt $$ "\\stop" + <> text lng <> "]" $$ txt $$ "\\stop" Nothing -> txt wrapBlank txt = blankline <> txt <> blankline fmap (wrapBlank . wrapLang . wrapDir . wrapRef) $ blockListToConTeXt bs @@ -416,12 +423,13 @@ inlineToConTeXt (Note contents) = do else text "\\startbuffer " <> nest 2 contents' <> text "\\stopbuffer\\footnote{\\getbuffer}" inlineToConTeXt (Span (_,_,kvs) ils) = do + mblang <- fromBCP47 (lookup "lang" kvs) let wrapDir txt = case lookup "dir" kvs of Just "rtl" -> braces $ "\\righttoleft " <> txt Just "ltr" -> braces $ "\\lefttoright " <> txt _ -> txt - wrapLang txt = case lookup "lang" kvs of - Just lng -> "\\start\\language[" <> text (fromBcp47' lng) + wrapLang txt = case mblang of + Just lng -> "\\start\\language[" <> text lng <> "]" <> txt <> "\\stop " Nothing -> txt fmap (wrapLang . wrapDir) $ inlineListToConTeXt ils @@ -458,36 +466,34 @@ sectionHeader (ident,classes,_) hdrLevel lst = do <> blankline _ -> contents <> blankline -fromBcp47' :: String -> String -fromBcp47' = fromBcp47 . splitBy (=='-') +fromBCP47 :: PandocMonad m => Maybe String -> WM m (Maybe String) +fromBCP47 mbs = fromBCP47' <$> toLang mbs -- Takes a list of the constituents of a BCP 47 language code -- and irons out ConTeXt's exceptions -- https://tools.ietf.org/html/bcp47#section-2.1 -- http://wiki.contextgarden.net/Language_Codes -fromBcp47 :: [String] -> String -fromBcp47 [] = "" -fromBcp47 ("ar":"SY":_) = "ar-sy" -fromBcp47 ("ar":"IQ":_) = "ar-iq" -fromBcp47 ("ar":"JO":_) = "ar-jo" -fromBcp47 ("ar":"LB":_) = "ar-lb" -fromBcp47 ("ar":"DZ":_) = "ar-dz" -fromBcp47 ("ar":"MA":_) = "ar-ma" -fromBcp47 ("de":"1901":_) = "deo" -fromBcp47 ("de":"DE":_) = "de-de" -fromBcp47 ("de":"AT":_) = "de-at" -fromBcp47 ("de":"CH":_) = "de-ch" -fromBcp47 ("el":"poly":_) = "agr" -fromBcp47 ("en":"US":_) = "en-us" -fromBcp47 ("en":"GB":_) = "en-gb" -fromBcp47 ("grc":_) = "agr" -fromBcp47 x = fromIso $ head x - where - fromIso "el" = "gr" - fromIso "eu" = "ba" - fromIso "he" = "il" - fromIso "jp" = "ja" - fromIso "uk" = "ua" - fromIso "vi" = "vn" - fromIso "zh" = "cn" - fromIso l = l +fromBCP47' :: Maybe Lang -> Maybe String +fromBCP47' (Just (Lang "ar" _ "SY" _) ) = Just "ar-sy" +fromBCP47' (Just (Lang "ar" _ "IQ" _) ) = Just "ar-iq" +fromBCP47' (Just (Lang "ar" _ "JO" _) ) = Just "ar-jo" +fromBCP47' (Just (Lang "ar" _ "LB" _) ) = Just "ar-lb" +fromBCP47' (Just (Lang "ar" _ "DZ" _) ) = Just "ar-dz" +fromBCP47' (Just (Lang "ar" _ "MA" _) ) = Just "ar-ma" +fromBCP47' (Just (Lang "de" _ _ ["1901"]) ) = Just "deo" +fromBCP47' (Just (Lang "de" _ "DE" _) ) = Just "de-de" +fromBCP47' (Just (Lang "de" _ "AT" _) ) = Just "de-at" +fromBCP47' (Just (Lang "de" _ "CH" _) ) = Just "de-ch" +fromBCP47' (Just (Lang "el" _ _ ["poly"]) ) = Just "agr" +fromBCP47' (Just (Lang "en" _ "US" _) ) = Just "en-us" +fromBCP47' (Just (Lang "en" _ "GB" _) ) = Just "en-gb" +fromBCP47' (Just (Lang "grc"_ _ _) ) = Just "agr" +fromBCP47' (Just (Lang "el" _ _ _) ) = Just "gr" +fromBCP47' (Just (Lang "eu" _ _ _) ) = Just "ba" +fromBCP47' (Just (Lang "he" _ _ _) ) = Just "il" +fromBCP47' (Just (Lang "jp" _ _ _) ) = Just "ja" +fromBCP47' (Just (Lang "uk" _ _ _) ) = Just "ua" +fromBCP47' (Just (Lang "vi" _ _ _) ) = Just "vn" +fromBCP47' (Just (Lang "zh" _ _ _) ) = Just "cn" +fromBCP47' (Just (Lang l _ _ _) ) = Just l +fromBCP47' Nothing = Nothing diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 1314ef844..363bad99b 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -46,6 +46,7 @@ import Data.Typeable import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8) import Scripting.Lua (LuaState, StackValue, callfunc) import qualified Scripting.Lua as Lua +import Text.Pandoc.Error import Text.Pandoc.Lua.Compat ( loadstring ) import Text.Pandoc.Lua.Util ( addValue ) import Text.Pandoc.Lua.SharedInstances () @@ -141,8 +142,10 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do let body = rendered case writerTemplate opts of Nothing -> return $ pack body - Just tpl -> return $ pack $ - renderTemplate' tpl $ setField "body" body context + Just tpl -> + case applyTemplate (pack tpl) $ setField "body" body context of + Left e -> throw (PandocTemplateError e) + Right r -> return (pack r) docToCustom :: LuaState -> WriterOptions -> Pandoc -> IO String docToCustom lua opts (Pandoc (Meta metamap) blocks) = do diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 02ffbf831..9db9a0102 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -124,9 +124,9 @@ writeDocbook opts (Pandoc meta blocks) = do MathML -> True _ -> False) $ metadata - return $ case writerTemplate opts of - Nothing -> main - Just tpl -> renderTemplate' tpl context + case writerTemplate opts of + Nothing -> return main + Just tpl -> renderTemplate' tpl context -- | Convert an Element to Docbook. elementToDocbook :: PandocMonad m => WriterOptions -> Int -> Element -> DB m Doc @@ -217,8 +217,10 @@ blockToDocbook opts (Div (ident,_,_) bs) = do (if null ident then mempty else selfClosingTag "anchor" [("id", ident)]) $$ contents -blockToDocbook _ (Header _ _ _) = - return empty -- should not occur after hierarchicalize +blockToDocbook _ h@(Header _ _ _) = do + -- should not occur after hierarchicalize, except inside lists/blockquotes + report $ BlockNotRendered h + return empty blockToDocbook opts (Plain lst) = inlinesToDocbook opts lst -- title beginning with fig: indicates that the image is a figure blockToDocbook opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) = do diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 63bb8a5ae..fb6b2013a 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -37,7 +37,7 @@ import Codec.Archive.Zip import Control.Applicative ((<|>)) import Control.Monad.Except (catchError) import Control.Monad.Reader -import Control.Monad.State +import Control.Monad.State.Strict import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BL8 @@ -68,6 +68,7 @@ import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Walk import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Shared (fixDisplayMath) +import Text.Pandoc.BCP47 (getLang, renderLang, toLang) import Text.Printf (printf) import Text.TeXMath import Text.XML.Light as XML @@ -257,12 +258,11 @@ writeDocx opts doc@(Pandoc meta _) = do ) -- styles - let lang = case lookupMeta "lang" meta of - Just (MetaInlines [Str s]) -> Just s - Just (MetaString s) -> Just s - _ -> Nothing + mblang <- toLang $ getLang opts meta let addLang :: Element -> Element - addLang e = case lang >>= \l -> (return . XMLC.toTree . go l . XMLC.fromElement) e of + addLang e = case mblang >>= \l -> + (return . XMLC.toTree . go (renderLang l) + . XMLC.fromElement) e of Just (Elem e') -> e' _ -> e -- return original where go :: String -> Cursor -> Cursor @@ -657,6 +657,9 @@ mkNumbering lists = do elts <- mapM mkAbstractNum (ordNub lists) return $ elts ++ zipWith mkNum lists [baseListId..(baseListId + length lists - 1)] +maxListLevel :: Int +maxListLevel = 8 + mkNum :: ListMarker -> Int -> Element mkNum marker numid = mknode "w:num" [("w:numId",show numid)] @@ -666,7 +669,8 @@ mkNum marker numid = BulletMarker -> [] NumberMarker _ _ start -> map (\lvl -> mknode "w:lvlOverride" [("w:ilvl",show (lvl :: Int))] - $ mknode "w:startOverride" [("w:val",show start)] ()) [0..6] + $ mknode "w:startOverride" [("w:val",show start)] ()) + [0..maxListLevel] mkAbstractNum :: (PandocMonad m) => ListMarker -> m Element mkAbstractNum marker = do @@ -675,7 +679,8 @@ mkAbstractNum marker = do return $ mknode "w:abstractNum" [("w:abstractNumId",listMarkerToId marker)] $ mknode "w:nsid" [("w:val", printf "%8x" nsid)] () : mknode "w:multiLevelType" [("w:val","multilevel")] () - : map (mkLvl marker) [0..6] + : map (mkLvl marker) + [0..maxListLevel] mkLvl :: ListMarker -> Int -> Element mkLvl marker lvl = @@ -706,7 +711,7 @@ mkLvl marker lvl = bulletFor 3 = "\x2013" bulletFor 4 = "\x2022" bulletFor 5 = "\x2013" - bulletFor _ = "\x2022" + bulletFor x = bulletFor (x `mod` 6) styleFor UpperAlpha _ = "upperLetter" styleFor LowerAlpha _ = "lowerLetter" styleFor UpperRoman _ = "upperRoman" @@ -718,6 +723,7 @@ mkLvl marker lvl = styleFor DefaultStyle 4 = "decimal" styleFor DefaultStyle 5 = "lowerLetter" styleFor DefaultStyle 6 = "lowerRoman" + styleFor DefaultStyle x = styleFor DefaultStyle (x `mod` 7) styleFor _ _ = "decimal" patternFor OneParen s = s ++ ")" patternFor TwoParens s = "(" ++ s ++ ")" diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index 551a1b0b5..ad8689e8c 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -41,7 +41,7 @@ DokuWiki: <https://www.dokuwiki.org/dokuwiki> module Text.Pandoc.Writers.DokuWiki ( writeDokuWiki ) where import Control.Monad (zipWithM) import Control.Monad.Reader (ReaderT, ask, local, runReaderT) -import Control.Monad.State (StateT, evalStateT, gets, modify) +import Control.Monad.State.Strict (StateT, evalStateT, gets, modify) import Data.Default (Default (..)) import Data.List (intercalate, intersect, isPrefixOf, transpose) import Data.Text (Text, pack) @@ -103,7 +103,7 @@ pandocToDokuWiki opts (Pandoc meta blocks) = do $ metadata case writerTemplate opts of Nothing -> return main - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context -- | Escape special characters for DokuWiki. escapeString :: String -> String diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index d68283007..a48fcf415 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -34,14 +34,14 @@ Conversion of 'Pandoc' documents to EPUB. module Text.Pandoc.Writers.EPUB ( writeEPUB2, writeEPUB3 ) where import Codec.Archive.Zip (Entry, addEntryToArchive, eRelativePath, emptyArchive, fromArchive, fromEntry, toEntry) -import Control.Monad (mplus, when, zipWithM) +import Control.Monad (mplus, when, unless, zipWithM) import Control.Monad.Except (catchError, throwError) -import Control.Monad.State (State, StateT, evalState, evalStateT, get, gets, +import Control.Monad.State.Strict (State, StateT, evalState, evalStateT, get, gets, lift, modify, put) import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy.Char8 as B8 import qualified Data.Text.Lazy as TL -import Data.Char (isAlphaNum, isDigit, toLower) +import Data.Char (isAlphaNum, isDigit, toLower, isAscii) import Data.List (intercalate, isInfixOf, isPrefixOf) import qualified Data.Map as M import Data.Maybe (catMaybes, fromMaybe) @@ -103,6 +103,7 @@ data EPUBMetadata = EPUBMetadata{ , epubCoverImage :: Maybe String , epubStylesheets :: [FilePath] , epubPageDirection :: Maybe ProgressionDirection + , epubIbooksFields :: [(String, String)] } deriving Show data Date = Date{ @@ -312,6 +313,7 @@ metadataFromMeta opts meta = EPUBMetadata{ , epubCoverImage = coverImage , epubStylesheets = stylesheets , epubPageDirection = pageDirection + , epubIbooksFields = ibooksFields } where identifiers = getIdentifier meta titles = getTitle meta @@ -339,6 +341,10 @@ metadataFromMeta opts meta = EPUBMetadata{ Just "ltr" -> Just LTR Just "rtl" -> Just RTL _ -> Nothing + ibooksFields = case lookupMeta "ibooks" meta of + Just (MetaMap mp) + -> M.toList $ M.map metaValueToString mp + _ -> [] -- | Produce an EPUB2 file from a Pandoc document. writeEPUB2 :: PandocMonad m @@ -361,8 +367,7 @@ writeEPUB :: PandocMonad m -> Pandoc -- ^ Document to convert -> m B.ByteString writeEPUB epubVersion opts doc = - let initState = EPUBState { stMediaPaths = [] - } + let initState = EPUBState { stMediaPaths = [] } in evalStateT (pandocToEPUB epubVersion opts doc) initState @@ -373,6 +378,10 @@ pandocToEPUB :: PandocMonad m -> Pandoc -> E m B.ByteString pandocToEPUB version opts doc@(Pandoc meta _) = do + let epubSubdir = writerEpubSubdirectory opts + -- sanity check on epubSubdir + unless (all (\c -> isAscii c && isAlphaNum c) epubSubdir) $ + throwError $ PandocEpubSubdirectoryError epubSubdir let epub3 = version == EPUB3 let writeHtml o = fmap (UTF8.fromTextLazy . TL.fromStrict) . writeHtmlStringForEPUB version o @@ -383,14 +392,15 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do -- stylesheet stylesheets <- case epubStylesheets metadata of [] -> (\x -> [B.fromChunks [x]]) <$> - P.readDataFile (writerUserDataDir opts) "epub.css" + P.readDataFile (writerUserDataDir opts) + "epub.css" fs -> mapM P.readFileLazy fs let stylesheetEntries = zipWith - (\bs n -> mkEntry ("stylesheet" ++ show n ++ ".css") bs) + (\bs n -> mkEntry ("styles/stylesheet" ++ show n ++ ".css") bs) stylesheets [(1 :: Int)..] let vars = ("epub3", if epub3 then "true" else "false") - : map (\e -> ("css", eRelativePath e)) stylesheetEntries + : map (\e -> ("css", "../" ++ eRelativePath e)) stylesheetEntries ++ [(x,y) | (x,y) <- writerVariables opts, x /= "css"] let opts' = opts{ writerEmailObfuscation = NoObfuscation , writerSectionDivs = True @@ -418,7 +428,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do tpContent <- lift $ writeHtml opts'{ writerVariables = ("titlepage","true"):vars } (Pandoc meta []) - let tpEntry = mkEntry "title_page.xhtml" tpContent + let tpEntry = mkEntry "text/title_page.xhtml" tpContent -- handle pictures -- mediaRef <- P.newIORef [] @@ -431,7 +441,8 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do when (null xs) $ report $ CouldNotFetchResource f "glob did not match any font files" return xs - let mkFontEntry f = mkEntry (takeFileName f) `fmap` (lift $ P.readFileLazy f) + let mkFontEntry f = mkEntry ("fonts/" ++ takeFileName f) <$> + lift (P.readFileLazy f) fontFiles <- concat <$> mapM matchingGlob (writerEpubFonts opts') fontEntries <- mapM mkFontEntry fontFiles @@ -516,7 +527,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do chapters' let chapToEntry num (Chapter mbnum bs) = - mkEntry (showChapter num) <$> + mkEntry ("text/" ++ showChapter num) <$> (writeHtml opts'{ writerNumberOffset = fromMaybe [] mbnum } $ case bs of (Header _ _ xs : _) -> @@ -572,7 +583,8 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do EPUB2 -> "2.0" EPUB3 -> "3.0") ,("xmlns","http://www.idpf.org/2007/opf") - ,("unique-identifier","epub-id-1")] $ + ,("unique-identifier","epub-id-1") + ,("prefix","ibooks: http://vocabulary.itunes.apple.com/rdf/ibooks/vocabulary-extensions-1.0/")] $ [ metadataElement version metadata currentTime , unode "manifest" $ [ unode "item" ! [("id","ncx"), ("href","toc.ncx") @@ -648,12 +660,12 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do navMapFormatter n tit src subs = unode "navPoint" ! [("id", "navPoint-" ++ show n)] $ [ unode "navLabel" $ unode "text" tit - , unode "content" ! [("src", src)] $ () + , unode "content" ! [("src", "text/" ++ src)] $ () ] ++ subs let tpNode = unode "navPoint" ! [("id", "navPoint-0")] $ [ unode "navLabel" $ unode "text" (stringify $ docTitle' meta) - , unode "content" ! [("src","title_page.xhtml")] $ () ] + , unode "content" ! [("src","text/title_page.xhtml")] $ () ] navMap <- lift $ evalStateT (mapM (navPointNode navMapFormatter) secs) 1 let tocData = UTF8.fromStringLazy $ ppTopElement $ @@ -681,7 +693,8 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do let navXhtmlFormatter :: Int -> String -> String -> [Element] -> Element navXhtmlFormatter n tit src subs = unode "li" ! [("id", "toc-li-" ++ show n)] $ - (unode "a" ! [("href",src)] + (unode "a" ! [("href", "text/" ++ + src)] $ tit) : case subs of [] -> [] @@ -714,7 +727,11 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do ] ] else [] - navData <- lift $ writeHtml opts'{ writerVariables = ("navpage","true"):vars } + navData <- lift $ writeHtml opts'{ writerVariables = ("navpage","true"): + -- remove the leading ../ from stylesheet paths: + map (\(k,v) -> if k == "css" + then (k, drop 3 v) + else (k, v)) vars } (Pandoc (setMeta "title" (walk removeNote $ fromList $ docTitle' meta) nullMeta) (navBlocks ++ landmarks)) @@ -728,7 +745,8 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do unode "container" ! [("version","1.0") ,("xmlns","urn:oasis:names:tc:opendocument:xmlns:container")] $ unode "rootfiles" $ - unode "rootfile" ! [("full-path","content.opf") + unode "rootfile" ! [("full-path", + epubSubdir ++ ['/' | not (null epubSubdir)] ++ "content.opf") ,("media-type","application/oebps-package+xml")] $ () let containerEntry = mkEntry "META-INF/container.xml" containerData @@ -739,10 +757,14 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do unode "option" ! [("name","specified-fonts")] $ "true" let appleEntry = mkEntry "META-INF/com.apple.ibooks.display-options.xml" apple + let addEpubSubdir :: Entry -> Entry + addEpubSubdir e = e{ eRelativePath = + epubSubdir ++ ['/' | not (null epubSubdir)] ++ eRelativePath e } -- construct archive - let archive = foldr addEntryToArchive emptyArchive - (mimetypeEntry : containerEntry : appleEntry : tpEntry : - contentsEntry : tocEntry : navEntry : + let archive = foldr addEntryToArchive emptyArchive $ + [mimetypeEntry, containerEntry, appleEntry] ++ + map addEpubSubdir + (tpEntry : contentsEntry : tocEntry : navEntry : (stylesheetEntries ++ picEntries ++ cpicEntry ++ cpgEntry ++ chapterEntries ++ fontEntries)) return $ fromArchive archive @@ -751,7 +773,8 @@ metadataElement :: EPUBVersion -> EPUBMetadata -> UTCTime -> Element metadataElement version md currentTime = unode "metadata" ! [("xmlns:dc","http://purl.org/dc/elements/1.1/") ,("xmlns:opf","http://www.idpf.org/2007/opf")] $ mdNodes - where mdNodes = identifierNodes ++ titleNodes ++ dateNodes ++ languageNodes + where mdNodes = identifierNodes ++ titleNodes ++ dateNodes + ++ languageNodes ++ ibooksNodes ++ creatorNodes ++ contributorNodes ++ subjectNodes ++ descriptionNodes ++ typeNodes ++ formatNodes ++ publisherNodes ++ sourceNodes ++ relationNodes @@ -770,6 +793,8 @@ metadataElement version md currentTime = [] -> [] (x:_) -> [dcNode "date" ! [("id","epub-date")] $ dateText x] + ibooksNodes = map ibooksNode (epubIbooksFields md) + ibooksNode (k, v) = unode "meta" ! [("property", "ibooks:" ++ k)] $ v languageNodes = [dcTag "language" $ epubLanguage md] creatorNodes = withIds "epub-creator" (toCreatorNode "creator") $ epubCreator md @@ -883,10 +908,10 @@ modifyMediaRef opts oldsrc = do Nothing -> catchError (do (img, mbMime) <- P.fetchItem (writerSourceURL opts) oldsrc let new = "media/file" ++ show (length media) ++ - fromMaybe (takeExtension (takeWhile (/='?') oldsrc)) - (('.':) <$> (mbMime >>= extensionFromMimeType)) + fromMaybe (takeExtension (takeWhile (/='?') oldsrc)) + (('.':) <$> (mbMime >>= extensionFromMimeType)) epochtime <- floor `fmap` lift P.getPOSIXTime - let entry = toEntry new epochtime $ B.fromChunks . (:[]) $ img + let entry = toEntry new epochtime (B.fromChunks . (:[]) $ img) modify $ \st -> st{ stMediaPaths = (oldsrc, (new, Just entry)):media} return new) @@ -913,12 +938,13 @@ transformInline :: PandocMonad m -> E m Inline transformInline opts (Image attr lab (src,tit)) = do newsrc <- modifyMediaRef opts src - return $ Image attr lab (newsrc, tit) + return $ Image attr lab ("../" ++ newsrc, tit) transformInline opts (x@(Math t m)) | WebTeX url <- writerHTMLMathMethod opts = do newsrc <- modifyMediaRef opts (url ++ urlEncode m) let mathclass = if t == DisplayMath then "display" else "inline" - return $ Span ("",["math",mathclass],[]) [Image nullAttr [x] (newsrc, "")] + return $ Span ("",["math",mathclass],[]) + [Image nullAttr [x] ("../" ++ newsrc, "")] transformInline opts (RawInline fmt raw) | fmt == Format "html" = do let tags = parseTags raw diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 213756330..4c764d987 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -37,9 +37,9 @@ FictionBook is an XML-based e-book format. For more information see: -} module Text.Pandoc.Writers.FB2 (writeFB2) where -import Control.Monad.Except (catchError, throwError) -import Control.Monad.State (StateT, evalStateT, get, lift, modify) -import Control.Monad.State (liftM) +import Control.Monad.Except (catchError) +import Control.Monad.State.Strict (StateT, evalStateT, get, lift, modify) +import Control.Monad.State.Strict (liftM) import Data.ByteString.Base64 (encode) import qualified Data.ByteString.Char8 as B8 import Data.Char (isAscii, isControl, isSpace, toLower) @@ -54,7 +54,6 @@ import qualified Text.XML.Light.Cursor as XC import Text.Pandoc.Class (PandocMonad, report) import qualified Text.Pandoc.Class as P import Text.Pandoc.Definition -import Text.Pandoc.Error import Text.Pandoc.Logging import Text.Pandoc.Options (HTMLMathMethod (..), WriterOptions (..), def) import Text.Pandoc.Shared (capitalize, isHeaderBlock, isURI, linesToPara, @@ -371,8 +370,10 @@ blockToXml (DefinitionList defs) = needsBreak (Para _) = False needsBreak (Plain ins) = LineBreak `notElem` ins needsBreak _ = True -blockToXml (Header _ _ _) = -- should never happen, see renderSections - throwError $ PandocShouldNeverHappenError "unexpected header in section text" +blockToXml h@(Header _ _ _) = do + -- should not occur after hierarchicalize, except inside lists/blockquotes + report $ BlockNotRendered h + return [] blockToXml HorizontalRule = return [ el "empty-line" () , el "p" (txt (replicate 10 '—')) diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 5ee8ab4ce..451123a6d 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -43,7 +43,7 @@ module Text.Pandoc.Writers.HTML ( writeDZSlides, writeRevealJs ) where -import Control.Monad.State +import Control.Monad.State.Strict import Data.Char (ord, toLower) import Data.Text (Text) import qualified Data.Text.Lazy as TL @@ -210,7 +210,7 @@ writeHtmlString' st opts d = do lookup "sourcefile" (writerVariables opts) report $ NoTitleElement fallback return $ resetField "pagetitle" fallback context - return $ renderTemplate' tpl $ + renderTemplate' tpl $ defField "body" (renderHtml' body) context' writeHtml' :: PandocMonad m => WriterState -> WriterOptions -> Pandoc -> m Html @@ -241,7 +241,7 @@ pandocToHtml opts (Pandoc meta blocks) = do then blocks else prepSlides slideLevel blocks toc <- if writerTableOfContents opts && slideVariant /= S5Slides - then tableOfContents opts sects + then fmap renderHtml' <$> tableOfContents opts sects else return Nothing blocks' <- liftM (mconcat . intersperse (nl opts)) $ mapM (elementToHtml slideLevel opts) sects @@ -253,7 +253,9 @@ pandocToHtml opts (Pandoc meta blocks) = do H.script ! A.src (toValue url) ! A.type_ "text/javascript" $ mempty - MathJax url -> + MathJax url + | slideVariant /= RevealJsSlides -> + -- mathjax is handled via a special plugin in revealjs H.script ! A.src (toValue url) ! A.type_ "text/javascript" $ case slideVariant of @@ -285,8 +287,16 @@ pandocToHtml opts (Pandoc meta blocks) = do (if stMath st then defField "math" (renderHtml' math) else id) $ + defField "mathjax" + (case writerHTMLMathMethod opts of + MathJax _ -> True + _ -> False) $ defField "quotes" (stQuotes st) $ - maybe id (defField "toc" . renderHtml') toc $ + -- for backwards compatibility we populate toc + -- with the contents of the toc, rather than a + -- boolean: + maybe id (defField "toc") toc $ + maybe id (defField "table-of-contents") toc $ defField "author-meta" authsMeta $ maybe id (defField "date-meta") (normalizeDate dateMeta) $ defField "pagetitle" (stringifyHTML (docTitle meta)) $ @@ -597,7 +607,8 @@ blockToHtml opts (Para lst) contents <- inlineListToHtml opts lst return $ H.p contents where - isEmptyRaw [RawInline f _] = f /= (Format "html") + isEmptyRaw [RawInline f _] = f `notElem` [Format "html", + Format "html4", Format "html5"] isEmptyRaw _ = False blockToHtml opts (LineBlock lns) = if writerWrapText opts == WrapNone @@ -626,14 +637,17 @@ blockToHtml opts (Div attr@(ident, classes, kvs) bs) = do NoSlides -> addAttrs opts' attr $ H.div $ contents' _ -> mempty else addAttrs opts (ident, classes', kvs) $ divtag $ contents' -blockToHtml opts (RawBlock f str) - | f == Format "html" = return $ preEscapedString str - | (f == Format "latex" || f == Format "tex") && - allowsMathEnvironments (writerHTMLMathMethod opts) && - isMathEnvironment str = blockToHtml opts $ Plain [Math DisplayMath str] - | otherwise = do - report $ BlockNotRendered (RawBlock f str) - return mempty +blockToHtml opts (RawBlock f str) = do + ishtml <- isRawHtml f + if ishtml + then return $ preEscapedString str + else if (f == Format "latex" || f == Format "tex") && + allowsMathEnvironments (writerHTMLMathMethod opts) && + isMathEnvironment str + then blockToHtml opts $ Plain [Math DisplayMath str] + else do + report $ BlockNotRendered (RawBlock f str) + return mempty blockToHtml _ (HorizontalRule) = do html5 <- gets stHtml5 return $ if html5 then H5.hr else H.hr @@ -971,11 +985,13 @@ inlineToHtml opts inline = do return $ case t of InlineMath -> m DisplayMath -> brtag >> m >> brtag - (RawInline f str) - | f == Format "html" -> return $ preEscapedString str - | otherwise -> do - report $ InlineNotRendered inline - return mempty + (RawInline f str) -> do + ishtml <- isRawHtml f + if ishtml + then return $ preEscapedString str + else do + report $ InlineNotRendered inline + return mempty (Link attr txt (s,_)) | "mailto:" `isPrefixOf` s -> do linkText <- inlineListToHtml opts txt lift $ obfuscateLink opts attr linkText s @@ -1123,3 +1139,9 @@ allowsMathEnvironments (MathJax _) = True allowsMathEnvironments (MathML) = True allowsMathEnvironments (WebTeX _) = True allowsMathEnvironments _ = False + +isRawHtml :: PandocMonad m => Format -> StateT WriterState m Bool +isRawHtml f = do + html5 <- gets stHtml5 + return $ f == Format "html" || + ((html5 && f == Format "html5") || f == Format "html4") diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs index 1ad9acd40..d1146ca73 100644 --- a/src/Text/Pandoc/Writers/Haddock.hs +++ b/src/Text/Pandoc/Writers/Haddock.hs @@ -33,7 +33,7 @@ Conversion of 'Pandoc' documents to haddock markup. Haddock: <http://www.haskell.org/haddock/doc/html/> -} module Text.Pandoc.Writers.Haddock (writeHaddock) where -import Control.Monad.State +import Control.Monad.State.Strict import Data.Default import Data.Text (Text) import Data.List (intersperse, transpose) @@ -80,7 +80,7 @@ pandocToHaddock opts (Pandoc meta blocks) = do $ metadata case writerTemplate opts of Nothing -> return main - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context -- | Return haddock representation of notes. notesToHaddock :: PandocMonad m diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 2884bc532..37df58e65 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -17,7 +17,7 @@ into InDesign with File -> Place. -} module Text.Pandoc.Writers.ICML (writeICML) where import Control.Monad.Except (catchError) -import Control.Monad.State +import Control.Monad.State.Strict import Data.List (intersperse, isInfixOf, isPrefixOf, stripPrefix) import qualified Data.Set as Set import Data.Text as Text (breakOnAll, pack) @@ -147,9 +147,9 @@ writeICML opts (Pandoc meta blocks) = do $ defField "parStyles" (render' $ parStylesToDoc st) $ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st) $ metadata - return $ case writerTemplate opts of - Nothing -> main - Just tpl -> renderTemplate' tpl context + case writerTemplate opts of + Nothing -> return main + Just tpl -> renderTemplate' tpl context -- | Auxilary functions for parStylesToDoc and charStylesToDoc. contains :: String -> (String, (String, String)) -> [(String, String)] diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index 1a8d80747..012ff8416 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -128,9 +128,9 @@ docToJATS opts (Pandoc meta blocks) = do MathML -> True _ -> False) $ metadata - return $ case writerTemplate opts of - Nothing -> main - Just tpl -> renderTemplate' tpl context + case writerTemplate opts of + Nothing -> return main + Just tpl -> renderTemplate' tpl context -- | Convert an Element to JATS. elementToJATS :: PandocMonad m => WriterOptions -> Int -> Element -> DB m Doc @@ -203,8 +203,10 @@ blockToJATS opts (Div (ident,_,kvs) bs) = do [(k,v) | (k,v) <- kvs, k `elem` ["specific-use", "content-type", "orientation", "position"]] return $ inTags True "boxed-text" attr contents -blockToJATS _ (Header _ _ _) = - return empty -- should not occur after hierarchicalize +blockToJATS _ h@(Header _ _ _) = do + -- should not occur after hierarchicalize, except inside lists/blockquotes + report $ BlockNotRendered h + return empty -- No Plain, everything needs to be in a block-level tag blockToJATS opts (Plain lst) = blockToJATS opts (Para lst) -- title beginning with fig: indicates that the image is a figure diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 80606d510..55ecda819 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -35,16 +35,17 @@ module Text.Pandoc.Writers.LaTeX ( , writeBeamer ) where import Control.Applicative ((<|>)) -import Control.Monad.State +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, nub, nubBy, +import Data.List (foldl', intercalate, intersperse, isInfixOf, nubBy, stripPrefix, (\\)) import Data.Maybe (catMaybes, fromMaybe, isJust) import Data.Text (Text) import qualified Data.Text as T import Network.URI (unEscapeString) +import Text.Pandoc.BCP47 (Lang(..), toLang, getLang, renderLang) import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Definition import Text.Pandoc.Highlighting (formatLaTeXBlock, formatLaTeXInline, highlight, @@ -188,7 +189,8 @@ pandocToLaTeX options (Pandoc meta blocks) = do 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) -> @@ -198,6 +200,18 @@ pandocToLaTeX options (Pandoc meta blocks) = do ,("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 @@ -235,26 +249,24 @@ 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 + Just ("A4" :: String) -> resetField "papersize" + ("a4" :: 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 @@ -274,20 +286,16 @@ pandocToLaTeX options (Pandoc meta blocks) = do -- 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) + $ 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 - return $ case writerTemplate options of - Nothing -> main - Just tpl -> renderTemplate' tpl context' + case writerTemplate options of + Nothing -> return main + Just tpl -> renderTemplate' tpl context' -- | Convert Elements to LaTeX elementToLaTeX :: PandocMonad m => WriterOptions -> Element -> LW m Doc @@ -443,11 +451,12 @@ blockToLaTeX (Div (identifier,classes,kvs) bs) = do -> "\\leavevmode" <> linkAnchor' <> "%" _ -> linkAnchor' let align dir txt = inCmd "begin" dir $$ txt $$ inCmd "end" dir + lang <- toLang $ lookup "lang" kvs let wrapDir = case lookup "dir" kvs of Just "rtl" -> align "RTL" Just "ltr" -> align "LTR" _ -> id - wrapLang txt = case lookup "lang" kvs of + wrapLang txt = case lang of Just lng -> let (l, o) = toPolyglossiaEnv lng ops = if null o then "" @@ -647,23 +656,25 @@ 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 empty + -- avoid duplicate notes in head and firsthead: + else ($$ text "\\endhead") <$> + 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 modify $ \s -> s{ stTable = True } @@ -671,9 +682,9 @@ blockToLaTeX (Table caption aligns widths heads rows) = do braces ("@{}" <> colDescriptors <> "@{}") -- the @{} removes extra space at beginning and end $$ capt + $$ firsthead $$ (if all null heads then "\\toprule" else empty) - $$ headers - $$ endhead + $$ head' $$ vcat rows' $$ "\\bottomrule" $$ "\\end{longtable}" @@ -916,13 +927,14 @@ inlineToLaTeX :: PandocMonad m -> LW m Doc inlineToLaTeX (Span (id',classes,kvs) ils) = do 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 -> []) @@ -1237,9 +1249,9 @@ mbBraced x = if not (all isAlphaNum 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 @@ -1252,85 +1264,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" diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 0fc6afbdc..4e756c419 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -31,7 +31,7 @@ Conversion of 'Pandoc' documents to groff man page format. -} module Text.Pandoc.Writers.Man ( writeMan) where import Control.Monad.Except (throwError) -import Control.Monad.State +import Control.Monad.State.Strict import Data.List (intercalate, intersperse, stripPrefix, sort) import qualified Data.Map as Map import Data.Maybe (fromMaybe) @@ -110,7 +110,7 @@ pandocToMan opts (Pandoc meta blocks) = do $ metadata case writerTemplate opts of Nothing -> return main - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context -- | Return man representation of notes. notesToMan :: PandocMonad m => WriterOptions -> [[Block]] -> StateT WriterState m Doc diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 3ac677943..1e0d8bde2 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -35,7 +35,7 @@ Markdown: <http://daringfireball.net/projects/markdown/> -} module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where import Control.Monad.Reader -import Control.Monad.State +import Control.Monad.State.Strict import Data.Char (chr, isPunctuation, isSpace, ord) import Data.Default import qualified Data.HashMap.Strict as H @@ -209,8 +209,8 @@ pandocToMarkdown opts (Pandoc meta blocks) = do Nothing -> empty let headerBlocks = filter isHeaderBlock blocks toc <- if writerTableOfContents opts - then tableOfContents opts headerBlocks - else return empty + then render' <$> tableOfContents opts headerBlocks + else return "" -- Strip off final 'references' header if markdown citations enabled let blocks' = if isEnabled Ext_citations opts then case reverse blocks of @@ -220,7 +220,11 @@ pandocToMarkdown opts (Pandoc meta blocks) = do body <- blockListToMarkdown opts blocks' notesAndRefs' <- notesAndRefs opts let main = render' $ body <> notesAndRefs' - let context = defField "toc" (render' toc) + let context = -- for backwards compatibility we populate toc + -- with the contents of the toc, rather than a + -- boolean: + defField "toc" toc + $ defField "table-of-contents" toc $ defField "body" main $ (if isNullMeta meta then id @@ -228,7 +232,7 @@ pandocToMarkdown opts (Pandoc meta blocks) = do $ addVariablesToJSON opts metadata case writerTemplate opts of Nothing -> return main - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context -- | Return markdown representation of reference key table. refsToMarkdown :: PandocMonad m => WriterOptions -> Refs -> MD m Doc @@ -412,6 +416,9 @@ blockToMarkdown' opts (Plain inlines) = do '+':s:_ | not isPlain && isSpace s -> "\\" <> contents '*':s:_ | not isPlain && isSpace s -> "\\" <> contents '-':s:_ | not isPlain && isSpace s -> "\\" <> contents + '+':[] | not isPlain -> "\\" <> contents + '*':[] | not isPlain -> "\\" <> contents + '-':[] | not isPlain -> "\\" <> contents '|':_ | (isEnabled Ext_line_blocks opts || isEnabled Ext_pipe_tables opts) && isEnabled Ext_all_symbols_escapable opts @@ -433,8 +440,10 @@ blockToMarkdown' opts (LineBlock lns) = return $ (vcat $ map (hang 2 (text "| ")) mdLines) <> blankline else blockToMarkdown opts $ linesToPara lns blockToMarkdown' opts b@(RawBlock f str) - | f == "markdown" = return $ text str <> text "\n" - | f == "html" && isEnabled Ext_raw_html opts = do + | f `elem` ["markdown", "markdown_github", "markdown_phpextra", + "markdown_mmd", "markdown_strict"] + = return $ text str <> text "\n" + | f `elem` ["html", "html5", "html4"] && isEnabled Ext_raw_html opts = do plain <- asks envPlain return $ if plain then empty @@ -1053,10 +1062,12 @@ inlineToMarkdown opts (Math DisplayMath str) = (texMathToInlines DisplayMath str >>= inlineListToMarkdown opts) inlineToMarkdown opts il@(RawInline f str) = do plain <- asks envPlain - if not plain && - ( f == "markdown" || + if (plain && f == "plain") || (not plain && + ( f `elem` ["markdown", "markdown_github", "markdown_phpextra", + "markdown_mmd", "markdown_strict"] || (isEnabled Ext_raw_tex opts && (f == "latex" || f == "tex")) || - (isEnabled Ext_raw_html opts && f == "html") ) + (isEnabled Ext_raw_html opts && f `elem` ["html", "html4", "html5"]) + )) then return $ text str else do report $ InlineNotRendered il diff --git a/src/Text/Pandoc/Writers/Math.hs b/src/Text/Pandoc/Writers/Math.hs index 104d3c20b..58252d60f 100644 --- a/src/Text/Pandoc/Writers/Math.hs +++ b/src/Text/Pandoc/Writers/Math.hs @@ -1,6 +1,8 @@ module Text.Pandoc.Writers.Math ( texMathToInlines , convertMath + , defaultMathJaxURL + , defaultKaTeXURL ) where @@ -47,3 +49,8 @@ convertMath writer mt str = do DisplayMath -> DisplayBlock InlineMath -> DisplayInline +defaultMathJaxURL :: String +defaultMathJaxURL = "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/" + +defaultKaTeXURL :: String +defaultKaTeXURL = "https://cdnjs.cloudflare.com/ajax/libs/KaTeX/0.6.0/" diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index c70e5b786..58d1b0707 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -31,7 +31,7 @@ MediaWiki: <http://www.mediawiki.org/wiki/MediaWiki> -} module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki ) where import Control.Monad.Reader -import Control.Monad.State +import Control.Monad.State.Strict import Data.List (intercalate) import qualified Data.Set as Set import Data.Text (Text, pack) @@ -82,9 +82,8 @@ pandocToMediaWiki (Pandoc meta blocks) = do let main = body ++ notes let context = defField "body" main $ defField "toc" (writerTableOfContents opts) metadata - return $ pack - $ case writerTemplate opts of - Nothing -> main + pack <$> case writerTemplate opts of + Nothing -> return main Just tpl -> renderTemplate' tpl context -- | Escape special characters for MediaWiki. diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs index c5c3d9f5b..493da1545 100644 --- a/src/Text/Pandoc/Writers/Ms.hs +++ b/src/Text/Pandoc/Writers/Ms.hs @@ -52,7 +52,7 @@ import Text.Pandoc.Pretty import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.ImageSize import Text.Pandoc.Logging -import Control.Monad.State +import Control.Monad.State.Strict import Data.Char ( isLower, isUpper, toUpper ) import Text.TeXMath (writeEqn) import System.FilePath (takeExtension) @@ -125,7 +125,7 @@ pandocToMs opts (Pandoc meta blocks) = do $ metadata case writerTemplate opts of Nothing -> return main - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context -- | Association list of characters to escape. msEscapes :: Map.Map Char String @@ -411,7 +411,8 @@ definitionListItemToMs opts (label, defs) = do let (first, rest) = case blocks of ((Para x):y) -> (Plain x,y) (x:y) -> (x,y) - [] -> error "blocks is null" + [] -> (Plain [], []) + -- should not happen rest' <- liftM vcat $ mapM (\item -> blockToMs opts item) rest first' <- blockToMs opts first diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs index 85e0b5467..0383d9d86 100644 --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -42,7 +42,7 @@ However, @\<literal style="html">@ tag is used for HTML raw blocks even though it is supported only in Emacs Muse. -} module Text.Pandoc.Writers.Muse (writeMuse) where -import Control.Monad.State +import Control.Monad.State.Strict import Data.Text (Text) import Data.List (intersperse, transpose, isInfixOf) import System.FilePath (takeExtension) @@ -97,11 +97,17 @@ pandocToMuse (Pandoc meta blocks) = do body <- blockListToMuse blocks notes <- liftM (reverse . stNotes) get >>= notesToMuse let main = render colwidth $ body $+$ notes - let context = defField "body" main - $ metadata + let context = defField "body" main metadata case writerTemplate opts of Nothing -> return main - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context + +-- | Convert list of Pandoc block elements to Muse +-- | without setting stTopLevel. +flatBlockListToMuse :: PandocMonad m + => [Block] -- ^ List of block elements + -> StateT WriterState m Doc +flatBlockListToMuse blocks = cat <$> mapM blockToMuse blocks -- | Convert list of Pandoc block elements to Muse. blockListToMuse :: PandocMonad m @@ -112,11 +118,11 @@ blockListToMuse blocks = do modify $ \s -> s { stTopLevel = not $ stInsideBlock s , stInsideBlock = True } - contents <- mapM blockToMuse blocks + result <- flatBlockListToMuse blocks modify $ \s -> s { stTopLevel = stTopLevel oldState , stInsideBlock = stInsideBlock oldState } - return $ cat contents + return result -- | Convert Pandoc block element to Muse. blockToMuse :: PandocMonad m @@ -129,23 +135,23 @@ blockToMuse (Para inlines) = do blockToMuse (LineBlock lns) = do let splitStanza [] = [] splitStanza xs = case break (== mempty) xs of - (l, []) -> l : [] + (l, []) -> [l] (l, _:r) -> l : splitStanza r let joinWithLinefeeds = nowrap . mconcat . intersperse cr let joinWithBlankLines = mconcat . intersperse blankline let prettyfyStanza ls = joinWithLinefeeds <$> mapM inlineListToMuse ls contents <- joinWithBlankLines <$> mapM prettyfyStanza (splitStanza lns) return $ blankline $$ "<verse>" $$ contents $$ "</verse>" <> blankline -blockToMuse (CodeBlock (_,_,_) str) = do +blockToMuse (CodeBlock (_,_,_) str) = return $ "<example>" $$ text str $$ "</example>" $$ blankline blockToMuse (RawBlock (Format format) str) = return $ blankline $$ "<literal style=\"" <> text format <> "\">" $$ text str $$ "</literal>" $$ blankline blockToMuse (BlockQuote blocks) = do - contents <- blockListToMuse blocks + contents <- flatBlockListToMuse blocks return $ blankline <> "<quote>" - $$ flush contents -- flush to drop blanklines + $$ nest 0 contents -- nest 0 to remove trailing blank lines $$ "</quote>" <> blankline blockToMuse (OrderedList (start, style, _) items) = do @@ -154,11 +160,10 @@ blockToMuse (OrderedList (start, style, _) items) = do let maxMarkerLength = maximum $ map length markers let markers' = map (\m -> let s = maxMarkerLength - length m in m ++ replicate s ' ') markers - contents <- mapM (\(item, num) -> orderedListItemToMuse item num) $ - zip markers' items + contents <- zipWithM orderedListItemToMuse markers' items -- ensure that sublists have preceding blank line topLevel <- gets stTopLevel - return $ cr $$ ((if topLevel then nest 1 else id) $ vcat contents) $$ blankline + return $ cr $$ (if topLevel then nest 1 else id) (vcat contents) $$ blankline where orderedListItemToMuse :: PandocMonad m => String -- ^ marker for list item -> [Block] -- ^ list item (list of blocks) @@ -170,7 +175,7 @@ blockToMuse (BulletList items) = do contents <- mapM bulletListItemToMuse items -- ensure that sublists have preceding blank line topLevel <- gets stTopLevel - return $ cr $$ ((if topLevel then nest 1 else id) $ vcat contents) $$ blankline + return $ cr $$ (if topLevel then nest 1 else id) (vcat contents) $$ blankline where bulletListItemToMuse :: PandocMonad m => [Block] -> StateT WriterState m Doc @@ -179,7 +184,7 @@ blockToMuse (BulletList items) = do return $ hang 2 "- " contents blockToMuse (DefinitionList items) = do contents <- mapM definitionListItemToMuse items - return $ cr $$ (nest 1 $ vcat $ contents) $$ blankline + return $ cr $$ nest 1 (vcat contents) $$ blankline where definitionListItemToMuse :: PandocMonad m => ([Inline], [[Block]]) -> StateT WriterState m Doc @@ -218,8 +223,8 @@ blockToMuse (Table caption _ _ headers rows) = do -- FIXME: Muse doesn't allow blocks with height more than 1. let hpipeBlocks sep blocks = hcat $ intersperse sep' blocks where h = maximum (1 : map height blocks) - sep' = lblock (length sep) $ vcat (map text $ replicate h sep) - let makeRow sep = (" " <>) . (hpipeBlocks sep . zipWith lblock widthsInChars) + sep' = lblock (length sep) $ vcat (replicate h (text sep)) + let makeRow sep = (" " <>) . hpipeBlocks sep . zipWith lblock widthsInChars let head' = makeRow " || " headers' let rowSeparator = if noHeaders then " | " else " | " rows'' <- mapM (\row -> do cols <- mapM blockListToMuse row @@ -236,9 +241,7 @@ blockToMuse Null = return empty notesToMuse :: PandocMonad m => Notes -> StateT WriterState m Doc -notesToMuse notes = - mapM (\(num, note) -> noteToMuse num note) (zip [1..] notes) >>= - return . vsep +notesToMuse notes = liftM vsep (zipWithM noteToMuse [1 ..] notes) -- | Return Muse representation of a note. noteToMuse :: PandocMonad m @@ -268,7 +271,7 @@ conditionalEscapeString s inlineListToMuse :: PandocMonad m => [Inline] -> StateT WriterState m Doc -inlineListToMuse lst = mapM inlineToMuse lst >>= return . hcat +inlineListToMuse lst = liftM hcat (mapM inlineToMuse lst) -- | Convert Pandoc inline element to Muse. inlineToMuse :: PandocMonad m @@ -316,7 +319,7 @@ inlineToMuse Space = return space inlineToMuse SoftBreak = do wrapText <- gets $ writerWrapText . stOptions return $ if wrapText == WrapPreserve then cr else space -inlineToMuse (Link _ txt (src, _)) = do +inlineToMuse (Link _ txt (src, _)) = case txt of [Str x] | escapeURI x == src -> return $ "[[" <> text (escapeLink x) <> "]]" @@ -340,7 +343,7 @@ inlineToMuse (Note contents) = do -- add to notes in state notes <- gets stNotes modify $ \st -> st { stNotes = contents:notes } - let ref = show $ (length notes) + 1 + let ref = show $ length notes + 1 return $ "[" <> text ref <> "]" inlineToMuse (Span (_,name:_,_) inlines) = do contents <- inlineListToMuse inlines diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 1da051380..785891a9f 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -31,8 +31,9 @@ Conversion of 'Pandoc' documents to ODT. module Text.Pandoc.Writers.ODT ( writeODT ) where import Codec.Archive.Zip import Control.Monad.Except (catchError) -import Control.Monad.State +import Control.Monad.State.Strict import qualified Data.ByteString.Lazy as B +import Data.Generics (everywhere', mkT) import Data.List (isPrefixOf) import Data.Maybe (fromMaybe) import qualified Data.Text.Lazy as TL @@ -46,13 +47,14 @@ import Text.Pandoc.MIME (extensionFromMimeType, getMimeType) import Text.Pandoc.Options (WrapOption (..), WriterOptions (..)) import Text.Pandoc.Pretty import Text.Pandoc.Shared (stringify) -import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy) +import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy, toStringLazy) import Text.Pandoc.Walk import Text.Pandoc.Writers.OpenDocument (writeOpenDocument) import Text.Pandoc.Writers.Shared (fixDisplayMath) +import Text.Pandoc.BCP47 (getLang, toLang, Lang(..), renderLang) import Text.Pandoc.XML import Text.TeXMath -import Text.XML.Light.Output +import Text.XML.Light data ODTState = ODTState { stEntries :: [Entry] } @@ -78,6 +80,7 @@ pandocToODT :: PandocMonad m pandocToODT opts doc@(Pandoc meta _) = do let datadir = writerUserDataDir opts let title = docTitle meta + lang <- toLang (getLang opts meta) refArchive <- case writerReferenceDoc opts of Just f -> liftM toArchive $ lift $ P.readFileLazy f @@ -132,18 +135,49 @@ pandocToODT opts doc@(Pandoc meta _) = do ,("xmlns:ooo","http://openoffice.org/2004/office") ,("xmlns:grddl","http://www.w3.org/2003/g/data-view#") ,("office:version","1.2")] - $ ( inTagsSimple "office:meta" - $ ( inTagsSimple "dc:title" (text $ escapeStringForXML (stringify title)) - ) + $ ( inTagsSimple "office:meta" $ + ( inTagsSimple "dc:title" + (text $ escapeStringForXML (stringify title)) + $$ + case lang of + Just l -> inTagsSimple "dc:language" + (text (escapeStringForXML (renderLang l))) + Nothing -> empty + ) ) ) -- make sure mimetype is first let mimetypeEntry = toEntry "mimetype" epochtime $ fromStringLazy "application/vnd.oasis.opendocument.text" - let archive'' = addEntryToArchive mimetypeEntry + archive'' <- updateStyleWithLang lang + $ addEntryToArchive mimetypeEntry $ addEntryToArchive metaEntry archive' return $ fromArchive archive'' +updateStyleWithLang :: PandocMonad m => Maybe Lang -> Archive -> O m Archive +updateStyleWithLang Nothing arch = return arch +updateStyleWithLang (Just lang) arch = do + epochtime <- floor `fmap` (lift P.getPOSIXTime) + return arch{ zEntries = [if eRelativePath e == "styles.xml" + then case parseXMLDoc + (toStringLazy (fromEntry e)) of + Nothing -> e + Just d -> + toEntry "styles.xml" epochtime + ( fromStringLazy + . ppTopElement + . addLang lang $ d ) + else e + | e <- zEntries arch] } + +addLang :: Lang -> Element -> Element +addLang lang = everywhere' (mkT updateLangAttr) + where updateLangAttr (Attr n@(QName "language" _ (Just "fo")) _) + = Attr n (langLanguage lang) + updateLangAttr (Attr n@(QName "country" _ (Just "fo")) _) + = Attr n (langRegion lang) + updateLangAttr x = x + -- | transform both Image and Math elements transformPicMath :: PandocMonad m => WriterOptions ->Inline -> O m Inline transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = catchError diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs index 4a0a317fa..52577ac17 100644 --- a/src/Text/Pandoc/Writers/OPML.hs +++ b/src/Text/Pandoc/Writers/OPML.hs @@ -60,9 +60,9 @@ writeOPML opts (Pandoc meta blocks) = do meta' main <- (render colwidth . vcat) <$> (mapM (elementToOPML opts) elements) let context = defField "body" main metadata - return $ case writerTemplate opts of - Nothing -> main - Just tpl -> renderTemplate' tpl context + case writerTemplate opts of + Nothing -> return main + Just tpl -> renderTemplate' tpl context writeHtmlInlines :: PandocMonad m => [Inline] -> m Text diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 58295684e..ed3dabb87 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -33,7 +33,7 @@ Conversion of 'Pandoc' documents to OpenDocument XML. -} module Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) where import Control.Arrow ((***), (>>>)) -import Control.Monad.State hiding (when) +import Control.Monad.State.Strict hiding (when) import Data.Char (chr) import Data.List (sortBy) import Data.Text (Text) @@ -50,6 +50,7 @@ import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Shared import Text.Pandoc.XML +import Text.Pandoc.BCP47 (parseBCP47, Lang(..)) import Text.Printf (printf) -- | Auxiliary function to convert Plain block to Para. @@ -168,8 +169,8 @@ inTextStyle d = do inTags False "style:style" [("style:name", styleName) ,("style:family", "text")] - $ selfClosingTag "style:text-properties" - (concatMap textStyleAttr (Set.toList at))) + $ selfClosingTag "style:text-properties" + (concatMap textStyleAttr (Set.toList at))) return $ inTags False "text:span" [("text:style-name",styleName)] d @@ -219,11 +220,12 @@ writeOpenDocument opts (Pandoc meta blocks) = do let listStyles = map listStyle (stListStyles s) let automaticStyles = vcat $ reverse $ styles ++ listStyles let context = defField "body" body + $ defField "toc" (writerTableOfContents opts) $ defField "automatic-styles" (render' automaticStyles) $ metadata - return $ case writerTemplate opts of - Nothing -> body - Just tpl -> renderTemplate' tpl context + case writerTemplate opts of + Nothing -> return body + Just tpl -> renderTemplate' tpl context withParagraphStyle :: PandocMonad m => WriterOptions -> String -> [Block] -> OD m Doc @@ -326,7 +328,8 @@ blockToOpenDocument o bs then return empty else inParagraphTags =<< inlinesToOpenDocument o b | LineBlock b <- bs = blockToOpenDocument o $ linesToPara b - | Div _ xs <- bs = blocksToOpenDocument o xs + | Div attr xs <- bs = withLangFromAttr attr + (blocksToOpenDocument o xs) | Header i _ b <- bs = setFirstPara >> (inHeaderTags i =<< inlinesToOpenDocument o b) | BlockQuote b <- bs = setFirstPara >> mkBlockQuote b @@ -444,7 +447,7 @@ inlineToOpenDocument o ils | writerWrapText o == WrapPreserve -> return $ preformatted "\n" | otherwise -> return $ space - Span _ xs -> inlinesToOpenDocument o xs + Span attr xs -> withLangFromAttr attr (inlinesToOpenDocument o xs) LineBreak -> return $ selfClosingTag "text:line-break" [] Str s -> return $ handleSpaces $ escapeStringForXML s Emph l -> withTextStyle Italic $ inlinesToOpenDocument o l @@ -606,7 +609,14 @@ paraTableStyles t s (a:xs) [ ("fo:text-align", x) , ("style:justify-single-word", "false")] -data TextStyle = Italic | Bold | Strike | Sub | Sup | SmallC | Pre +data TextStyle = Italic + | Bold + | Strike + | Sub + | Sup + | SmallC + | Pre + | Language Lang deriving ( Eq,Ord ) textStyleAttr :: TextStyle -> [(String,String)] @@ -624,4 +634,18 @@ textStyleAttr s | Pre <- s = [("style:font-name" ,"Courier New") ,("style:font-name-asian" ,"Courier New") ,("style:font-name-complex" ,"Courier New")] + | Language lang <- s + = [("fo:language" ,langLanguage lang) + ,("fo:country" ,langRegion lang)] | otherwise = [] + +withLangFromAttr :: PandocMonad m => Attr -> OD m a -> OD m a +withLangFromAttr (_,_,kvs) action = + case lookup "lang" kvs of + Nothing -> action + Just l -> do + case parseBCP47 l of + Right lang -> withTextStyle (Language lang) action + Left _ -> do + report $ InvalidLang l + action diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index e8f48da00..48f17c4fb 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -35,7 +35,7 @@ Conversion of 'Pandoc' documents to Emacs Org-Mode. Org-Mode: <http://orgmode.org> -} module Text.Pandoc.Writers.Org (writeOrg) where -import Control.Monad.State +import Control.Monad.State.Strict import Data.Char (isAlphaNum, toLower) import Data.Text (Text) import Data.List (intersect, intersperse, isPrefixOf, partition, transpose) @@ -86,7 +86,7 @@ pandocToOrg (Pandoc meta blocks) = do $ metadata case writerTemplate opts of Nothing -> return main - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context -- | Return Org representation of notes. notesToOrg :: PandocMonad m => [[Block]] -> Org m Doc diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 59f6553e2..019c8335d 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -31,7 +31,7 @@ Conversion of 'Pandoc' documents to reStructuredText. reStructuredText: <http://docutils.sourceforge.net/rst.html> -} module Text.Pandoc.Writers.RST ( writeRST ) where -import Control.Monad.State +import Control.Monad.State.Strict import Data.Char (isSpace, toLower) import Data.List (isPrefixOf, stripPrefix) import Data.Maybe (fromMaybe) @@ -108,7 +108,7 @@ pandocToRST (Pandoc meta blocks) = do $ metadata case writerTemplate opts of Nothing -> return main - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context where normalizeHeadings lev (Header l a i:bs) = Header lev a i:normalizeHeadings (lev+1) cont ++ normalizeHeadings lev bs' diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 5c990f324..48d31c7bf 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -122,13 +122,18 @@ writeRTF options doc = do let context = defField "body" body $ defField "spacer" spacer $ (if writerTableOfContents options - then defField "toc" toc + then defField "table-of-contents" toc + -- for backwards compatibility, + -- we populate toc with the contents + -- of the toc rather than a boolean: + . defField "toc" toc else id) $ metadata - return $ T.pack - $ case writerTemplate options of + T.pack <$> + case writerTemplate options of Just tpl -> renderTemplate' tpl context - Nothing -> case reverse body of + Nothing -> return $ + case reverse body of ('\n':_) -> body _ -> body ++ "\n" diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs index 27d26c7d9..26070966e 100644 --- a/src/Text/Pandoc/Writers/TEI.hs +++ b/src/Text/Pandoc/Writers/TEI.hs @@ -85,7 +85,7 @@ writeTEI opts (Pandoc meta blocks) = do $ metadata case writerTemplate opts of Nothing -> return main - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context -- | Convert an Element to TEI. elementToTEI :: PandocMonad m => WriterOptions -> Int -> Element -> m Doc @@ -159,11 +159,13 @@ blockToTEI opts (Div (ident,_,_) [Para lst]) = do let attribs = [("id", ident) | not (null ident)] inTags False "p" attribs <$> inlinesToTEI opts lst blockToTEI opts (Div _ bs) = blocksToTEI opts $ map plainToPara bs -blockToTEI _ (Header _ _ _) = return empty --- should not occur after hierarchicalize +blockToTEI _ h@(Header _ _ _) = do + -- should not occur after hierarchicalize, except inside lists/blockquotes + report $ BlockNotRendered h + return empty -- For TEI simple, text must be within containing block element, so --- we use plainToPara to ensure that Plain text ends up contained by --- something. +-- we use treat as Para to ensure that Plain text ends up contained by +-- something: blockToTEI opts (Plain lst) = blockToTEI opts $ Para lst -- title beginning with fig: indicates that the image is a figure --blockToTEI opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) = diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 387e55290..549d4f3d9 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -32,7 +32,7 @@ Conversion of 'Pandoc' format into Texinfo. -} module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where import Control.Monad.Except (throwError) -import Control.Monad.State +import Control.Monad.State.Strict import Data.Char (chr, ord) import Data.List (maximumBy, transpose) import Data.Ord (comparing) @@ -106,7 +106,7 @@ pandocToTexinfo options (Pandoc meta blocks) = do $ metadata case writerTemplate options of Nothing -> return body - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context -- | Escape things as needed for Texinfo. stringToTexinfo :: String -> String diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 091a5baca..acc9eaa0f 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -30,7 +30,7 @@ Conversion of 'Pandoc' documents to Textile markup. Textile: <http://thresholdstate.com/articles/4312/the-textile-reference-manual> -} module Text.Pandoc.Writers.Textile ( writeTextile ) where -import Control.Monad.State +import Control.Monad.State.Strict import Data.Char (isSpace) import Data.List (intercalate) import Data.Text (Text, pack) @@ -75,7 +75,7 @@ pandocToTextile opts (Pandoc meta blocks) = do let context = defField "body" main metadata case writerTemplate opts of Nothing -> return main - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context withUseTags :: PandocMonad m => TW m a -> TW m a withUseTags action = do diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs index 5ee239e59..ced02d4be 100644 --- a/src/Text/Pandoc/Writers/ZimWiki.hs +++ b/src/Text/Pandoc/Writers/ZimWiki.hs @@ -33,7 +33,7 @@ http://zim-wiki.org/manual/Help/Wiki_Syntax.html module Text.Pandoc.Writers.ZimWiki ( writeZimWiki ) where import Control.Monad (zipWithM) -import Control.Monad.State (StateT, evalStateT, gets, modify) +import Control.Monad.State.Strict (StateT, evalStateT, gets, modify) import Data.Default (Default (..)) import Data.List (intercalate, isInfixOf, isPrefixOf, transpose) import qualified Data.Map as Map @@ -78,7 +78,7 @@ pandocToZimWiki opts (Pandoc meta blocks) = do $ defField "toc" (writerTableOfContents opts) $ metadata case writerTemplate opts of - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context Nothing -> return main -- | Escape special characters for ZimWiki. |