diff options
Diffstat (limited to 'src/Text/Pandoc/Writers')
30 files changed, 1074 insertions, 540 deletions
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index 036185282..ffe5b7473 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -44,7 +44,7 @@ import Data.Aeson (Result (..), Value (String), fromJSON, toJSON) import Data.Char (isPunctuation, isSpace) import Data.List (intercalate, intersperse, stripPrefix) import qualified Data.Map as M -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (fromMaybe, isJust, listToMaybe) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T @@ -126,11 +126,16 @@ olMarker = do (start, style', delim) <- anyOrderedListMarker else spaceChar -- | True if string begins with an ordered list marker -beginsWithOrderedListMarker :: String -> Bool -beginsWithOrderedListMarker str = - case runParser olMarker defaultParserState "para start" (take 10 str) of - Left _ -> False - Right _ -> True +-- or would be interpreted as an AsciiDoc option command +needsEscaping :: String -> Bool +needsEscaping s = beginsWithOrderedListMarker s || isBracketed s + where + beginsWithOrderedListMarker str = + case runParser olMarker defaultParserState "para start" (take 10 str) of + Left _ -> False + Right _ -> True + isBracketed ('[':cs) = listToMaybe (reverse cs) == Just ']' + isBracketed _ = False -- | Convert Pandoc block element to asciidoc. blockToAsciiDoc :: PandocMonad m @@ -146,8 +151,8 @@ blockToAsciiDoc opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = blockToAsciiDoc opts (Para inlines) = do contents <- inlineListToAsciiDoc opts inlines -- escape if para starts with ordered list marker - let esc = if beginsWithOrderedListMarker (render Nothing contents) - then text "\\" + let esc = if needsEscaping (render Nothing contents) + then text "{empty}" else empty return $ esc <> contents <> blankline blockToAsciiDoc opts (LineBlock lns) = do @@ -280,7 +285,7 @@ blockToAsciiDoc opts (DefinitionList items) = do contents <- mapM (definitionListItemToAsciiDoc opts) items return $ cat contents <> blankline blockToAsciiDoc opts (Div (ident,_,_) bs) = do - let identifier = if null ident then empty else ("[[" <> text ident <> "]]") + let identifier = if null ident then empty else "[[" <> text ident <> "]]" contents <- blockListToAsciiDoc opts bs return $ identifier $$ contents @@ -487,6 +492,6 @@ inlineToAsciiDoc opts (Note [Plain inlines]) = do -- asciidoc can't handle blank lines in notes inlineToAsciiDoc _ (Note _) = return "[multiblock footnote omitted]" inlineToAsciiDoc opts (Span (ident,_,_) ils) = do - let identifier = if null ident then empty else ("[[" <> text ident <> "]]") + let identifier = if null ident then empty else "[[" <> text ident <> "]]" contents <- inlineListToAsciiDoc opts ils return $ identifier <> contents diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs index 98c1101fa..84ea37f38 100644 --- a/src/Text/Pandoc/Writers/CommonMark.hs +++ b/src/Text/Pandoc/Writers/CommonMark.hs @@ -45,7 +45,7 @@ import Network.HTTP (urlEncode) import Text.Pandoc.Class (PandocMonad) import Text.Pandoc.Definition import Text.Pandoc.Options -import Text.Pandoc.Shared (isTightList, linesToPara, substitute) +import Text.Pandoc.Shared (isTightList, linesToPara, substitute, capitalize) import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Walk (query, walk, walkM) import Text.Pandoc.Writers.HTML (writeHtml5String, tagWithAttributes) @@ -253,18 +253,34 @@ inlineToNodes opts (Strong xs) = (node STRONG (inlinesToNodes opts xs) :) inlineToNodes opts (Strikeout xs) = if isEnabled Ext_strikeout opts then (node (CUSTOM_INLINE "~~" "~~") (inlinesToNodes opts xs) :) - else ((node (HTML_INLINE (T.pack "<s>")) [] : inlinesToNodes opts xs ++ - [node (HTML_INLINE (T.pack "</s>")) []]) ++ ) + else if isEnabled Ext_raw_html opts + then ((node (HTML_INLINE (T.pack "<s>")) [] : inlinesToNodes opts xs ++ + [node (HTML_INLINE (T.pack "</s>")) []]) ++ ) + else (inlinesToNodes opts xs ++) inlineToNodes opts (Superscript xs) = - ((node (HTML_INLINE (T.pack "<sup>")) [] : inlinesToNodes opts xs ++ - [node (HTML_INLINE (T.pack "</sup>")) []]) ++ ) + if isEnabled Ext_raw_html opts + then ((node (HTML_INLINE (T.pack "<sup>")) [] : inlinesToNodes opts xs ++ + [node (HTML_INLINE (T.pack "</sup>")) []]) ++ ) + else case traverse toSuperscriptInline xs of + Nothing -> + ((node (TEXT (T.pack "^(")) [] : inlinesToNodes opts xs ++ + [node (TEXT (T.pack ")")) []]) ++ ) + Just xs' -> (inlinesToNodes opts xs' ++) inlineToNodes opts (Subscript xs) = - ((node (HTML_INLINE (T.pack "<sub>")) [] : inlinesToNodes opts xs ++ - [node (HTML_INLINE (T.pack "</sub>")) []]) ++ ) + if isEnabled Ext_raw_html opts + then ((node (HTML_INLINE (T.pack "<sub>")) [] : inlinesToNodes opts xs ++ + [node (HTML_INLINE (T.pack "</sub>")) []]) ++ ) + else case traverse toSubscriptInline xs of + Nothing -> + ((node (TEXT (T.pack "_(")) [] : inlinesToNodes opts xs ++ + [node (TEXT (T.pack ")")) []]) ++ ) + Just xs' -> (inlinesToNodes opts xs' ++) inlineToNodes opts (SmallCaps xs) = - ((node (HTML_INLINE (T.pack "<span class=\"smallcaps\">")) [] - : inlinesToNodes opts xs ++ - [node (HTML_INLINE (T.pack "</span>")) []]) ++ ) + if isEnabled Ext_raw_html opts + then ((node (HTML_INLINE (T.pack "<span class=\"smallcaps\">")) [] + : inlinesToNodes opts xs ++ + [node (HTML_INLINE (T.pack "</span>")) []]) ++ ) + else (inlinesToNodes opts (capitalize xs) ++) inlineToNodes opts (Link _ ils (url,tit)) = (node (LINK (T.pack url) (T.pack tit)) (inlinesToNodes opts ils) :) -- title beginning with fig: indicates implicit figure @@ -304,6 +320,11 @@ inlineToNodes opts (Math mt str) = (node (HTML_INLINE (T.pack ("\\(" ++ str ++ "\\)"))) [] :) DisplayMath -> (node (HTML_INLINE (T.pack ("\\[" ++ str ++ "\\]"))) [] :) +inlineToNodes opts (Span ("",["emoji"],kvs) [Str s]) = do + case lookup "data-emoji" kvs of + Just emojiname | isEnabled Ext_emoji opts -> + (node (TEXT (":" <> T.pack emojiname <> ":")) [] :) + _ -> (node (TEXT (T.pack s)) [] :) inlineToNodes opts (Span attr ils) = let nodes = inlinesToNodes opts ils op = tagWithAttributes opts True False "span" attr @@ -314,3 +335,19 @@ inlineToNodes opts (Span attr ils) = inlineToNodes opts (Cite _ ils) = (inlinesToNodes opts ils ++) inlineToNodes _ (Note _) = id -- should not occur -- we remove Note elements in preprocessing + +toSubscriptInline :: Inline -> Maybe Inline +toSubscriptInline Space = Just Space +toSubscriptInline (Span attr ils) = Span attr <$> traverse toSubscriptInline ils +toSubscriptInline (Str s) = Str <$> traverse toSubscript s +toSubscriptInline LineBreak = Just LineBreak +toSubscriptInline SoftBreak = Just SoftBreak +toSubscriptInline _ = Nothing + +toSuperscriptInline :: Inline -> Maybe Inline +toSuperscriptInline Space = Just Space +toSuperscriptInline (Span attr ils) = Span attr <$> traverse toSuperscriptInline ils +toSuperscriptInline (Str s) = Str <$> traverse toSuperscript s +toSuperscriptInline LineBreak = Just LineBreak +toSuperscriptInline SoftBreak = Just SoftBreak +toSuperscriptInline _ = Nothing diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 10e996bdb..1f9760442 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -190,10 +190,9 @@ blockToConTeXt (BlockQuote lst) = do blockToConTeXt (CodeBlock _ str) = return $ flush ("\\starttyping" <> cr <> text str <> cr <> "\\stoptyping") $$ blankline -- blankline because \stoptyping can't have anything after it, inc. '}' -blockToConTeXt (RawBlock "context" str) = return $ text str <> blankline -blockToConTeXt b@(RawBlock _ _ ) = do - report $ BlockNotRendered b - return empty +blockToConTeXt b@(RawBlock f str) + | f == Format "context" || f == Format "tex" = return $ text str <> blankline + | otherwise = empty <$ report (BlockNotRendered b) blockToConTeXt (Div (ident,_,kvs) bs) = do let align dir txt = "\\startalignment[" <> dir <> "]" $$ txt $$ "\\stopalignment" mblang <- fromBCP47 (lookup "lang" kvs) @@ -330,8 +329,7 @@ alignToConTeXt align = case align of AlignDefault -> empty listItemToConTeXt :: PandocMonad m => [Block] -> WM m Doc -listItemToConTeXt list = blockListToConTeXt list >>= - return . ("\\item" $$) . nest 2 +listItemToConTeXt list = (("\\item" $$) . nest 2) <$> blockListToConTeXt list defListItemToConTeXt :: PandocMonad m => ([Inline], [[Block]]) -> WM m Doc defListItemToConTeXt (term, defs) = do @@ -401,11 +399,9 @@ inlineToConTeXt (Math InlineMath str) = return $ char '$' <> text str <> char '$' inlineToConTeXt (Math DisplayMath str) = return $ text "\\startformula " <> text str <> text " \\stopformula" <> space -inlineToConTeXt (RawInline "context" str) = return $ text str -inlineToConTeXt (RawInline "tex" str) = return $ text str -inlineToConTeXt il@(RawInline _ _) = do - report $ InlineNotRendered il - return empty +inlineToConTeXt il@(RawInline f str) + | f == Format "tex" || f == Format "context" = return $ text str + | otherwise = empty <$ report (InlineNotRendered il) inlineToConTeXt LineBreak = return $ text "\\crlf" <> cr inlineToConTeXt SoftBreak = do wrapText <- gets (writerWrapText . stOptions) @@ -457,7 +453,12 @@ inlineToConTeXt (Image attr@(_,cls,_) _ (src, _)) = do clas = if null cls then empty else brackets $ text $ toLabel $ head cls - src' = if isURI src + -- Use / for path separators on Windows; see #4918 + fixPathSeparators = map $ \c -> case c of + '\\' -> '/' + _ -> c + src' = fixPathSeparators $ + if isURI src then src else unEscapeString src return $ braces $ "\\externalfigure" <> brackets (text src') <> dims <> clas diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 53b321c7c..37fec9f0f 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2012-2018 John MacFarlane <jgm@berkeley.edu> This program is free software; you can redistribute it and/or modify @@ -35,25 +35,26 @@ import Prelude import Control.Arrow ((***)) import Control.Exception import Control.Monad (when) -import Control.Monad.Trans (MonadIO (liftIO)) import Data.Char (toLower) import Data.List (intersperse) import qualified Data.Map as M import Data.Text (Text, pack) import Data.Typeable -import Foreign.Lua (Lua, ToLuaStack (..), callFunc) -import Foreign.Lua.Api +import Foreign.Lua (Lua, Pushable) import Text.Pandoc.Class (PandocIO) import Text.Pandoc.Definition import Text.Pandoc.Error -import Text.Pandoc.Lua.Init (runPandocLua, registerScriptPath) +import Text.Pandoc.Lua.Init (LuaException (LuaException), runPandocLua, + registerScriptPath) import Text.Pandoc.Lua.StackInstances () -import Text.Pandoc.Lua.Util (addValue, dostring') +import Text.Pandoc.Lua.Util (addField, dofileWithTraceback) import Text.Pandoc.Options import Text.Pandoc.Templates import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Writers.Shared +import qualified Foreign.Lua as Lua + attrToMap :: Attr -> M.Map String String attrToMap (id',classes,keyvals) = M.fromList $ ("id", id') @@ -62,41 +63,43 @@ attrToMap (id',classes,keyvals) = M.fromList newtype Stringify a = Stringify a -instance ToLuaStack (Stringify Format) where - push (Stringify (Format f)) = push (map toLower f) +instance Pushable (Stringify Format) where + push (Stringify (Format f)) = Lua.push (map toLower f) -instance ToLuaStack (Stringify [Inline]) where - push (Stringify ils) = push =<< inlineListToCustom ils +instance Pushable (Stringify [Inline]) where + push (Stringify ils) = Lua.push =<< inlineListToCustom ils -instance ToLuaStack (Stringify [Block]) where - push (Stringify blks) = push =<< blockListToCustom blks +instance Pushable (Stringify [Block]) where + push (Stringify blks) = Lua.push =<< blockListToCustom blks -instance ToLuaStack (Stringify MetaValue) where - push (Stringify (MetaMap m)) = push (fmap Stringify m) - push (Stringify (MetaList xs)) = push (map Stringify xs) - push (Stringify (MetaBool x)) = push x - push (Stringify (MetaString s)) = push s - push (Stringify (MetaInlines ils)) = push (Stringify ils) - push (Stringify (MetaBlocks bs)) = push (Stringify bs) +instance Pushable (Stringify MetaValue) where + push (Stringify (MetaMap m)) = Lua.push (fmap Stringify m) + push (Stringify (MetaList xs)) = Lua.push (map Stringify xs) + push (Stringify (MetaBool x)) = Lua.push x + push (Stringify (MetaString s)) = Lua.push s + push (Stringify (MetaInlines ils)) = Lua.push (Stringify ils) + push (Stringify (MetaBlocks bs)) = Lua.push (Stringify bs) -instance ToLuaStack (Stringify Citation) where +instance Pushable (Stringify Citation) where push (Stringify cit) = do - createtable 6 0 - addValue "citationId" $ citationId cit - addValue "citationPrefix" . Stringify $ citationPrefix cit - addValue "citationSuffix" . Stringify $ citationSuffix cit - addValue "citationMode" $ show (citationMode cit) - addValue "citationNoteNum" $ citationNoteNum cit - addValue "citationHash" $ citationHash cit + Lua.createtable 6 0 + addField "citationId" $ citationId cit + addField "citationPrefix" . Stringify $ citationPrefix cit + addField "citationSuffix" . Stringify $ citationSuffix cit + addField "citationMode" $ show (citationMode cit) + addField "citationNoteNum" $ citationNoteNum cit + addField "citationHash" $ citationHash cit -- | Key-value pair, pushed as a table with @a@ as the only key and @v@ as the -- associated value. newtype KeyValue a b = KeyValue (a, b) -instance (ToLuaStack a, ToLuaStack b) => ToLuaStack (KeyValue a b) where +instance (Pushable a, Pushable b) => Pushable (KeyValue a b) where push (KeyValue (k, v)) = do - newtable - addValue k v + Lua.newtable + Lua.push k + Lua.push v + Lua.rawset (Lua.nthFromTop 3) data PandocLuaException = PandocLuaException String deriving (Show, Typeable) @@ -106,14 +109,13 @@ instance Exception PandocLuaException -- | Convert Pandoc to custom markup. writeCustom :: FilePath -> WriterOptions -> Pandoc -> PandocIO Text writeCustom luaFile opts doc@(Pandoc meta _) = do - luaScript <- liftIO $ UTF8.readFile luaFile res <- runPandocLua $ do registerScriptPath luaFile - stat <- dostring' luaScript + stat <- dofileWithTraceback luaFile -- check for error in lua script (later we'll change the return type -- to handle this more gracefully): - when (stat /= OK) $ - tostring 1 >>= throw . PandocLuaException . UTF8.toString + when (stat /= Lua.OK) $ + Lua.tostring' (-1) >>= throw . PandocLuaException . UTF8.toString -- TODO - call hierarchicalize, so we have that info rendered <- docToCustom opts doc context <- metaToJSON opts @@ -122,7 +124,7 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do meta return (rendered, context) let (body, context) = case res of - Left e -> throw (PandocLuaException (show e)) + Left (LuaException msg) -> throw (PandocLuaException msg) Right x -> x case writerTemplate opts of Nothing -> return $ pack body @@ -134,7 +136,7 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do docToCustom :: WriterOptions -> Pandoc -> Lua String docToCustom opts (Pandoc (Meta metamap) blocks) = do body <- blockListToCustom blocks - callFunc "Doc" body (fmap Stringify metamap) (writerVariables opts) + Lua.callFunc "Doc" body (fmap Stringify metamap) (writerVariables opts) -- | Convert Pandoc block element to Custom. blockToCustom :: Block -- ^ Block element @@ -142,52 +144,55 @@ blockToCustom :: Block -- ^ Block element blockToCustom Null = return "" -blockToCustom (Plain inlines) = callFunc "Plain" (Stringify inlines) +blockToCustom (Plain inlines) = Lua.callFunc "Plain" (Stringify inlines) blockToCustom (Para [Image attr txt (src,tit)]) = - callFunc "CaptionedImage" src tit (Stringify txt) (attrToMap attr) + Lua.callFunc "CaptionedImage" src tit (Stringify txt) (attrToMap attr) -blockToCustom (Para inlines) = callFunc "Para" (Stringify inlines) +blockToCustom (Para inlines) = Lua.callFunc "Para" (Stringify inlines) -blockToCustom (LineBlock linesList) = callFunc "LineBlock" (map Stringify linesList) +blockToCustom (LineBlock linesList) = + Lua.callFunc "LineBlock" (map Stringify linesList) blockToCustom (RawBlock format str) = - callFunc "RawBlock" (Stringify format) str + Lua.callFunc "RawBlock" (Stringify format) str -blockToCustom HorizontalRule = callFunc "HorizontalRule" +blockToCustom HorizontalRule = Lua.callFunc "HorizontalRule" blockToCustom (Header level attr inlines) = - callFunc "Header" level (Stringify inlines) (attrToMap attr) + Lua.callFunc "Header" level (Stringify inlines) (attrToMap attr) blockToCustom (CodeBlock attr str) = - callFunc "CodeBlock" str (attrToMap attr) + Lua.callFunc "CodeBlock" str (attrToMap attr) -blockToCustom (BlockQuote blocks) = callFunc "BlockQuote" (Stringify blocks) +blockToCustom (BlockQuote blocks) = + Lua.callFunc "BlockQuote" (Stringify blocks) blockToCustom (Table capt aligns widths headers rows) = let aligns' = map show aligns capt' = Stringify capt headers' = map Stringify headers rows' = map (map Stringify) rows - in callFunc "Table" capt' aligns' widths headers' rows' + in Lua.callFunc "Table" capt' aligns' widths headers' rows' -blockToCustom (BulletList items) = callFunc "BulletList" (map Stringify items) +blockToCustom (BulletList items) = + Lua.callFunc "BulletList" (map Stringify items) blockToCustom (OrderedList (num,sty,delim) items) = - callFunc "OrderedList" (map Stringify items) num (show sty) (show delim) + Lua.callFunc "OrderedList" (map Stringify items) num (show sty) (show delim) blockToCustom (DefinitionList items) = - callFunc "DefinitionList" - (map (KeyValue . (Stringify *** map Stringify)) items) + Lua.callFunc "DefinitionList" + (map (KeyValue . (Stringify *** map Stringify)) items) blockToCustom (Div attr items) = - callFunc "Div" (Stringify items) (attrToMap attr) + Lua.callFunc "Div" (Stringify items) (attrToMap attr) -- | Convert list of Pandoc block elements to Custom. blockListToCustom :: [Block] -- ^ List of block elements -> Lua String blockListToCustom xs = do - blocksep <- callFunc "Blocksep" + blocksep <- Lua.callFunc "Blocksep" bs <- mapM blockToCustom xs return $ mconcat $ intersperse blocksep bs @@ -200,51 +205,51 @@ inlineListToCustom lst = do -- | Convert Pandoc inline element to Custom. inlineToCustom :: Inline -> Lua String -inlineToCustom (Str str) = callFunc "Str" str +inlineToCustom (Str str) = Lua.callFunc "Str" str -inlineToCustom Space = callFunc "Space" +inlineToCustom Space = Lua.callFunc "Space" -inlineToCustom SoftBreak = callFunc "SoftBreak" +inlineToCustom SoftBreak = Lua.callFunc "SoftBreak" -inlineToCustom (Emph lst) = callFunc "Emph" (Stringify lst) +inlineToCustom (Emph lst) = Lua.callFunc "Emph" (Stringify lst) -inlineToCustom (Strong lst) = callFunc "Strong" (Stringify lst) +inlineToCustom (Strong lst) = Lua.callFunc "Strong" (Stringify lst) -inlineToCustom (Strikeout lst) = callFunc "Strikeout" (Stringify lst) +inlineToCustom (Strikeout lst) = Lua.callFunc "Strikeout" (Stringify lst) -inlineToCustom (Superscript lst) = callFunc "Superscript" (Stringify lst) +inlineToCustom (Superscript lst) = Lua.callFunc "Superscript" (Stringify lst) -inlineToCustom (Subscript lst) = callFunc "Subscript" (Stringify lst) +inlineToCustom (Subscript lst) = Lua.callFunc "Subscript" (Stringify lst) -inlineToCustom (SmallCaps lst) = callFunc "SmallCaps" (Stringify lst) +inlineToCustom (SmallCaps lst) = Lua.callFunc "SmallCaps" (Stringify lst) -inlineToCustom (Quoted SingleQuote lst) = callFunc "SingleQuoted" (Stringify lst) +inlineToCustom (Quoted SingleQuote lst) = Lua.callFunc "SingleQuoted" (Stringify lst) -inlineToCustom (Quoted DoubleQuote lst) = callFunc "DoubleQuoted" (Stringify lst) +inlineToCustom (Quoted DoubleQuote lst) = Lua.callFunc "DoubleQuoted" (Stringify lst) -inlineToCustom (Cite cs lst) = callFunc "Cite" (Stringify lst) (map Stringify cs) +inlineToCustom (Cite cs lst) = Lua.callFunc "Cite" (Stringify lst) (map Stringify cs) inlineToCustom (Code attr str) = - callFunc "Code" str (attrToMap attr) + Lua.callFunc "Code" str (attrToMap attr) inlineToCustom (Math DisplayMath str) = - callFunc "DisplayMath" str + Lua.callFunc "DisplayMath" str inlineToCustom (Math InlineMath str) = - callFunc "InlineMath" str + Lua.callFunc "InlineMath" str inlineToCustom (RawInline format str) = - callFunc "RawInline" (Stringify format) str + Lua.callFunc "RawInline" (Stringify format) str -inlineToCustom LineBreak = callFunc "LineBreak" +inlineToCustom LineBreak = Lua.callFunc "LineBreak" inlineToCustom (Link attr txt (src,tit)) = - callFunc "Link" (Stringify txt) src tit (attrToMap attr) + Lua.callFunc "Link" (Stringify txt) src tit (attrToMap attr) inlineToCustom (Image attr alt (src,tit)) = - callFunc "Image" (Stringify alt) src tit (attrToMap attr) + Lua.callFunc "Image" (Stringify alt) src tit (attrToMap attr) -inlineToCustom (Note contents) = callFunc "Note" (Stringify contents) +inlineToCustom (Note contents) = Lua.callFunc "Note" (Stringify contents) inlineToCustom (Span attr items) = - callFunc "Span" (Stringify items) (attrToMap attr) + Lua.callFunc "Span" (Stringify items) (attrToMap attr) diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index f6e814095..3306e4f31 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -126,9 +126,10 @@ writeDocbook opts (Pandoc meta blocks) = do defField "mathml" (case writerHTMLMathMethod opts of MathML -> True _ -> False) metadata - case writerTemplate opts of - Nothing -> return main - Just tpl -> renderTemplate' tpl context + (if writerPreferAscii opts then toEntities else id) <$> + 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 diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 1666c0562..524d20fd1 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -66,7 +66,7 @@ import Text.Pandoc.Readers.Docx.StyleMap import Text.Pandoc.Shared hiding (Element) import Text.Pandoc.Walk import Text.Pandoc.Writers.Math -import Text.Pandoc.Writers.Shared (fixDisplayMath, metaValueToInlines) +import Text.Pandoc.Writers.Shared import Text.Printf (printf) import Text.TeXMath import Text.XML.Light as XML @@ -230,7 +230,7 @@ writeDocx opts doc@(Pandoc meta _) = do let mbAttrMarLeft = (elAttribs <$> mbpgmar) >>= lookupAttrBy ((=="left") . qName) let mbAttrMarRight = (elAttribs <$> mbpgmar) >>= lookupAttrBy ((=="right") . qName) - -- Get the avaible area (converting the size and the margins to int and + -- Get the available area (converting the size and the margins to int and -- doing the difference let pgContentWidth = (-) <$> (read <$> mbAttrSzWidth ::Maybe Integer) <*> ( @@ -266,8 +266,9 @@ writeDocx opts doc@(Pandoc meta _) = do -- parse styledoc for heading styles let styleMaps = getStyleMaps styledoc - let tocTitle = fromMaybe (stTocTitle defaultWriterState) $ - metaValueToInlines <$> lookupMeta "toc-title" meta + let tocTitle = case lookupMetaInlines "toc-title" meta of + [] -> stTocTitle defaultWriterState + ls -> ls let initialSt = defaultWriterState { stStyleMaps = styleMaps @@ -727,7 +728,7 @@ getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists makeTOC :: (PandocMonad m) => WriterOptions -> WS m [Element] -makeTOC opts | writerTableOfContents opts = do +makeTOC opts = do let depth = "1-"++show (writerTOCDepth opts) let tocCmd = "TOC \\o \""++depth++"\" \\h \\z \\u" tocTitle <- gets stTocTitle @@ -751,8 +752,6 @@ makeTOC opts | writerTableOfContents opts = do ) -- w:p ]) ])] -- w:sdt -makeTOC _ = return [] - -- | Convert Pandoc document to two lists of -- OpenXML elements (the main document and footnotes). @@ -761,15 +760,9 @@ writeOpenXML opts (Pandoc meta blocks) = do let tit = docTitle meta let auths = docAuthors meta let dat = docDate meta - let abstract' = case lookupMeta "abstract" meta of - Just (MetaBlocks bs) -> bs - Just (MetaInlines ils) -> [Plain ils] - _ -> [] - let subtitle' = case lookupMeta "subtitle" meta of - Just (MetaBlocks [Plain xs]) -> xs - Just (MetaBlocks [Para xs]) -> xs - Just (MetaInlines xs) -> xs - _ -> [] + let abstract' = lookupMetaBlocks "abstract" meta + let subtitle' = lookupMetaInlines "subtitle" meta + let includeTOC = writerTableOfContents opts || lookupMetaBool "toc" meta title <- withParaPropM (pStyleM "Title") $ blocksToOpenXML opts [Para tit | not (null tit)] subtitle <- withParaPropM (pStyleM "Subtitle") $ blocksToOpenXML opts [Para subtitle' | not (null subtitle')] authors <- withParaProp (pCustomStyle "Author") $ blocksToOpenXML opts $ @@ -801,7 +794,9 @@ writeOpenXML opts (Pandoc meta blocks) = do ] ++ annotation ] comments' <- mapM toComment comments - toc <- makeTOC opts + toc <- if includeTOC + then makeTOC opts + else return [] let meta' = title ++ subtitle ++ authors ++ date ++ abstract ++ toc return (meta' ++ doc', notes', comments') @@ -908,9 +903,10 @@ blockToOpenXML' opts (Para lst) | null lst && not (isEnabled Ext_empty_paragraphs opts) = return [] | otherwise = do isFirstPara <- gets stFirstPara - paraProps <- getParaProps $ case lst of - [Math DisplayMath _] -> True - _ -> False + let displayMathPara = case lst of + [x] -> isDisplayMath x + _ -> False + paraProps <- getParaProps displayMathPara bodyTextStyle <- pStyleM "Body Text" let paraProps' = case paraProps of [] | isFirstPara -> [mknode "w:pPr" [] diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index f1ff8b482..6099f0223 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -74,6 +74,7 @@ import Text.Printf (printf) import Text.XML.Light (Attr (..), Element (..), Node (..), QName (..), add_attrs, lookupAttr, node, onlyElems, parseXML, ppElement, showElement, strContent, unode, unqual) +import Text.Pandoc.XML (escapeStringForXML) -- A Chapter includes a list of blocks and maybe a section -- number offset. Note, some chapters are unnumbered. The section @@ -446,7 +447,8 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do cpContent <- lift $ writeHtml opts'{ writerVariables = ("coverpage","true"): - ("pagetitle",plainTitle): + ("pagetitle", + escapeStringForXML plainTitle): cssvars True ++ vars } (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"../media/" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"]) imgContent <- lift $ P.readFileLazy img @@ -459,7 +461,8 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do -- title page tpContent <- lift $ writeHtml opts'{ writerVariables = ("titlepage","true"): - ("pagetitle",plainTitle): + ("body-type", "frontmatter"): + ("pagetitle", escapeStringForXML plainTitle): cssvars True ++ vars } (Pandoc meta []) tpEntry <- mkEntry "text/title_page.xhtml" tpContent @@ -563,13 +566,28 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do let chapToEntry num (Chapter mbnum bs) = mkEntry ("text/" ++ showChapter num) =<< writeHtml opts'{ writerNumberOffset = fromMaybe [] mbnum - , writerVariables = cssvars True ++ vars } - (case bs of - (Header _ _ xs : _) -> + , writerVariables = ("body-type", bodyType) : + cssvars True ++ vars } pdoc + where (pdoc, bodyType) = + case bs of + (Header _ (_,_,kvs) xs : _) -> -- remove notes or we get doubled footnotes - Pandoc (setMeta "title" (walk removeNote $ fromList xs) - nullMeta) bs - _ -> Pandoc nullMeta bs) + (Pandoc (setMeta "title" + (walk removeNote $ fromList xs) nullMeta) bs, + case lookup "epub:type" kvs of + Nothing -> "bodymatter" + Just x + | x `elem` frontMatterTypes -> "frontmatter" + | x `elem` backMatterTypes -> "backmatter" + | otherwise -> "bodymatter") + _ -> (Pandoc nullMeta bs, "bodymatter") + frontMatterTypes = ["prologue", "abstract", "acknowledgments", + "copyright-page", "dedication", + "foreword", "halftitle", + "introduction", "preface", + "seriespage", "titlepage"] + backMatterTypes = ["afterword", "appendix", "colophon", + "conclusion", "epigraph"] chapterEntries <- zipWithM chapToEntry [1..] chapters @@ -754,7 +772,8 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do (writeHtmlStringForEPUB version opts{ writerTemplate = Nothing , writerVariables = - ("pagetitle",plainTitle): + ("pagetitle", + escapeStringForXML plainTitle): writerVariables opts} (Pandoc nullMeta [Plain $ walk clean tit])) of @@ -782,7 +801,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do [ unode "a" ! [("href", "text/cover.xhtml") ,("epub:type", "cover")] $ "Cover"] | - epubCoverImage metadata /= Nothing + isJust (epubCoverImage metadata) ] ++ [ unode "li" [ unode "a" ! [("href", "#toc") diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index a46011a8f..a139de5cd 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -119,7 +119,7 @@ description meta' = do let as = authors meta' dd <- docdate meta' annotation <- case lookupMeta "abstract" meta' of - Just (MetaBlocks bs) -> (list . el "annotation") <$> cMapM blockToXml bs + Just (MetaBlocks bs) -> (list . el "annotation") <$> cMapM blockToXml (map unPlain bs) _ -> pure mempty let lang = case lookupMeta "lang" meta' of Just (MetaInlines [Str s]) -> [el "lang" $ iso639 s] @@ -135,8 +135,9 @@ description meta' = do Just (MetaString s) -> coverimage s _ -> return [] return $ el "description" - [ el "title-info" (genre : (bt ++ annotation ++ as ++ dd ++ lang)) - , el "document-info" (el "program-used" "pandoc" : coverpage) + [ el "title-info" (genre : + (as ++ bt ++ annotation ++ dd ++ coverpage ++ lang)) + , el "document-info" [el "program-used" "pandoc"] ] booktitle :: PandocMonad m => Meta -> FBM m [Content] @@ -398,6 +399,11 @@ plainToPara (Para inlines : rest) = Para inlines : HorizontalRule : plainToPara rest -- HorizontalRule will be converted to <empty-line /> plainToPara (p:rest) = p : plainToPara rest +-- Replace plain text with paragraphs +unPlain :: Block -> Block +unPlain (Plain inlines) = Para inlines +unPlain x = x + -- Simulate increased indentation level. Will not really work -- for multi-line paragraphs. indentPrefix :: String -> Block -> Block diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index a09ad2fda..46f754226 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -50,13 +50,13 @@ import Prelude import Control.Monad.State.Strict import Data.Char (ord, toLower) import Data.List (intercalate, intersperse, isPrefixOf, partition) -import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing) +import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe) import qualified Data.Set as Set import Data.String (fromString) import Data.Text (Text) import qualified Data.Text.Lazy as TL import Network.HTTP (urlEncode) -import Network.URI (URI (..), parseURIReference, unEscapeString) +import Network.URI (URI (..), parseURIReference) import Numeric (showHex) import Text.Blaze.Internal (customLeaf, customParent, MarkupM(Empty)) #if MIN_VERSION_blaze_markup(0,6,3) @@ -75,7 +75,7 @@ import Text.Pandoc.Templates import Text.Pandoc.Walk import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Shared -import Text.Pandoc.XML (escapeStringForXML, fromEntities) +import Text.Pandoc.XML (escapeStringForXML, fromEntities, toEntities) #if MIN_VERSION_blaze_markup(0,6,3) #else import Text.Blaze.Internal (preEscapedString, preEscapedText) @@ -206,7 +206,8 @@ writeHtmlString' :: PandocMonad m => WriterState -> WriterOptions -> Pandoc -> m Text writeHtmlString' st opts d = do (body, context) <- evalStateT (pandocToHtml opts d) st - case writerTemplate opts of + (if writerPreferAscii opts then toEntities else id) <$> + case writerTemplate opts of Nothing -> return $ renderHtml' body Just tpl -> do -- warn if empty lang @@ -221,16 +222,19 @@ writeHtmlString' st opts d = do lookup "sourcefile" (writerVariables opts) report $ NoTitleElement fallback return $ resetField "pagetitle" fallback context - renderTemplate' tpl $ - defField "body" (renderHtml' body) context' + renderTemplate' tpl + (defField "body" (renderHtml' body) context') writeHtml' :: PandocMonad m => WriterState -> WriterOptions -> Pandoc -> m Html writeHtml' st opts d = case writerTemplate opts of Just _ -> preEscapedText <$> writeHtmlString' st opts d - Nothing -> do - (body, _) <- evalStateT (pandocToHtml opts d) st - return body + Nothing + | writerPreferAscii opts + -> preEscapedText <$> writeHtmlString' st opts d + | otherwise -> do + (body, _) <- evalStateT (pandocToHtml opts d) st + return body -- result is (title, authors, date, toc, body, new variables) pandocToHtml :: PandocMonad m @@ -259,7 +263,7 @@ pandocToHtml opts (Pandoc meta blocks) = do st <- get notes <- footnoteSection opts (reverse (stNotes st)) let thebody = blocks' >> notes - let math = case writerHTMLMathMethod opts of + let math = case writerHTMLMathMethod opts of MathJax url | slideVariant /= RevealJsSlides -> -- mathjax is handled via a special plugin in revealjs @@ -273,10 +277,10 @@ pandocToHtml opts (Pandoc meta blocks) = do KaTeX url -> do H.script ! A.src (toValue $ url ++ "katex.min.js") $ mempty - H.script ! - A.src (toValue $ url ++ "contrib/auto-render.min.js") $ mempty + nl opts H.script - "document.addEventListener(\"DOMContentLoaded\", function() {\n renderMathInElement(document.body);\n});" + "document.addEventListener(\"DOMContentLoaded\", function () {\n var mathElements = document.getElementsByClassName(\"math\");\n for (var i = 0; i < mathElements.length; i++) {\n var texText = mathElements[i].firstChild;\n if (mathElements[i].tagName == \"SPAN\") { katex.render(texText.data, mathElements[i], { displayMode: mathElements[i].classList.contains(\"display\"), throwOnError: false } );\n }}});" + nl opts H.link ! A.rel "stylesheet" ! A.href (toValue $ url ++ "katex.min.css") @@ -296,10 +300,11 @@ 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) $ + (case writerHTMLMathMethod opts of + MathJax u -> defField "mathjax" True . + defField "mathjaxurl" + (takeWhile (/='?') u) + _ -> defField "mathjax" False) $ defField "quotes" (stQuotes st) $ -- for backwards compatibility we populate toc -- with the contents of the toc, rather than a @@ -460,7 +465,7 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen t <- addAttrs opts attr $ secttag header' return $ - (if slideVariant == RevealJsSlides + (if slideVariant == RevealJsSlides && not (null innerContents) then H5.section else id) $ mconcat $ t : innerContents else if writerSectionDivs opts || slide @@ -576,12 +581,23 @@ toAttrs :: PandocMonad m => [(String, String)] -> StateT WriterState m [Attribute] toAttrs kvs = do html5 <- gets stHtml5 - return $ map (\(x,y) -> - customAttribute - (fromString (if not html5 || x `Set.member` html5Attributes - || "data-" `isPrefixOf` x - then x - else "data-" ++ x)) (toValue y)) kvs + mbEpubVersion <- gets stEPUBVersion + return $ mapMaybe (\(x,y) -> + if html5 + then + if x `Set.member` html5Attributes + || ':' `elem` x -- e.g. epub: namespace + || "data-" `isPrefixOf` x + then Just $ customAttribute (fromString x) (toValue y) + else Just $ customAttribute (fromString ("data-" ++ x)) + (toValue y) + else + if mbEpubVersion == Just EPUB2 && + not (x `Set.member` html4Attributes || + "xml:" `isPrefixOf` x) + then Nothing + else Just $ customAttribute (fromString x) (toValue y)) + kvs attrsToHtml :: PandocMonad m => WriterOptions -> Attr -> StateT WriterState m [Attribute] @@ -828,9 +844,7 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do return $ foldl (!) l attribs blockToHtml opts (DefinitionList lst) = do contents <- mapM (\(term, defs) -> - do term' <- if null term - then return mempty - else liftM H.dt $ inlineListToHtml opts term + do term' <- liftM H.dt $ inlineListToHtml opts term defs' <- mapM (liftM (\x -> H.dd (x >> nl opts)) . blockListToHtml opts) defs return $ mconcat $ nl opts : term' : nl opts : @@ -1051,8 +1065,8 @@ inlineToHtml opts inline = do DisplayMath -> "\\[" ++ str ++ "\\]" KaTeX _ -> return $ H.span ! A.class_ mathClass $ toHtml $ case t of - InlineMath -> "\\(" ++ str ++ "\\)" - DisplayMath -> "\\[" ++ str ++ "\\]" + InlineMath -> str + DisplayMath -> str PlainMath -> do x <- lift (texMathToInlines t str) >>= inlineListToHtml opts let m = H.span ! A.class_ mathClass $ x @@ -1084,10 +1098,7 @@ inlineToHtml opts inline = do in '#' : prefix ++ xs _ -> s let link = H.a ! A.href (toValue s') $ linkText - let attr = if txt == [Str (unEscapeString s)] - then (ident, "uri" : classes, kvs) - else (ident, classes, kvs) - link' <- addAttrs opts attr link + link' <- addAttrs opts (ident, classes, kvs) link return $ if null tit then link' else link' ! A.title (toValue tit) @@ -1422,3 +1433,125 @@ html5Attributes = Set.fromList , "workertype" , "wrap" ] + +html4Attributes :: Set.Set String +html4Attributes = Set.fromList + [ "abbr" + , "accept" + , "accept-charset" + , "accesskey" + , "action" + , "align" + , "alink" + , "alt" + , "archive" + , "axis" + , "background" + , "bgcolor" + , "border" + , "cellpadding" + , "cellspacing" + , "char" + , "charoff" + , "charset" + , "checked" + , "cite" + , "class" + , "classid" + , "clear" + , "code" + , "codebase" + , "codetype" + , "color" + , "cols" + , "colspan" + , "compact" + , "content" + , "coords" + , "data" + , "datetime" + , "declare" + , "defer" + , "dir" + , "disabled" + , "enctype" + , "face" + , "for" + , "frame" + , "frameborder" + , "headers" + , "height" + , "href" + , "hreflang" + , "hspace" + , "http-equiv" + , "id" + , "ismap" + , "label" + , "lang" + , "language" + , "link" + , "longdesc" + , "marginheight" + , "marginwidth" + , "maxlength" + , "media" + , "method" + , "multiple" + , "name" + , "nohref" + , "noresize" + , "noshade" + , "nowrap" + , "object" + , "onblur" + , "onchange" + , "onclick" + , "ondblclick" + , "onfocus" + , "onkeydown" + , "onkeypress" + , "onkeyup" + , "onload" + , "onmousedown" + , "onmousemove" + , "onmouseout" + , "onmouseover" + , "onmouseup" + , "onreset" + , "onselect" + , "onsubmit" + , "onunload" + , "profile" + , "prompt" + , "readonly" + , "rel" + , "rev" + , "rows" + , "rowspan" + , "rules" + , "scheme" + , "scope" + , "scrolling" + , "selected" + , "shape" + , "size" + , "span" + , "src" + , "standby" + , "start" + , "style" + , "summary" + , "tabindex" + , "target" + , "text" + , "title" + , "usemap" + , "valign" + , "value" + , "valuetype" + , "version" + , "vlink" + , "vspace" + , "width" + ] diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs index 75b8c78dc..80e092b6a 100644 --- a/src/Text/Pandoc/Writers/Haddock.hs +++ b/src/Text/Pandoc/Writers/Haddock.hs @@ -45,7 +45,6 @@ import Text.Pandoc.Options import Text.Pandoc.Pretty import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate') -import Text.Pandoc.Writers.Math (texMathToInlines) import Text.Pandoc.Writers.Shared type Notes = [[Block]] @@ -208,13 +207,13 @@ blockListToHaddock :: PandocMonad m -> [Block] -- ^ List of block elements -> StateT WriterState m Doc blockListToHaddock opts blocks = - mapM (blockToHaddock opts) blocks >>= return . cat + cat <$> mapM (blockToHaddock opts) blocks -- | Convert list of Pandoc inline elements to haddock. inlineListToHaddock :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m Doc inlineListToHaddock opts lst = - mapM (inlineToHaddock opts) lst >>= return . cat + cat <$> mapM (inlineToHaddock opts) lst -- | Convert Pandoc inline element to haddock. inlineToHaddock :: PandocMonad m @@ -250,11 +249,10 @@ inlineToHaddock _ (Code _ str) = return $ "@" <> text (escapeString str) <> "@" inlineToHaddock _ (Str str) = return $ text $ escapeString str -inlineToHaddock opts (Math mt str) = do - let adjust x = case mt of - DisplayMath -> cr <> x <> cr - InlineMath -> x - adjust <$> (lift (texMathToInlines mt str) >>= inlineListToHaddock opts) +inlineToHaddock _ (Math mt str) = + return $ case mt of + DisplayMath -> cr <> "\\[" <> text str <> "\\]" <> cr + InlineMath -> "\\(" <> text str <> "\\)" inlineToHaddock _ il@(RawInline f str) | f == "haddock" = return $ text str | otherwise = do diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 266d58007..ef1e2af0a 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -149,11 +149,12 @@ writeICML opts (Pandoc meta blocks) = do $ defField "charStyles" (render' $ charStylesToDoc st) $ defField "parStyles" (render' $ parStylesToDoc st) $ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st) metadata - case writerTemplate opts of + (if writerPreferAscii opts then toEntities else id) <$> + case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context --- | Auxilary functions for parStylesToDoc and charStylesToDoc. +-- | Auxiliary functions for parStylesToDoc and charStylesToDoc. contains :: String -> (String, (String, String)) -> [(String, String)] contains s rule = [snd rule | (fst rule) `isInfixOf` s] diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index fb3236bd9..4e78a4cce 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -102,7 +102,8 @@ docToJATS opts (Pandoc meta blocks) = do $ defField "mathml" (case writerHTMLMathMethod opts of MathML -> True _ -> False) metadata - case writerTemplate opts of + (if writerPreferAscii opts then toEntities else id) <$> + case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -344,7 +345,7 @@ inlineToJATS _ (Str str) = return $ text $ escapeStringForXML str inlineToJATS opts (Emph lst) = inTagsSimple "italic" <$> inlinesToJATS opts lst inlineToJATS opts (Strong lst) = - inTags False "bold" [("role", "strong")] <$> inlinesToJATS opts lst + inTagsSimple "bold" <$> inlinesToJATS opts lst inlineToJATS opts (Strikeout lst) = inTagsSimple "strike" <$> inlinesToJATS opts lst inlineToJATS opts (Superscript lst) = @@ -352,8 +353,7 @@ inlineToJATS opts (Superscript lst) = inlineToJATS opts (Subscript lst) = inTagsSimple "sub" <$> inlinesToJATS opts lst inlineToJATS opts (SmallCaps lst) = - inTags False "sc" [("role", "smallcaps")] <$> - inlinesToJATS opts lst + inTagsSimple "sc" <$> inlinesToJATS opts lst inlineToJATS opts (Quoted SingleQuote lst) = do contents <- inlinesToJATS opts lst return $ char '‘' <> contents <> char '’' diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 2904bec06..c1b5d0fa4 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -42,8 +42,9 @@ import Data.Aeson (FromJSON, object, (.=)) import Data.Char (isAlphaNum, isAscii, isDigit, isLetter, isPunctuation, ord, toLower) import Data.List (foldl', intercalate, intersperse, isInfixOf, nubBy, - stripPrefix, (\\)) + stripPrefix, (\\), uncons) import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe, isNothing) +import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T import Network.URI (unEscapeString) @@ -63,6 +64,7 @@ import Text.Pandoc.Walk import Text.Pandoc.Writers.Shared import qualified Text.Parsec as P import Text.Printf (printf) +import qualified Data.Text.Normalize as Normalize data WriterState = WriterState { stInNote :: Bool -- true if we're in a note @@ -176,9 +178,9 @@ pandocToLaTeX options (Pandoc meta blocks) = do modify $ \s -> s{stCsquotes = True} let (blocks'', lastHeader) = if writerCiteMethod options == Citeproc then (blocks', []) - else case last blocks' of - Header 1 _ il -> (init blocks', il) - _ -> (blocks', []) + else case reverse blocks' of + Header 1 _ il : _ -> (init blocks', il) + _ -> (blocks', []) beamer <- gets stBeamer blocks''' <- if beamer then toSlides blocks'' @@ -248,7 +250,8 @@ pandocToLaTeX options (Pandoc meta blocks) = do defField "biblatex" True _ -> id) $ defField "colorlinks" (any hasStringValue - ["citecolor", "urlcolor", "linkcolor", "toccolor"]) $ + ["citecolor", "urlcolor", "linkcolor", "toccolor", + "filecolor"]) $ (if null dirs then id else defField "dir" ("ltr" :: String)) $ @@ -317,46 +320,110 @@ data StringContext = TextString -- escape things as needed for LaTeX stringToLaTeX :: PandocMonad m => StringContext -> String -> LW m String -stringToLaTeX _ [] = return "" -stringToLaTeX ctx (x:xs) = do +stringToLaTeX context zs = do opts <- gets stOptions - rest <- stringToLaTeX ctx xs - let ligatures = isEnabled Ext_smart opts && ctx == TextString - let isUrl = ctx == URLString - return $ + go opts context $ + if writerPreferAscii opts + then T.unpack $ Normalize.normalize Normalize.NFD $ T.pack zs + else zs + where + go _ _ [] = return "" + go opts ctx (x:xs) = do + let ligatures = isEnabled Ext_smart opts && ctx == TextString + let isUrl = ctx == URLString + let mbAccentCmd = + if writerPreferAscii opts && ctx == TextString + then uncons xs >>= \(c,_) -> M.lookup c accents + else Nothing + let emits s = + case mbAccentCmd of + Just cmd -> ((cmd ++ "{" ++ s ++ "}") ++) + <$> go opts ctx (drop 1 xs) -- drop combining accent + Nothing -> (s++) <$> go opts ctx xs + let emitc c = + case mbAccentCmd of + Just cmd -> ((cmd ++ "{" ++ [c] ++ "}") ++) + <$> go opts ctx (drop 1 xs) -- drop combining accent + Nothing -> (c:) <$> go opts ctx xs case x of - '{' -> "\\{" ++ rest - '}' -> "\\}" ++ rest - '`' | ctx == CodeString -> "\\textasciigrave{}" ++ rest - '$' | not isUrl -> "\\$" ++ rest - '%' -> "\\%" ++ rest - '&' -> "\\&" ++ rest - '_' | not isUrl -> "\\_" ++ rest - '#' -> "\\#" ++ rest - '-' | not isUrl -> case xs of - -- prevent adjacent hyphens from forming ligatures - ('-':_) -> "-\\/" ++ rest - _ -> '-' : rest - '~' | not isUrl -> "\\textasciitilde{}" ++ rest - '^' -> "\\^{}" ++ rest - '\\'| isUrl -> '/' : rest -- NB. / works as path sep even on Windows - | otherwise -> "\\textbackslash{}" ++ rest - '|' | not isUrl -> "\\textbar{}" ++ rest - '<' -> "\\textless{}" ++ rest - '>' -> "\\textgreater{}" ++ rest - '[' -> "{[}" ++ rest -- to avoid interpretation as - ']' -> "{]}" ++ rest -- optional arguments - '\'' | ctx == CodeString -> "\\textquotesingle{}" ++ rest - '\160' -> "~" ++ rest - '\x202F' -> "\\," ++ rest - '\x2026' -> "\\ldots{}" ++ rest - '\x2018' | ligatures -> "`" ++ rest - '\x2019' | ligatures -> "'" ++ rest - '\x201C' | ligatures -> "``" ++ rest - '\x201D' | ligatures -> "''" ++ rest - '\x2014' | ligatures -> "---" ++ rest - '\x2013' | ligatures -> "--" ++ rest - _ -> x : rest + '{' -> emits "\\{" + '}' -> emits "\\}" + '`' | ctx == CodeString -> emits "\\textasciigrave{}" + '$' | not isUrl -> emits "\\$" + '%' -> emits "\\%" + '&' -> emits "\\&" + '_' | not isUrl -> emits "\\_" + '#' -> emits "\\#" + '-' | not isUrl -> case xs of + -- prevent adjacent hyphens from forming ligatures + ('-':_) -> emits "-\\/" + _ -> emitc '-' + '~' | not isUrl -> emits "\\textasciitilde{}" + '^' -> emits "\\^{}" + '\\'| isUrl -> emitc '/' -- NB. / works as path sep even on Windows + | otherwise -> emits "\\textbackslash{}" + '|' | not isUrl -> emits "\\textbar{}" + '<' -> emits "\\textless{}" + '>' -> emits "\\textgreater{}" + '[' -> emits "{[}" -- to avoid interpretation as + ']' -> emits "{]}" -- optional arguments + '\'' | ctx == CodeString -> emits "\\textquotesingle{}" + '\160' -> emits "~" + '\x202F' -> emits "\\," + '\x2026' -> emits "\\ldots{}" + '\x2018' | ligatures -> emits "`" + '\x2019' | ligatures -> emits "'" + '\x201C' | ligatures -> emits "``" + '\x201D' | ligatures -> emits "''" + '\x2014' | ligatures -> emits "---" + '\x2013' | ligatures -> emits "--" + _ | writerPreferAscii opts + -> case x of + 'ı' -> emits "\\i " + 'ȷ' -> emits "\\j " + 'å' -> emits "\\aa " + 'Å' -> emits "\\AA " + 'ß' -> emits "\\ss " + 'ø' -> emits "\\o " + 'Ø' -> emits "\\O " + 'Ł' -> emits "\\L " + 'ł' -> emits "\\l " + 'æ' -> emits "\\ae " + 'Æ' -> emits "\\AE " + 'œ' -> emits "\\oe " + 'Œ' -> emits "\\OE " + '£' -> emits "\\pounds " + '€' -> emits "\\euro " + '©' -> emits "\\copyright " + _ -> emitc x + | otherwise -> emitc x + +accents :: M.Map Char String +accents = M.fromList + [ ('\779' , "\\H") + , ('\768' , "\\`") + , ('\769' , "\\'") + , ('\770' , "\\^") + , ('\771' , "\\~") + , ('\776' , "\\\"") + , ('\775' , "\\.") + , ('\772' , "\\=") + , ('\781' , "\\|") + , ('\817' , "\\b") + , ('\807' , "\\c") + , ('\783' , "\\G") + , ('\777' , "\\h") + , ('\803' , "\\d") + , ('\785' , "\\f") + , ('\778' , "\\r") + , ('\865' , "\\t") + , ('\782' , "\\U") + , ('\780' , "\\v") + , ('\774' , "\\u") + , ('\808' , "\\k") + , ('\785' , "\\newtie") + , ('\8413', "\\textcircled") + ] toLabel :: PandocMonad m => String -> LW m String toLabel z = go `fmap` stringToLaTeX URLString z @@ -402,7 +469,8 @@ elementToBeamer slideLevel (Sec lvl _num (ident,classes,kvs) tit elts) not (null $ query hasCodeBlock elts ++ query hasCode elts) let frameoptions = ["allowdisplaybreaks", "allowframebreaks", "fragile", "b", "c", "t", "environment", - "label", "plain", "shrink", "standout"] + "label", "plain", "shrink", "standout", + "noframenumbering"] let optionslist = ["fragile" | fragile && isNothing (lookup "fragile" kvs)] ++ [k | k <- classes, k `elem` frameoptions] ++ [k ++ "=" ++ v | (k,v) <- kvs, k `elem` frameoptions] @@ -487,7 +555,7 @@ blockToLaTeX (Div (identifier,classes,kvs) bs) then \contents -> let fromPct xs = case reverse xs of - '%':ds -> '0':'.': reverse ds + '%':ds -> showFl (read (reverse ds) / 100 :: Double) _ -> xs w = maybe "0.48" fromPct (lookup "width" kvs) in inCmd "begin" "column" <> @@ -517,25 +585,15 @@ 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 - modify $ \st -> st{ stInMinipage = False, stNotes = [] } - - -- We can't have footnotes in the list of figures, so remove them: - captForLof <- if null notes - then return empty - else brackets <$> inlineListToLaTeX (walk deNote txt) - img <- inlineToLaTeX (Image attr txt (src,tit)) - let footnotes = notesToLaTeX notes + (capt, captForLof, footnotes) <- getCaption txt lab <- labelFor ident let caption = "\\caption" <> captForLof <> braces capt <> lab + img <- inlineToLaTeX (Image attr txt (src,tit)) innards <- hypertarget True ident $ "\\centering" $$ img $$ caption <> cr let figure = cr <> "\\begin{figure}" $$ innards $$ "\\end{figure}" - return $ if inNote || inMinipage + st <- get + return $ if stInNote st || stInMinipage st -- 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}" @@ -714,11 +772,11 @@ blockToLaTeX (Header level (id',classes,_) lst) = do modify $ \s -> s{stInHeading = False} return hdr blockToLaTeX (Table caption aligns widths heads rows) = do + (captionText, captForLof, footnotes) <- getCaption caption 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 @@ -730,8 +788,8 @@ blockToLaTeX (Table caption aligns widths heads rows) = do else walk removeNote heads) let capt = if isEmpty captionText then empty - else text "\\caption" <> - braces captionText <> "\\tabularnewline" + else "\\caption" <> captForLof <> braces captionText + <> "\\tabularnewline" rows' <- mapM (tableRowToLaTeX False aligns widths) rows let colDescriptors = text $ concatMap toColDescriptor aligns modify $ \s -> s{ stTable = True } @@ -745,6 +803,21 @@ blockToLaTeX (Table caption aligns widths heads rows) = do $$ vcat rows' $$ "\\bottomrule" $$ "\\end{longtable}" + $$ footnotes + +getCaption :: PandocMonad m => [Inline] -> LW m (Doc, Doc, Doc) +getCaption txt = do + inMinipage <- gets stInMinipage + modify $ \st -> st{ stInMinipage = True, stNotes = [] } + capt <- inlineListToLaTeX txt + notes <- gets stNotes + modify $ \st -> st{ stInMinipage = inMinipage, stNotes = [] } + -- We can't have footnotes in the list of figures/tables, so remove them: + captForLof <- if null notes + then return empty + else brackets <$> inlineListToLaTeX (walk deNote txt) + let footnotes = notesToLaTeX notes + return (capt, captForLof, footnotes) toColDescriptor :: Alignment -> String toColDescriptor align = @@ -863,9 +936,11 @@ defListItemToLaTeX (term, defs) = do else term' def' <- liftM vsep $ mapM blockListToLaTeX defs return $ case defs of - ((Header{} : _) : _) -> + ((Header{} : _) : _) -> + "\\item" <> brackets term'' <> " ~ " $$ def' + ((CodeBlock{} : _) : _) -> -- see #4662 "\\item" <> brackets term'' <> " ~ " $$ def' - _ -> + _ -> "\\item" <> brackets term'' $$ def' -- | Craft the section header, inserting the secton reference, if supplied. diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 912231a88..81fa38bd7 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -107,7 +107,8 @@ pandocToMan opts (Pandoc meta blocks) = do $ defField "has-tables" hasTables $ defField "hyphenate" True $ defField "pandoc-version" pandocVersion metadata - case writerTemplate opts of + (if writerPreferAscii opts then groffEscape else id) <$> + case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -152,32 +153,6 @@ escapeCode = intercalate "\n" . map escapeLine . lines where -- line. groff/troff treats the line-ending period differently. -- See http://code.google.com/p/pandoc/issues/detail?id=148. --- | Returns the first sentence in a list of inlines, and the rest. -breakSentence :: [Inline] -> ([Inline], [Inline]) -breakSentence [] = ([],[]) -breakSentence xs = - let isSentenceEndInline (Str ys@(_:_)) | last ys == '.' = True - isSentenceEndInline (Str ys@(_:_)) | last ys == '?' = True - isSentenceEndInline LineBreak = True - isSentenceEndInline _ = False - (as, bs) = break isSentenceEndInline xs - in case bs of - [] -> (as, []) - [c] -> (as ++ [c], []) - (c:Space:cs) -> (as ++ [c], cs) - (c:SoftBreak:cs) -> (as ++ [c], cs) - (Str ".":Str (')':ys):cs) -> (as ++ [Str ".", Str (')':ys)], cs) - (x@(Str ('.':')':_)):cs) -> (as ++ [x], cs) - (LineBreak:x@(Str ('.':_)):cs) -> (as ++[LineBreak], x:cs) - (c:cs) -> (as ++ [c] ++ ds, es) - where (ds, es) = breakSentence cs - --- | Split a list of inlines into sentences. -splitSentences :: [Inline] -> [[Inline]] -splitSentences xs = - let (sent, rest) = breakSentence xs - in if null rest then [sent] else sent : splitSentences rest - -- | Convert Pandoc block element to man. blockToMan :: PandocMonad m => WriterOptions -- ^ Options @@ -325,11 +300,11 @@ blockListToMan :: PandocMonad m -> [Block] -- ^ List of block elements -> StateT WriterState m Doc blockListToMan opts blocks = - mapM (blockToMan opts) blocks >>= (return . vcat) + vcat <$> mapM (blockToMan opts) blocks -- | Convert list of Pandoc inline elements to man. inlineListToMan :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m Doc -inlineListToMan opts lst = mapM (inlineToMan opts) lst >>= (return . hcat) +inlineListToMan opts lst = hcat <$> mapM (inlineToMan opts) lst -- | Convert Pandoc inline element to man. inlineToMan :: PandocMonad m => WriterOptions -> Inline -> StateT WriterState m Doc diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 075858e5e..9a4acb59d 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -38,7 +38,7 @@ module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where import Prelude import Control.Monad.Reader import Control.Monad.State.Strict -import Data.Char (chr, isPunctuation, isSpace, ord, isAlphaNum) +import Data.Char (isPunctuation, isSpace, isAlphaNum) import Data.Default import qualified Data.HashMap.Strict as H import Data.List (find, group, intersperse, sortBy, stripPrefix, transpose) @@ -50,7 +50,7 @@ import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import qualified Data.Vector as V -import Data.Yaml (Value (Array, Bool, Number, Object, String)) +import Data.Aeson (Value (Array, Bool, Number, Object, String)) import Network.HTTP (urlEncode) import Text.HTML.TagSoup (Tag (..), isTagText, parseTags) import Text.Pandoc.Class (PandocMonad, report) @@ -298,7 +298,8 @@ escapeString opts (c:cs) = '\\':c:escapeString opts cs '|' | isEnabled Ext_pipe_tables opts -> '\\':'|':escapeString opts cs '^' | isEnabled Ext_superscript opts -> '\\':'^':escapeString opts cs - '~' | isEnabled Ext_subscript opts -> '\\':'~':escapeString opts cs + '~' | isEnabled Ext_subscript opts || + isEnabled Ext_strikeout opts -> '\\':'~':escapeString opts cs '$' | isEnabled Ext_tex_math_dollars opts -> '\\':'$':escapeString opts cs '\'' | isEnabled Ext_smart opts -> '\\':'\'':escapeString opts cs '"' | isEnabled Ext_smart opts -> '\\':'"':escapeString opts cs @@ -452,8 +453,14 @@ blockToMarkdown' opts (Plain inlines) = do | otherwise -> contents return $ contents' <> cr -- title beginning with fig: indicates figure -blockToMarkdown' opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = - blockToMarkdown opts (Para [Image attr alt (src,tit)]) +blockToMarkdown' opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) + | isEnabled Ext_raw_html opts && + not (isEnabled Ext_link_attributes opts) && + attr /= nullAttr = -- use raw HTML + (text . T.unpack . T.strip) <$> + writeHtml5String opts{ writerTemplate = Nothing } + (Pandoc nullMeta [Para [Image attr alt (src,"fig:" ++ tit)]]) + | otherwise = blockToMarkdown opts (Para [Image attr alt (src,tit)]) blockToMarkdown' opts (Para inlines) = (<> blankline) `fmap` blockToMarkdown opts (Plain inlines) blockToMarkdown' opts (LineBlock lns) = @@ -619,7 +626,7 @@ blockToMarkdown' opts t@(Table caption aligns widths headers rows) = do (all null headers) aligns' widths' headers rows | isEnabled Ext_raw_html opts -> fmap (id,) $ (text . T.unpack) <$> - (writeHtml5String def $ Pandoc nullMeta [t]) + (writeHtml5String opts{ writerTemplate = Nothing } $ Pandoc nullMeta [t]) | hasSimpleCells && isEnabled Ext_pipe_tables opts -> do rawHeaders <- padRow <$> mapM (blockListToMarkdown opts) headers @@ -976,6 +983,11 @@ isRight (Left _) = False -- | Convert Pandoc inline element to markdown. inlineToMarkdown :: PandocMonad m => WriterOptions -> Inline -> MD m Doc +inlineToMarkdown opts (Span ("",["emoji"],kvs) [Str s]) = do + case lookup "data-emoji" kvs of + Just emojiname | isEnabled Ext_emoji opts -> + return $ ":" <> text emojiname <> ":" + _ -> inlineToMarkdown opts (Str s) inlineToMarkdown opts (Span attrs ils) = do plain <- asks envPlain contents <- inlineListToMarkdown opts ils @@ -1172,7 +1184,7 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit)) not (isEnabled Ext_link_attributes opts) && attr /= nullAttr = -- use raw HTML (text . T.unpack . T.strip) <$> - writeHtml5String def (Pandoc nullMeta [Plain [lnk]]) + writeHtml5String opts{ writerTemplate = Nothing } (Pandoc nullMeta [Plain [lnk]]) | otherwise = do plain <- asks envPlain linktext <- inlineListToMarkdown opts txt @@ -1212,7 +1224,7 @@ inlineToMarkdown opts img@(Image attr alternate (source, tit)) not (isEnabled Ext_link_attributes opts) && attr /= nullAttr = -- use raw HTML (text . T.unpack . T.strip) <$> - writeHtml5String def (Pandoc nullMeta [Plain [img]]) + writeHtml5String opts{ writerTemplate = Nothing } (Pandoc nullMeta [Plain [img]]) | otherwise = do plain <- asks envPlain let txt = if null alternate || alternate == [Str source] @@ -1237,33 +1249,6 @@ makeMathPlainer = walk go go (Emph xs) = Span nullAttr xs go x = x -toSuperscript :: Char -> Maybe Char -toSuperscript '1' = Just '\x00B9' -toSuperscript '2' = Just '\x00B2' -toSuperscript '3' = Just '\x00B3' -toSuperscript '+' = Just '\x207A' -toSuperscript '-' = Just '\x207B' -toSuperscript '=' = Just '\x207C' -toSuperscript '(' = Just '\x207D' -toSuperscript ')' = Just '\x207E' -toSuperscript c - | c >= '0' && c <= '9' = - Just $ chr (0x2070 + (ord c - 48)) - | isSpace c = Just c - | otherwise = Nothing - -toSubscript :: Char -> Maybe Char -toSubscript '+' = Just '\x208A' -toSubscript '-' = Just '\x208B' -toSubscript '=' = Just '\x208C' -toSubscript '(' = Just '\x208D' -toSubscript ')' = Just '\x208E' -toSubscript c - | c >= '0' && c <= '9' = - Just $ chr (0x2080 + (ord c - 48)) - | isSpace c = Just c - | otherwise = Nothing - lineBreakToSpace :: Inline -> Inline lineBreakToSpace LineBreak = Space lineBreakToSpace SoftBreak = Space diff --git a/src/Text/Pandoc/Writers/Math.hs b/src/Text/Pandoc/Writers/Math.hs index 99d17d594..61decf2df 100644 --- a/src/Text/Pandoc/Writers/Math.hs +++ b/src/Text/Pandoc/Writers/Math.hs @@ -55,4 +55,4 @@ defaultMathJaxURL :: String defaultMathJaxURL = "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2/" defaultKaTeXURL :: String -defaultKaTeXURL = "https://cdnjs.cloudflare.com/ajax/libs/KaTeX/0.8.3/" +defaultKaTeXURL = "https://cdnjs.cloudflare.com/ajax/libs/KaTeX/0.9.0/" diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index df50028a0..666853a3c 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -313,6 +313,7 @@ tableCellToMediaWiki headless rownum (alignment, width, bs) = do let sep = case bs of [Plain _] -> " " [Para _] -> " " + [] -> "" _ -> "\n" return $ marker ++ attr ++ sep ++ trimr contents diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs index 16a66c85b..9a35a9693 100644 --- a/src/Text/Pandoc/Writers/Ms.hs +++ b/src/Text/Pandoc/Writers/Ms.hs @@ -127,7 +127,8 @@ pandocToMs opts (Pandoc meta blocks) = do $ defField "title-meta" titleMeta $ defField "author-meta" (intercalate "; " authorsMeta) $ defField "highlighting-macros" highlightingMacros metadata - case writerTemplate opts of + (if writerPreferAscii opts then groffEscape else id) <$> + case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -188,32 +189,6 @@ escapeCode = intercalate "\n" . map escapeLine . lines -- line. groff/troff treats the line-ending period differently. -- See http://code.google.com/p/pandoc/issues/detail?id=148. --- | Returns the first sentence in a list of inlines, and the rest. -breakSentence :: [Inline] -> ([Inline], [Inline]) -breakSentence [] = ([],[]) -breakSentence xs = - let isSentenceEndInline (Str ys@(_:_)) | last ys == '.' = True - isSentenceEndInline (Str ys@(_:_)) | last ys == '?' = True - isSentenceEndInline LineBreak = True - isSentenceEndInline _ = False - (as, bs) = break isSentenceEndInline xs - in case bs of - [] -> (as, []) - [c] -> (as ++ [c], []) - (c:Space:cs) -> (as ++ [c], cs) - (c:SoftBreak:cs) -> (as ++ [c], cs) - (Str ".":Str (')':ys):cs) -> (as ++ [Str ".", Str (')':ys)], cs) - (x@(Str ('.':')':_)):cs) -> (as ++ [x], cs) - (LineBreak:x@(Str ('.':_)):cs) -> (as ++[LineBreak], x:cs) - (c:cs) -> (as ++ [c] ++ ds, es) - where (ds, es) = breakSentence cs - --- | Split a list of inlines into sentences. -splitSentences :: [Inline] -> [[Inline]] -splitSentences xs = - let (sent, rest) = breakSentence xs - in if null rest then [sent] else sent : splitSentences rest - blockToMs :: PandocMonad m => WriterOptions -- ^ Options -> Block -- ^ Block element @@ -434,7 +409,7 @@ blockListToMs :: PandocMonad m -> [Block] -- ^ List of block elements -> MS m Doc blockListToMs opts blocks = - mapM (blockToMs opts) blocks >>= (return . vcat) + vcat <$> mapM (blockToMs opts) blocks -- | Convert list of Pandoc inline elements to ms. inlineListToMs :: PandocMonad m => WriterOptions -> [Inline] -> MS m Doc diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs index 3681fcc0d..18aebc364 100644 --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -46,7 +46,7 @@ module Text.Pandoc.Writers.Muse (writeMuse) where import Prelude import Control.Monad.Reader import Control.Monad.State.Strict -import Data.Char (isSpace, isDigit, isAsciiUpper, isAsciiLower) +import Data.Char (isSpace, isAlphaNum, isDigit, isAsciiUpper, isAsciiLower) import Data.Default import Data.Text (Text) import Data.List (intersperse, transpose, isInfixOf) @@ -70,20 +70,24 @@ data WriterEnv = WriterEnv { envOptions :: WriterOptions , envTopLevel :: Bool , envInsideBlock :: Bool - , envInlineStart :: Bool + , envInlineStart :: Bool -- ^ True if there is only whitespace since last newline , envInsideLinkDescription :: Bool -- ^ Escape ] if True - , envAfterSpace :: Bool + , envAfterSpace :: Bool -- ^ There is whitespace (not just newline) before , envOneLine :: Bool -- ^ True if newlines are not allowed + , envInsideAsterisks :: Bool -- ^ True if outer element is emphasis with asterisks + , envNearAsterisks :: Bool -- ^ Rendering inline near asterisks } data WriterState = WriterState { stNotes :: Notes , stIds :: Set.Set String + , stUseTags :: Bool -- ^ Use tags for emphasis, for example because previous character is a letter } instance Default WriterState where def = WriterState { stNotes = [] , stIds = Set.empty + , stUseTags = False } evalMuse :: PandocMonad m => Muse m a -> WriterEnv -> WriterState -> m a @@ -103,6 +107,8 @@ writeMuse opts document = , envInsideLinkDescription = False , envAfterSpace = False , envOneLine = False + , envInsideAsterisks = False + , envNearAsterisks = False } -- | Return Muse representation of document. @@ -212,6 +218,7 @@ blockToMuse (BulletList items) = do => [Block] -> Muse m Doc bulletListItemToMuse item = do + modify $ \st -> st { stUseTags = False } contents <- blockListToMuse item return $ hang 2 "- " contents blockToMuse (DefinitionList items) = do @@ -223,16 +230,18 @@ blockToMuse (DefinitionList items) = do => ([Inline], [[Block]]) -> Muse m Doc definitionListItemToMuse (label, defs) = do + modify $ \st -> st { stUseTags = False } label' <- local (\env -> env { envOneLine = True, envAfterSpace = True }) $ inlineListToMuse' label contents <- vcat <$> mapM descriptionToMuse defs let ind = offset label' - return $ hang ind label' contents + return $ hang ind (nowrap label') contents descriptionToMuse :: PandocMonad m => [Block] -> Muse m Doc descriptionToMuse desc = hang 4 " :: " <$> blockListToMuse desc blockToMuse (Header level (ident,_,_) inlines) = do opts <- asks envOptions + topLevel <- asks envTopLevel contents <- local (\env -> env { envOneLine = True }) $ inlineListToMuse' inlines ids <- gets stIds let autoId = uniqueIdent inlines ids @@ -241,8 +250,8 @@ blockToMuse (Header level (ident,_,_) inlines) = do let attr' = if null ident || (isEnabled Ext_auto_identifiers opts && ident == autoId) then empty else "#" <> text ident <> cr - let header' = text $ replicate level '*' - return $ blankline <> attr' $$ nowrap (header' <> space <> contents) <> blankline + let header' = if topLevel then (text $ replicate level '*') <> space else mempty + return $ blankline <> attr' $$ nowrap (header' <> contents) <> blankline -- https://www.gnu.org/software/emacs-muse/manual/muse.html#Horizontal-Rules-and-Anchors blockToMuse HorizontalRule = return $ blankline $$ "----" $$ blankline blockToMuse (Table caption _ _ headers rows) = do @@ -284,7 +293,11 @@ noteToMuse :: PandocMonad m -> [Block] -> Muse m Doc noteToMuse num note = - hang (length marker) (text marker) <$> blockListToMuse note + hang (length marker) (text marker) <$> + (local (\env -> env { envInsideBlock = True + , envInlineStart = True + , envAfterSpace = True + }) $ blockListToMuse note) where marker = "[" ++ show num ++ "] " @@ -295,6 +308,12 @@ escapeString s = substitute "</verbatim>" "<</verbatim><verbatim>/verbatim>" s ++ "</verbatim>" +-- | Replace newlines with spaces +replaceNewlines :: String -> String +replaceNewlines ('\n':xs) = ' ':replaceNewlines xs +replaceNewlines (x:xs) = x:replaceNewlines xs +replaceNewlines [] = [] + startsWithMarker :: (Char -> Bool) -> String -> Bool startsWithMarker f (' ':xs) = startsWithMarker f xs startsWithMarker f (x:xs) = @@ -321,16 +340,28 @@ containsFootnotes = p s (_:xs) = p xs s [] = False -conditionalEscapeString :: Bool -> String -> String -conditionalEscapeString isInsideLinkDescription s = - if any (`elem` ("#*<=|" :: String)) s || - "::" `isInfixOf` s || - "~~" `isInfixOf` s || - "[[" `isInfixOf` s || - ("]" `isInfixOf` s && isInsideLinkDescription) || - containsFootnotes s - then escapeString s - else s +-- | Return True if string should be escaped with <verbatim> tags +shouldEscapeString :: PandocMonad m + => String + -> Muse m Bool +shouldEscapeString s = do + insideLink <- asks envInsideLinkDescription + return $ null s || + any (`elem` ("#*<=|" :: String)) s || + "::" `isInfixOf` s || + "~~" `isInfixOf` s || + "[[" `isInfixOf` s || + ("]" `isInfixOf` s && insideLink) || + containsFootnotes s + +conditionalEscapeString :: PandocMonad m + => String + -> Muse m String +conditionalEscapeString s = do + shouldEscape <- shouldEscapeString s + return $ if shouldEscape + then escapeString s + else s -- Expand Math and Cite before normalizing inline list preprocessInlineList :: PandocMonad m @@ -389,6 +420,19 @@ fixNotes (Space : n@Note{} : rest) = Str " " : n : fixNotes rest fixNotes (SoftBreak : n@Note{} : rest) = Str " " : n : fixNotes rest fixNotes (x:xs) = x : fixNotes xs +startsWithSpace :: [Inline] -> Bool +startsWithSpace (Space:_) = True +startsWithSpace (SoftBreak:_) = True +startsWithSpace (Str s:_) = stringStartsWithSpace s +startsWithSpace _ = False + +endsWithSpace :: [Inline] -> Bool +endsWithSpace [Space] = True +endsWithSpace [SoftBreak] = True +endsWithSpace [Str s] = stringStartsWithSpace $ reverse s +endsWithSpace (_:xs) = endsWithSpace xs +endsWithSpace [] = False + urlEscapeBrackets :: String -> String urlEscapeBrackets (']':xs) = '%':'5':'D':urlEscapeBrackets xs urlEscapeBrackets (x:xs) = x:urlEscapeBrackets xs @@ -397,22 +441,33 @@ urlEscapeBrackets [] = [] isHorizontalRule :: String -> Bool isHorizontalRule s = length s >= 4 && all (== '-') s -startsWithSpace :: String -> Bool -startsWithSpace (x:_) = isSpace x -startsWithSpace [] = False +stringStartsWithSpace :: String -> Bool +stringStartsWithSpace (x:_) = isSpace x +stringStartsWithSpace "" = False fixOrEscape :: Bool -> Inline -> Bool fixOrEscape sp (Str "-") = sp -fixOrEscape sp (Str ";") = not sp -fixOrEscape _ (Str ">") = True +fixOrEscape sp (Str s@('-':x:_)) = (sp && isSpace x) || isHorizontalRule s +fixOrEscape sp (Str (";")) = not sp +fixOrEscape sp (Str (';':x:_)) = not sp && isSpace x +fixOrEscape _ (Str (">")) = True +fixOrEscape _ (Str ('>':x:_)) = isSpace x fixOrEscape sp (Str s) = (sp && (startsWithMarker isDigit s || startsWithMarker isAsciiLower s || startsWithMarker isAsciiUpper s)) - || isHorizontalRule s || startsWithSpace s + || stringStartsWithSpace s fixOrEscape _ Space = True fixOrEscape _ SoftBreak = True fixOrEscape _ _ = False +inlineListStartsWithAlnum :: PandocMonad m + => [Inline] + -> Muse m Bool +inlineListStartsWithAlnum (Str s:_) = do + esc <- shouldEscapeString s + return $ esc || isAlphaNum (head s) +inlineListStartsWithAlnum _ = return False + -- | Convert list of Pandoc inline elements to Muse renderInlineList :: PandocMonad m => [Inline] @@ -424,86 +479,159 @@ renderInlineList (x:xs) = do start <- asks envInlineStart afterSpace <- asks envAfterSpace topLevel <- asks envTopLevel - r <- inlineToMuse x + insideAsterisks <- asks envInsideAsterisks + nearAsterisks <- asks envNearAsterisks + useTags <- gets stUseTags + alnumNext <- inlineListStartsWithAlnum xs + let newUseTags = useTags || alnumNext + modify $ \st -> st { stUseTags = newUseTags } + + r <- local (\env -> env { envInlineStart = False + , envInsideAsterisks = False + , envNearAsterisks = nearAsterisks || (null xs && insideAsterisks) + }) $ inlineToMuse x opts <- asks envOptions let isNewline = (x == SoftBreak && writerWrapText opts == WrapPreserve) || x == LineBreak lst' <- local (\env -> env { envInlineStart = isNewline , envAfterSpace = x == Space || (not topLevel && isNewline) + , envNearAsterisks = False }) $ renderInlineList xs if start && fixOrEscape afterSpace x then pure (text "<verbatim></verbatim>" <> r <> lst') else pure (r <> lst') -- | Normalize and convert list of Pandoc inline elements to Muse. -inlineListToMuse'' :: PandocMonad m - => Bool - -> [Inline] - -> Muse m Doc -inlineListToMuse'' start lst = do - lst' <- (normalizeInlineList . fixNotes) <$> preprocessInlineList (map (removeKeyValues . replaceSmallCaps) lst) - topLevel <- asks envTopLevel - afterSpace <- asks envAfterSpace - local (\env -> env { envInlineStart = start - , envAfterSpace = afterSpace || (start && not topLevel) - }) $ renderInlineList lst' +inlineListToMuse :: PandocMonad m + => [Inline] + -> Muse m Doc +inlineListToMuse lst = do + lst' <- normalizeInlineList . fixNotes <$> preprocessInlineList (map (removeKeyValues . replaceSmallCaps) lst) + insideAsterisks <- asks envInsideAsterisks + modify $ \st -> st { stUseTags = False } -- Previous character is likely a '>' or some other markup + local (\env -> env { envNearAsterisks = insideAsterisks }) $ renderInlineList lst' inlineListToMuse' :: PandocMonad m => [Inline] -> Muse m Doc -inlineListToMuse' = inlineListToMuse'' True - -inlineListToMuse :: PandocMonad m => [Inline] -> Muse m Doc -inlineListToMuse = inlineListToMuse'' False +inlineListToMuse' lst = do + topLevel <- asks envTopLevel + afterSpace <- asks envAfterSpace + local (\env -> env { envInlineStart = True + , envAfterSpace = afterSpace || not topLevel + }) $ inlineListToMuse lst -- | Convert Pandoc inline element to Muse. inlineToMuse :: PandocMonad m => Inline -> Muse m Doc inlineToMuse (Str str) = do - insideLink <- asks envInsideLinkDescription - return $ text $ conditionalEscapeString insideLink str + escapedStr <- conditionalEscapeString $ replaceNewlines str + let useTags = isAlphaNum $ last escapedStr -- escapedStr is never empty because empty strings are escaped + modify $ \st -> st { stUseTags = useTags } + return $ text escapedStr +inlineToMuse (Emph [Strong lst]) = do + useTags <- gets stUseTags + let lst' = normalizeInlineList lst + if useTags + then do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst' + modify $ \st -> st { stUseTags = False } + return $ "<em>**" <> contents <> "**</em>" + else if null lst' || startsWithSpace lst' || endsWithSpace lst' + then do + contents <- local (\env -> env { envInsideAsterisks = False }) $ inlineListToMuse lst' + modify $ \st -> st { stUseTags = True } + return $ "*<strong>" <> contents <> "</strong>*" + else do + contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst' + modify $ \st -> st { stUseTags = True } + return $ "***" <> contents <> "***" inlineToMuse (Emph lst) = do - contents <- inlineListToMuse lst - return $ "<em>" <> contents <> "</em>" + useTags <- gets stUseTags + let lst' = normalizeInlineList lst + if useTags || null lst' || startsWithSpace lst' || endsWithSpace lst' + then do contents <- inlineListToMuse lst' + return $ "<em>" <> contents <> "</em>" + else do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst' + modify $ \st -> st { stUseTags = True } + return $ "*" <> contents <> "*" +inlineToMuse (Strong [Emph lst]) = do + useTags <- gets stUseTags + let lst' = normalizeInlineList lst + if useTags + then do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst' + modify $ \st -> st { stUseTags = False } + return $ "<strong>*" <> contents <> "*</strong>" + else if null lst' || startsWithSpace lst' || endsWithSpace lst' + then do + contents <- local (\env -> env { envInsideAsterisks = False }) $ inlineListToMuse lst' + modify $ \st -> st { stUseTags = True } + return $ "**<em>" <> contents <> "</em>**" + else do + contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst' + modify $ \st -> st { stUseTags = True } + return $ "***" <> contents <> "***" inlineToMuse (Strong lst) = do - contents <- inlineListToMuse lst - return $ "<strong>" <> contents <> "</strong>" + useTags <- gets stUseTags + let lst' = normalizeInlineList lst + if useTags || null lst' || startsWithSpace lst' || endsWithSpace lst' + then do contents <- inlineListToMuse lst' + modify $ \st -> st { stUseTags = False } + return $ "<strong>" <> contents <> "</strong>" + else do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst' + modify $ \st -> st { stUseTags = True } + return $ "**" <> contents <> "**" inlineToMuse (Strikeout lst) = do contents <- inlineListToMuse lst + modify $ \st -> st { stUseTags = False } return $ "<del>" <> contents <> "</del>" inlineToMuse (Superscript lst) = do contents <- inlineListToMuse lst + modify $ \st -> st { stUseTags = False } return $ "<sup>" <> contents <> "</sup>" inlineToMuse (Subscript lst) = do contents <- inlineListToMuse lst + modify $ \st -> st { stUseTags = False } return $ "<sub>" <> contents <> "</sub>" inlineToMuse SmallCaps {} = fail "SmallCaps should be expanded before normalization" inlineToMuse (Quoted SingleQuote lst) = do contents <- inlineListToMuse lst + modify $ \st -> st { stUseTags = False } return $ "‘" <> contents <> "’" inlineToMuse (Quoted DoubleQuote lst) = do contents <- inlineListToMuse lst + modify $ \st -> st { stUseTags = False } return $ "“" <> contents <> "”" inlineToMuse Cite {} = fail "Citations should be expanded before normalization" -inlineToMuse (Code _ str) = return $ - "<code>" <> text (substitute "</code>" "<</code><code>/code>" str) <> "</code>" +inlineToMuse (Code _ str) = do + useTags <- gets stUseTags + modify $ \st -> st { stUseTags = False } + return $ if useTags || null str || '=' `elem` str || isSpace (head str) || isSpace (last str) + then "<code>" <> text (substitute "</code>" "<</code><code>/code>" str) <> "</code>" + else "=" <> text str <> "=" inlineToMuse Math{} = fail "Math should be expanded before normalization" -inlineToMuse (RawInline (Format f) str) = +inlineToMuse (RawInline (Format f) str) = do + modify $ \st -> st { stUseTags = False } return $ "<literal style=\"" <> text f <> "\">" <> text str <> "</literal>" inlineToMuse LineBreak = do oneline <- asks envOneLine + modify $ \st -> st { stUseTags = False } return $ if oneline then "<br>" else "<br>" <> cr -inlineToMuse Space = return space +inlineToMuse Space = do + modify $ \st -> st { stUseTags = False } + return space inlineToMuse SoftBreak = do oneline <- asks envOneLine wrapText <- asks $ writerWrapText . envOptions + modify $ \st -> st { stUseTags = False } return $ if not oneline && wrapText == WrapPreserve then cr else space inlineToMuse (Link _ txt (src, _)) = case txt of - [Str x] | escapeURI x == src -> + [Str x] | escapeURI x == src -> do + modify $ \st -> st { stUseTags = False } return $ "[[" <> text (escapeLink x) <> "]]" _ -> do contents <- local (\env -> env { envInsideLinkDescription = True }) $ inlineListToMuse txt + modify $ \st -> st { stUseTags = False } return $ "[[" <> text (escapeLink src) <> "][" <> contents <> "]]" where escapeLink lnk = if isImageUrl lnk then "URL:" ++ urlEscapeBrackets lnk else urlEscapeBrackets lnk -- Taken from muse-image-regexp defined in Emacs Muse file lisp/muse-regexps.el @@ -514,11 +642,12 @@ inlineToMuse (Image attr alt (source,'f':'i':'g':':':title)) = inlineToMuse (Image attr@(_, classes, _) inlines (source, title)) = do opts <- asks envOptions alt <- local (\env -> env { envInsideLinkDescription = True }) $ inlineListToMuse inlines - let title' = if null title - then if null inlines - then "" - else "[" <> alt <> "]" - else "[" <> text (conditionalEscapeString True title) <> "]" + title' <- if null title + then if null inlines + then return "" + else return $ "[" <> alt <> "]" + else do s <- local (\env -> env { envInsideLinkDescription = True }) $ conditionalEscapeString title + return $ "[" <> text s <> "]" let width = case dimension Width attr of Just (Percent x) | isEnabled Ext_amuse opts -> " " ++ show (round x :: Integer) _ -> "" @@ -528,11 +657,14 @@ inlineToMuse (Image attr@(_, classes, _) inlines (source, title)) = do let rightalign = if "align-right" `elem` classes then " r" else "" + modify $ \st -> st { stUseTags = False } return $ "[[" <> text (urlEscapeBrackets source ++ width ++ leftalign ++ rightalign) <> "]" <> title' <> "]" inlineToMuse (Note contents) = do -- add to notes in state notes <- gets stNotes - modify $ \st -> st { stNotes = contents:notes } + modify $ \st -> st { stNotes = contents:notes + , stUseTags = False + } let ref = show $ length notes + 1 return $ "[" <> text ref <> "]" inlineToMuse (Span (anchor,names,_) inlines) = do @@ -540,6 +672,7 @@ inlineToMuse (Span (anchor,names,_) inlines) = do let anchorDoc = if null anchor then mempty else text ('#':anchor) <> space + modify $ \st -> st { stUseTags = False } return $ anchorDoc <> (if null inlines && not (null anchor) then mempty else (if null names diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 7aecb3da5..1c9481630 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -189,8 +189,8 @@ transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = catchError let dims = case (getDim Width, getDim Height) of (Just w, Just h) -> [("width", show w), ("height", show h)] - (Just w@(Percent p), Nothing) -> [("width", show w), ("height", show (p / ratio) ++ "%")] - (Nothing, Just h@(Percent p)) -> [("width", show (p * ratio) ++ "%"), ("height", show h)] + (Just w@(Percent _), Nothing) -> [("rel-width", show w),("rel-height", "scale"),("width", show ptX ++ "pt"),("height", show ptY ++ "pt")] + (Nothing, Just h@(Percent _)) -> [("rel-width", "scale"),("rel-height", show h),("width", show ptX ++ "pt"),("height", show ptY ++ "pt")] (Just w@(Inch i), Nothing) -> [("width", show w), ("height", show (i / ratio) ++ "in")] (Nothing, Just h@(Inch i)) -> [("width", show (i * ratio) ++ "in"), ("height", show h)] _ -> [("width", show ptX ++ "pt"), ("height", show ptY ++ "pt")] diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs index 6c48046a2..716c5cbad 100644 --- a/src/Text/Pandoc/Writers/OPML.hs +++ b/src/Text/Pandoc/Writers/OPML.hs @@ -62,7 +62,8 @@ writeOPML opts (Pandoc meta blocks) = do meta' main <- (render colwidth . vcat) <$> mapM (elementToOPML opts) elements let context = defField "body" main metadata - case writerTemplate opts of + (if writerPreferAscii opts then toEntities else id) <$> + case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 514327e9a..d9f0a8e44 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -39,17 +39,20 @@ import Control.Monad.State.Strict hiding (when) import Data.Char (chr) import Data.List (sortBy) import qualified Data.Map as Map +import Data.Maybe (fromMaybe) import Data.Ord (comparing) import qualified Data.Set as Set import Data.Text (Text) import Text.Pandoc.BCP47 (Lang (..), parseBCP47) -import Text.Pandoc.Class (PandocMonad, report) +import Text.Pandoc.Class (PandocMonad, report, translateTerm, + setTranslations, toLang) import Text.Pandoc.Definition import Text.Pandoc.Logging import Text.Pandoc.Options import Text.Pandoc.Pretty import Text.Pandoc.Shared (linesToPara) import Text.Pandoc.Templates (renderTemplate') +import qualified Text.Pandoc.Translations as Term (Term(Figure, Table)) import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Shared import Text.Pandoc.XML @@ -67,32 +70,36 @@ plainToPara x = x type OD m = StateT WriterState m data WriterState = - WriterState { stNotes :: [Doc] - , stTableStyles :: [Doc] - , stParaStyles :: [Doc] - , stListStyles :: [(Int, [Doc])] - , stTextStyles :: Map.Map (Set.Set TextStyle) (String, Doc) - , stTextStyleAttr :: Set.Set TextStyle - , stIndentPara :: Int - , stInDefinition :: Bool - , stTight :: Bool - , stFirstPara :: Bool - , stImageId :: Int + WriterState { stNotes :: [Doc] + , stTableStyles :: [Doc] + , stParaStyles :: [Doc] + , stListStyles :: [(Int, [Doc])] + , stTextStyles :: Map.Map (Set.Set TextStyle) (String, Doc) + , stTextStyleAttr :: Set.Set TextStyle + , stIndentPara :: Int + , stInDefinition :: Bool + , stTight :: Bool + , stFirstPara :: Bool + , stImageId :: Int + , stTableCaptionId :: Int + , stImageCaptionId :: Int } defaultWriterState :: WriterState defaultWriterState = - WriterState { stNotes = [] - , stTableStyles = [] - , stParaStyles = [] - , stListStyles = [] - , stTextStyles = Map.empty - , stTextStyleAttr = Set.empty - , stIndentPara = 0 - , stInDefinition = False - , stTight = False - , stFirstPara = False - , stImageId = 1 + WriterState { stNotes = [] + , stTableStyles = [] + , stParaStyles = [] + , stListStyles = [] + , stTextStyles = Map.empty + , stTextStyleAttr = Set.empty + , stIndentPara = 0 + , stInDefinition = False + , stTight = False + , stFirstPara = False + , stImageId = 1 + , stTableCaptionId = 1 + , stImageCaptionId = 1 } when :: Bool -> Doc -> Doc @@ -193,10 +200,15 @@ formulaStyle mt = inTags False "style:style" ,("style:horizontal-rel", "paragraph-content") ,("style:wrap", "none")] -inHeaderTags :: PandocMonad m => Int -> Doc -> OD m Doc -inHeaderTags i d = +inHeaderTags :: PandocMonad m => Int -> String -> Doc -> OD m Doc +inHeaderTags i ident d = return $ inTags False "text:h" [ ("text:style-name", "Heading_20_" ++ show i) - , ("text:outline-level", show i)] d + , ("text:outline-level", show i)] + $ if null ident + then d + else selfClosingTag "text:bookmark-start" [ ("text:name", ident) ] + <> d <> + selfClosingTag "text:bookmark-end" [ ("text:name", ident) ] inQuotes :: QuoteType -> Doc -> Doc inQuotes SingleQuote s = char '\8216' <> s <> char '\8217' @@ -218,6 +230,11 @@ handleSpaces s -- | Convert Pandoc document to string in OpenDocument format. writeOpenDocument :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeOpenDocument opts (Pandoc meta blocks) = do + let defLang = Lang "en" "US" "" [] + lang <- case lookupMetaString "lang" meta of + "" -> pure defLang + s -> fromMaybe defLang <$> toLang (Just s) + setTranslations lang let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing @@ -349,8 +366,9 @@ blockToOpenDocument o bs | LineBlock b <- bs = blockToOpenDocument o $ linesToPara b | Div attr xs <- bs = withLangFromAttr attr (blocksToOpenDocument o xs) - | Header i _ b <- bs = setFirstPara >> - (inHeaderTags i =<< inlinesToOpenDocument o b) + | Header i (ident,_,_) b + <- bs = setFirstPara >> (inHeaderTags i ident + =<< inlinesToOpenDocument o b) | BlockQuote b <- bs = setFirstPara >> mkBlockQuote b | DefinitionList b <- bs = setFirstPara >> defList b | BulletList b <- bs = setFirstPara >> bulletListToOpenDocument o b @@ -394,11 +412,11 @@ blockToOpenDocument o bs mapM_ addParaStyle . newPara $ paraHStyles ++ paraStyles captionDoc <- if null c then return empty - else withParagraphStyle o "Table" [Para c] + else inlinesToOpenDocument o c >>= numberedTableCaption th <- if all null h then return empty - else colHeadsToOpenDocument o name (map fst paraHStyles) h - tr <- mapM (tableRowToOpenDocument o name (map fst paraStyles)) r + else colHeadsToOpenDocument o (map fst paraHStyles) h + tr <- mapM (tableRowToOpenDocument o (map fst paraStyles)) r return $ inTags True "table:table" [ ("table:name" , name) , ("table:style-name", name) ] (vcat columns $$ th $$ vcat tr) $$ captionDoc @@ -406,28 +424,54 @@ blockToOpenDocument o bs withParagraphStyle o "Figure" [Para [Image attr caption (source,title)]] | otherwise = do imageDoc <- withParagraphStyle o "FigureWithCaption" [Para [Image attr caption (source,title)]] - captionDoc <- withParagraphStyle o "FigureCaption" [Para caption] + captionDoc <- inlinesToOpenDocument o caption >>= numberedFigureCaption return $ imageDoc $$ captionDoc + +numberedTableCaption :: PandocMonad m => Doc -> OD m Doc +numberedTableCaption caption = do + id' <- gets stTableCaptionId + modify (\st -> st{ stTableCaptionId = id' + 1 }) + capterm <- translateTerm Term.Table + return $ numberedCaption "Table" capterm "Table" id' caption + +numberedFigureCaption :: PandocMonad m => Doc -> OD m Doc +numberedFigureCaption caption = do + id' <- gets stImageCaptionId + modify (\st -> st{ stImageCaptionId = id' + 1 }) + capterm <- translateTerm Term.Figure + return $ numberedCaption "FigureCaption" capterm "Illustration" id' caption + +numberedCaption :: String -> String -> String -> Int -> Doc -> Doc +numberedCaption style term name num caption = + let t = text term + r = num - 1 + s = inTags False "text:sequence" [ ("text:ref-name", "ref" ++ name ++ show r), + ("text:name", name), + ("text:formula", "ooow:" ++ name ++ "+1"), + ("style:num-format", "1") ] $ text $ show num + c = text ": " + in inParagraphTagsWithStyle style $ hcat [ t, text " ", s, c, caption ] + colHeadsToOpenDocument :: PandocMonad m - => WriterOptions -> String -> [String] -> [[Block]] + => WriterOptions -> [String] -> [[Block]] -> OD m Doc -colHeadsToOpenDocument o tn ns hs = +colHeadsToOpenDocument o ns hs = inTagsIndented "table:table-header-rows" . inTagsIndented "table:table-row" . vcat <$> - mapM (tableItemToOpenDocument o tn) (zip ns hs) + mapM (tableItemToOpenDocument o "TableHeaderRowCell") (zip ns hs) tableRowToOpenDocument :: PandocMonad m - => WriterOptions -> String -> [String] -> [[Block]] + => WriterOptions -> [String] -> [[Block]] -> OD m Doc -tableRowToOpenDocument o tn ns cs = +tableRowToOpenDocument o ns cs = inTagsIndented "table:table-row" . vcat <$> - mapM (tableItemToOpenDocument o tn) (zip ns cs) + mapM (tableItemToOpenDocument o "TableRowCell") (zip ns cs) tableItemToOpenDocument :: PandocMonad m => WriterOptions -> String -> (String,[Block]) -> OD m Doc -tableItemToOpenDocument o tn (n,i) = - let a = [ ("table:style-name" , tn ++ ".A1" ) +tableItemToOpenDocument o s (n,i) = + let a = [ ("table:style-name" , s ) , ("office:value-type", "string" ) ] in inTags True "table:table-cell" a <$> @@ -500,7 +544,9 @@ inlineToOpenDocument o ils modify (\st -> st{ stImageId = id' + 1 }) let getDims [] = [] getDims (("width", w) :xs) = ("svg:width", w) : getDims xs + getDims (("rel-width", w):xs) = ("style:rel-width", w) : getDims xs getDims (("height", h):xs) = ("svg:height", h) : getDims xs + getDims (("rel-height", w):xs) = ("style:rel-height", w) : getDims xs getDims (_:xs) = getDims xs return $ inTags False "draw:frame" (("draw:name", "img" ++ show id') : getDims kvs) $ @@ -555,10 +601,18 @@ orderedListLevelStyle (s,n, d) (l,ls) = listLevelStyle :: Int -> Doc listLevelStyle i = - let indent = show (0.4 * fromIntegral (i - 1) :: Double) in - selfClosingTag "style:list-level-properties" - [ ("text:space-before" , indent ++ "in") - , ("text:min-label-width", "0.4in")] + let indent = show (0.5 * fromIntegral i :: Double) in + inTags True "style:list-level-properties" + [ ("text:list-level-position-and-space-mode", + "label-alignment") + , ("fo:text-align", "right") + ] $ + selfClosingTag "style:list-level-label-alignment" + [ ("text:label-followed-by", "listtab") + , ("text:list-tab-stop-position", indent ++ "in") + , ("fo:text-indent", "-0.1in") + , ("fo:margin-left", indent ++ "in") + ] tableStyle :: Int -> [(Char,Double)] -> Doc tableStyle num wcs = @@ -576,13 +630,21 @@ tableStyle num wcs = , ("style:family", "table-column" )] $ selfClosingTag "style:table-column-properties" [("style:rel-column-width", printf "%d*" (floor $ w * 65535 :: Integer))] - cellStyle = inTags True "style:style" - [ ("style:name" , tableId ++ ".A1") + headerRowCellStyle = inTags True "style:style" + [ ("style:name" , "TableHeaderRowCell") + , ("style:family", "table-cell" )] $ + selfClosingTag "style:table-cell-properties" + [ ("fo:border", "none")] + rowCellStyle = inTags True "style:style" + [ ("style:name" , "TableRowCell") , ("style:family", "table-cell" )] $ selfClosingTag "style:table-cell-properties" [ ("fo:border", "none")] + cellStyles = if num == 0 + then headerRowCellStyle $$ rowCellStyle + else empty columnStyles = map colStyle wcs - in table $$ vcat columnStyles $$ cellStyle + in cellStyles $$ table $$ vcat columnStyles paraStyle :: PandocMonad m => [(String,String)] -> OD m Int paraStyle attrs = do diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index a71775e13..12a54fd71 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -109,7 +109,7 @@ escapeString = escapeStringUsing $ , ('\x2013',"--") , ('\x2019',"'") , ('\x2026',"...") - ] ++ backslashEscapes "^_" + ] isRawFormat :: Format -> Bool isRawFormat f = @@ -266,7 +266,7 @@ orderedListItemToOrg marker items = do contents <- blockListToOrg items return $ hang (length marker + 1) (text marker <> space) (contents <> cr) --- | Convert defintion list item (label, list of blocks) to Org. +-- | Convert definition list item (label, list of blocks) to Org. definitionListItemToOrg :: PandocMonad m => ([Inline], [[Block]]) -> Org m Doc definitionListItemToOrg (label, defs) = do diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs index e14476b16..c97d8d770 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs @@ -72,7 +72,7 @@ import Text.Pandoc.Logging import Text.Pandoc.Walk import Data.Time (UTCTime) import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element" -import Text.Pandoc.Writers.Shared (metaValueToInlines) +import Text.Pandoc.Writers.Shared (lookupMetaInlines) import qualified Data.Map as M import qualified Data.Set as S import Data.Maybe (maybeToList, fromMaybe) @@ -731,9 +731,9 @@ makeEndNotesSlideBlocks = do anchorSet <- M.keysSet <$> gets stAnchorMap if M.null noteIds then return [] - else let title = case lookupMeta "notes-title" meta of - Just val -> metaValueToInlines val - Nothing -> [Str "Notes"] + else let title = case lookupMetaInlines "notes-title" meta of + [] -> [Str "Notes"] + ls -> ls ident = Shared.uniqueIdent title anchorSet hdr = Header slideLevel (ident, [], []) title blks = concatMap (\(n, bs) -> makeNoteEntry n bs) $ @@ -744,13 +744,7 @@ getMetaSlide :: Pres (Maybe Slide) getMetaSlide = do meta <- asks envMetadata title <- inlinesToParElems $ docTitle meta - subtitle <- inlinesToParElems $ - case lookupMeta "subtitle" meta of - Just (MetaString s) -> [Str s] - Just (MetaInlines ils) -> ils - Just (MetaBlocks [Plain ils]) -> ils - Just (MetaBlocks [Para ils]) -> ils - _ -> [] + subtitle <- inlinesToParElems $ lookupMetaInlines "subtitle" meta authors <- mapM inlinesToParElems $ docAuthors meta date <- inlinesToParElems $ docDate meta if null title && null subtitle && null authors && null date @@ -785,9 +779,9 @@ makeTOCSlide blks = local (\env -> env{envCurSlideId = tocSlideId}) $ do contents <- BulletList <$> mapM elementToListItem (Shared.hierarchicalize blks) meta <- asks envMetadata slideLevel <- asks envSlideLevel - let tocTitle = case lookupMeta "toc-title" meta of - Just val -> metaValueToInlines val - Nothing -> [Str "Table of Contents"] + let tocTitle = case lookupMetaInlines "toc-title" meta of + [] -> [Str "Table of Contents"] + ls -> ls hdr = Header slideLevel nullAttr tocTitle blocksToSlide [hdr, contents] diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index f82597c55..d64529c21 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -35,7 +35,7 @@ module Text.Pandoc.Writers.RST ( writeRST, flatten ) where import Prelude import Control.Monad.State.Strict import Data.Char (isSpace, toLower) -import Data.List (isPrefixOf, stripPrefix) +import Data.List (isPrefixOf, stripPrefix, transpose) import Data.Maybe (fromMaybe) import Data.Text (Text, stripEnd) import qualified Text.Pandoc.Builder as B @@ -82,14 +82,12 @@ pandocToRST (Pandoc meta blocks) = do else Nothing let render' :: Doc -> Text render' = render colwidth - let subtit = case lookupMeta "subtitle" meta of - Just (MetaBlocks [Plain xs]) -> xs - _ -> [] + let subtit = lookupMetaInlines "subtitle" meta title <- titleToRST (docTitle meta) subtit metadata <- metaToJSON opts (fmap render' . blockListToRST) (fmap (stripEnd . render') . inlineListToRST) - $ B.deleteMeta "title" $ B.deleteMeta "subtitle" meta + meta body <- blockListToRST' True $ case writerTemplate opts of Just _ -> normalizeHeadings 1 blocks Nothing -> blocks @@ -103,8 +101,9 @@ pandocToRST (Pandoc meta blocks) = do let context = defField "body" main $ defField "toc" (writerTableOfContents opts) $ defField "toc-depth" (show $ writerTOCDepth opts) + $ defField "number-sections" (writerNumberSections opts) $ defField "math" hasMath - $ defField "title" (render Nothing title :: String) + $ defField "titleblock" (render Nothing title :: String) $ defField "math" hasMath $ defField "rawtex" rawTeX metadata case writerTemplate opts of @@ -209,11 +208,26 @@ blockToRST :: PandocMonad m => Block -- ^ Block element -> RST m Doc blockToRST Null = return empty -blockToRST (Div attr bs) = do +blockToRST (Div ("",["admonition-title"],[]) _) = return empty + -- this is generated by the rst reader and can safely be + -- omitted when we're generating rst +blockToRST (Div (ident,classes,_kvs) bs) = do contents <- blockListToRST bs - let startTag = ".. raw:: html" $+$ nest 3 (tagWithAttrs "div" attr) - let endTag = ".. raw:: html" $+$ nest 3 "</div>" - return $ blankline <> startTag $+$ contents $+$ endTag $$ blankline + let admonitions = ["attention","caution","danger","error","hint", + "important","note","tip","warning","admonition"] + let admonition = case classes of + (cl:_) + | cl `elem` admonitions + -> ".. " <> text cl <> "::" + cls -> ".. container::" <> space <> + text (unwords (filter (/= "container") cls)) + return $ blankline $$ + admonition $$ + (if null ident + then blankline + else " :name: " <> text ident $$ blankline) $$ + nest 3 contents $$ + blankline blockToRST (Plain inlines) = inlineListToRST inlines -- title beginning with fig: indicates that the image is a figure blockToRST (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do @@ -236,6 +250,7 @@ blockToRST (LineBlock lns) = linesToLineBlock lns blockToRST (RawBlock f@(Format f') str) | f == "rst" = return $ text str + | f == "tex" = blockToRST (RawBlock (Format "latex") str) | otherwise = return $ blankline <> ".. raw:: " <> text (map toLower f') $+$ nest 3 (text str) $$ blankline @@ -272,7 +287,8 @@ blockToRST (CodeBlock (_,classes,kvs) str) = do then return $ prefixed "> " (text str) $$ blankline else return $ (case [c | c <- classes, - c `notElem` ["sourceCode","literate","numberLines"]] of + c `notElem` ["sourceCode","literate","numberLines", + "number-lines","example"]] of [] -> "::" (lang:_) -> (".. code:: " <> text lang) $$ numberlines) $+$ nest 3 (text str) $$ blankline @@ -288,9 +304,12 @@ blockToRST (Table caption aligns widths headers rows) = do modify $ \st -> st{ stOptions = oldOpts } return result opts <- gets stOptions - tbl <- gridTable opts blocksToDoc (all null headers) - (map (const AlignDefault) aligns) widths - headers rows + let isSimple = all (== 0) widths + tbl <- if isSimple + then simpleTable opts blocksToDoc headers rows + else gridTable opts blocksToDoc (all null headers) + (map (const AlignDefault) aligns) widths + headers rows return $ if null caption then tbl $$ blankline else (".. table:: " <> caption') $$ blankline $$ nest 3 tbl $$ @@ -331,7 +350,7 @@ orderedListItemToRST marker items = do let marker' = marker ++ " " return $ hang (length marker') (text marker') $ contents <> cr --- | Convert defintion list item (label, list of blocks) to RST. +-- | Convert definition list item (label, list of blocks) to RST. definitionListItemToRST :: PandocMonad m => ([Inline], [[Block]]) -> RST m Doc definitionListItemToRST (label, defs) = do label' <- inlineListToRST label @@ -470,6 +489,8 @@ flatten outer -- them and they will be readable and parsable (Quoted _ _, _) -> keep f i (_, Quoted _ _) -> keep f i + -- inlineToRST handles this case properly so it's safe to keep + (Link _ _ _, Image _ _ _) -> keep f i -- parent inlines would prevent links from being correctly -- parsed, in this case we prioritise the content over the -- style @@ -569,15 +590,18 @@ inlineToRST (Quoted DoubleQuote lst) = do else return $ "“" <> contents <> "”" inlineToRST (Cite _ lst) = writeInlines lst +inlineToRST (Code (_,["interpreted-text"],[("role",role)]) str) = do + return $ ":" <> text role <> ":`" <> text str <> "`" inlineToRST (Code _ str) = do opts <- gets stOptions -- we trim the string because the delimiters must adjoin a -- non-space character; see #3496 -- we use :literal: when the code contains backticks, since -- :literal: allows backslash-escapes; see #3974 - return $ if '`' `elem` str - then ":literal:`" <> text (escapeString opts (trim str)) <> "`" - else "``" <> text (trim str) <> "``" + return $ + if '`' `elem` str + then ":literal:`" <> text (escapeString opts (trim str)) <> "`" + else "``" <> text (trim str) <> "``" inlineToRST (Str str) = do opts <- gets stOptions return $ text $ @@ -672,3 +696,30 @@ imageDimsToRST attr = do Just dim -> cols dim Nothing -> empty return $ cr <> name $$ showDim Width $$ showDim Height + +simpleTable :: PandocMonad m + => WriterOptions + -> (WriterOptions -> [Block] -> m Doc) + -> [[Block]] + -> [[[Block]]] + -> m Doc +simpleTable opts blocksToDoc headers rows = do + -- can't have empty cells in first column: + let fixEmpties (d:ds) = if isEmpty d + then text "\\ " : ds + else d : ds + fixEmpties [] = [] + headerDocs <- if all null headers + then return [] + else fixEmpties <$> mapM (blocksToDoc opts) headers + rowDocs <- mapM (fmap fixEmpties . mapM (blocksToDoc opts)) rows + let numChars [] = 0 + numChars xs = maximum . map offset $ xs + let colWidths = map numChars $ transpose (headerDocs : rowDocs) + let toRow = hsep . zipWith lblock colWidths + let hline = hsep (map (\n -> text (replicate n '=')) colWidths) + let hdr = if all null headers + then mempty + else hline $$ toRow headerDocs + let bdy = vcat $ map toRow rowDocs + return $ hdr $$ hline $$ bdy $$ hline diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 3045c1c10..ed8dc9ae4 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -341,8 +341,10 @@ listItemToRTF :: PandocMonad m listItemToRTF alignment indent marker [] = return $ rtfCompact (indent + listIncrement) (negate listIncrement) alignment (marker ++ "\\tx" ++ show listIncrement ++ "\\tab ") -listItemToRTF alignment indent marker list = do - (first:rest) <- mapM (blockToRTF (indent + listIncrement) alignment) list +listItemToRTF alignment indent marker (listFirst:listRest) = do + let f = blockToRTF (indent + listIncrement) alignment + first <- f listFirst + rest <- mapM f listRest let listMarker = "\\fi" ++ show (negate listIncrement) ++ " " ++ marker ++ "\\tx" ++ show listIncrement ++ "\\tab" let insertListMarker ('\\':'f':'i':'-':d:xs) | isDigit d = diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 2edce7deb..ed2c46d7b 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -38,17 +38,27 @@ module Text.Pandoc.Writers.Shared ( , resetField , defField , tagWithAttrs + , isDisplayMath , fixDisplayMath , unsmartify + , hasSimpleCells , gridTable - , metaValueToInlines + , lookupMetaBool + , lookupMetaBlocks + , lookupMetaInlines + , lookupMetaString , stripLeadingTrailingSpace + , groffEscape + , toSubscript + , toSuperscript ) where import Prelude import Control.Monad (zipWithM) +import Data.Monoid (Any (..)) import Data.Aeson (FromJSON (..), Result (..), ToJSON (..), Value (Object), encode, fromJSON) +import Data.Char (chr, ord, isAscii, isSpace) import qualified Data.HashMap.Strict as H import Data.List (groupBy, intersperse, transpose) import qualified Data.Map as M @@ -59,9 +69,11 @@ import qualified Text.Pandoc.Builder as Builder import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Pretty -import Text.Pandoc.Walk (query) +import Text.Pandoc.Shared (stringify) import Text.Pandoc.UTF8 (toStringLazy) import Text.Pandoc.XML (escapeStringForXML) +import Text.Pandoc.Walk (query) +import Text.Printf (printf) -- | Create JSON value for template from a 'Meta' and an association list -- of variables, specified at the command line or in the writer. @@ -187,8 +199,9 @@ tagWithAttrs tag (ident,classes,kvs) = hsep ] <> ">" isDisplayMath :: Inline -> Bool -isDisplayMath (Math DisplayMath _) = True -isDisplayMath _ = False +isDisplayMath (Math DisplayMath _) = True +isDisplayMath (Span _ [Math DisplayMath _]) = True +isDisplayMath _ = False stripLeadingTrailingSpace :: [Inline] -> [Inline] stripLeadingTrailingSpace = go . reverse . go . reverse @@ -233,6 +246,21 @@ unsmartify opts ('\8216':xs) = '\'' : unsmartify opts xs unsmartify opts (x:xs) = x : unsmartify opts xs unsmartify _ [] = [] +-- | True if block is a table that can be represented with +-- one line per row. +hasSimpleCells :: Block -> Bool +hasSimpleCells (Table _caption _aligns _widths headers rows) = + all isSimpleCell (concat (headers:rows)) + where + isLineBreak LineBreak = Any True + isLineBreak _ = Any False + hasLineBreak = getAny . query isLineBreak + isSimpleCell [Plain ils] = not (hasLineBreak ils) + isSimpleCell [Para ils ] = not (hasLineBreak ils) + isSimpleCell [] = True + isSimpleCell _ = False +hasSimpleCells _ = False + gridTable :: Monad m => WriterOptions -> (WriterOptions -> [Block] -> m Doc) @@ -332,9 +360,82 @@ gridTable opts blocksToDoc headless aligns widths headers rows = do body $$ border '-' (repeat AlignDefault) widthsInChars -metaValueToInlines :: MetaValue -> [Inline] -metaValueToInlines (MetaString s) = [Str s] -metaValueToInlines (MetaInlines ils) = ils -metaValueToInlines (MetaBlocks bs) = query return bs -metaValueToInlines (MetaBool b) = [Str $ show b] -metaValueToInlines _ = [] + + +-- | Retrieve the metadata value for a given @key@ +-- and convert to Bool. +lookupMetaBool :: String -> Meta -> Bool +lookupMetaBool key meta = + case lookupMeta key meta of + Just (MetaBlocks _) -> True + Just (MetaInlines _) -> True + Just (MetaString (_:_)) -> True + Just (MetaBool True) -> True + _ -> False + +-- | Retrieve the metadata value for a given @key@ +-- and extract blocks. +lookupMetaBlocks :: String -> Meta -> [Block] +lookupMetaBlocks key meta = + case lookupMeta key meta of + Just (MetaBlocks bs) -> bs + Just (MetaInlines ils) -> [Plain ils] + Just (MetaString s) -> [Plain [Str s]] + _ -> [] + +-- | Retrieve the metadata value for a given @key@ +-- and extract inlines. +lookupMetaInlines :: String -> Meta -> [Inline] +lookupMetaInlines key meta = + case lookupMeta key meta of + Just (MetaString s) -> [Str s] + Just (MetaInlines ils) -> ils + Just (MetaBlocks [Plain ils]) -> ils + Just (MetaBlocks [Para ils]) -> ils + _ -> [] + +-- | Retrieve the metadata value for a given @key@ +-- and convert to String. +lookupMetaString :: String -> Meta -> String +lookupMetaString key meta = + case lookupMeta key meta of + Just (MetaString s) -> s + Just (MetaInlines ils) -> stringify ils + Just (MetaBlocks bs) -> stringify bs + Just (MetaBool b) -> show b + _ -> "" + +-- | Escape non-ASCII characters using groff \u[..] sequences. +groffEscape :: T.Text -> T.Text +groffEscape = T.concatMap toUchar + where toUchar c + | isAscii c = T.singleton c + | otherwise = T.pack $ printf "\\[u%04X]" (ord c) + + +toSuperscript :: Char -> Maybe Char +toSuperscript '1' = Just '\x00B9' +toSuperscript '2' = Just '\x00B2' +toSuperscript '3' = Just '\x00B3' +toSuperscript '+' = Just '\x207A' +toSuperscript '-' = Just '\x207B' +toSuperscript '=' = Just '\x207C' +toSuperscript '(' = Just '\x207D' +toSuperscript ')' = Just '\x207E' +toSuperscript c + | c >= '0' && c <= '9' = + Just $ chr (0x2070 + (ord c - 48)) + | isSpace c = Just c + | otherwise = Nothing + +toSubscript :: Char -> Maybe Char +toSubscript '+' = Just '\x208A' +toSubscript '-' = Just '\x208B' +toSubscript '=' = Just '\x208C' +toSubscript '(' = Just '\x208D' +toSubscript ')' = Just '\x208E' +toSubscript c + | c >= '0' && c <= '9' = + Just $ chr (0x2080 + (ord c - 48)) + | isSpace c = Just c + | otherwise = Nothing diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs index e461f5715..9169c8515 100644 --- a/src/Text/Pandoc/Writers/TEI.hs +++ b/src/Text/Pandoc/Writers/TEI.hs @@ -35,7 +35,6 @@ import Prelude import Data.Char (toLower) import Data.List (isPrefixOf, stripPrefix) import Data.Text (Text) -import qualified Text.Pandoc.Builder as B import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Definition import Text.Pandoc.Highlighting (languages, languagesByExtension) @@ -48,16 +47,6 @@ import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Writers.Shared import Text.Pandoc.XML --- | Convert list of authors to a docbook <author> section -authorToTEI :: PandocMonad m => WriterOptions -> [Inline] -> m B.Inlines -authorToTEI opts name' = do - name <- render Nothing <$> inlinesToTEI opts name' - let colwidth = if writerWrapText opts == WrapAuto - then Just $ writerColumns opts - else Nothing - return $ B.rawInline "tei" $ render colwidth $ - inTagsSimple "author" (text $ escapeStringForXML name) - -- | Convert Pandoc document to string in Docbook format. writeTEI :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeTEI opts (Pandoc meta blocks) = do @@ -72,13 +61,11 @@ writeTEI opts (Pandoc meta blocks) = do TopLevelChapter -> 0 TopLevelSection -> 1 TopLevelDefault -> 1 - auths' <- mapM (authorToTEI opts) $ docAuthors meta - let meta' = B.setMeta "author" auths' meta metadata <- metaToJSON opts (fmap (render' . vcat) . mapM (elementToTEI opts startLvl) . hierarchicalize) (fmap render' . inlinesToTEI opts) - meta' + meta main <- (render' . vcat) <$> mapM (elementToTEI opts startLvl) elements let context = defField "body" main $ diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 305b41206..21d1f4eca 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -56,8 +56,6 @@ import Text.Printf (printf) data WriterState = WriterState { stStrikeout :: Bool -- document contains strikeout - , stSuperscript :: Bool -- document contains superscript - , stSubscript :: Bool -- document contains subscript , stEscapeComma :: Bool -- in a context where we need @comma , stIdentifiers :: Set.Set String -- header ids used already , stOptions :: WriterOptions -- writer options @@ -74,8 +72,7 @@ type TI m = StateT WriterState m writeTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeTexinfo options document = evalStateT (pandocToTexinfo options $ wrapTop document) - WriterState { stStrikeout = False, stSuperscript = False, - stEscapeComma = False, stSubscript = False, + WriterState { stStrikeout = False, stEscapeComma = False, stIdentifiers = Set.empty, stOptions = options} -- | Add a "Top" node around the document, needed by Texinfo. @@ -102,8 +99,6 @@ pandocToTexinfo options (Pandoc meta blocks) = do let context = defField "body" body $ defField "toc" (writerTableOfContents options) $ defField "titlepage" titlePage - $ defField "subscript" (stSubscript st) - $ defField "superscript" (stSuperscript st) $ defField "strikeout" (stStrikeout st) metadata case writerTemplate options of @@ -351,12 +346,9 @@ collectNodes :: Int -> [Block] -> [Block] collectNodes _ [] = [] collectNodes level (x:xs) = case x of - (Header hl _ _) -> - if hl < level - then [] - else if hl == level - then x : collectNodes level xs - else collectNodes level xs + (Header hl _ _) | hl < level -> [] + | hl == level -> x : collectNodes level xs + | otherwise -> collectNodes level xs _ -> collectNodes level xs @@ -394,7 +386,7 @@ defListItemToTexinfo (term, defs) = do inlineListToTexinfo :: PandocMonad m => [Inline] -- ^ Inlines to convert -> TI m Doc -inlineListToTexinfo lst = mapM inlineToTexinfo lst >>= return . hcat +inlineListToTexinfo lst = hcat <$> mapM inlineToTexinfo lst -- | Convert list of inline elements to Texinfo acceptable for a node name. inlineListForNode :: PandocMonad m @@ -416,10 +408,10 @@ inlineToTexinfo (Span _ lst) = inlineListToTexinfo lst inlineToTexinfo (Emph lst) = - inlineListToTexinfo lst >>= return . inCmd "emph" + inCmd "emph" <$> inlineListToTexinfo lst inlineToTexinfo (Strong lst) = - inlineListToTexinfo lst >>= return . inCmd "strong" + inCmd "strong" <$> inlineListToTexinfo lst inlineToTexinfo (Strikeout lst) = do modify $ \st -> st{ stStrikeout = True } @@ -427,17 +419,15 @@ inlineToTexinfo (Strikeout lst) = do return $ text "@textstrikeout{" <> contents <> text "}" inlineToTexinfo (Superscript lst) = do - modify $ \st -> st{ stSuperscript = True } contents <- inlineListToTexinfo lst - return $ text "@textsuperscript{" <> contents <> char '}' + return $ text "@sup{" <> contents <> char '}' inlineToTexinfo (Subscript lst) = do - modify $ \st -> st{ stSubscript = True } contents <- inlineListToTexinfo lst - return $ text "@textsubscript{" <> contents <> char '}' + return $ text "@sub{" <> contents <> char '}' inlineToTexinfo (SmallCaps lst) = - inlineListToTexinfo lst >>= return . inCmd "sc" + inCmd "sc" <$> inlineListToTexinfo lst inlineToTexinfo (Code _ str) = return $ text $ "@code{" ++ stringToTexinfo str ++ "}" diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 0ed79d2df..c7d96454a 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -73,7 +73,7 @@ pandocToTextile opts (Pandoc meta blocks) = do (inlineListToTextile opts) meta body <- blockListToTextile opts blocks notes <- gets $ unlines . reverse . stNotes - let main = pack $ body ++ if null notes then "" else ("\n\n" ++ notes) + let main = pack $ body ++ if null notes then "" else "\n\n" ++ notes let context = defField "body" main metadata case writerTemplate opts of Nothing -> return main @@ -154,7 +154,7 @@ blockToTextile _ HorizontalRule = return "<hr />\n" blockToTextile opts (Header level (ident,classes,keyvals) inlines) = do contents <- inlineListToTextile opts inlines - let identAttr = if null ident then "" else ('#':ident) + let identAttr = if null ident then "" else '#':ident let attribs = if null identAttr && null classes then "" else "(" ++ unwords classes ++ identAttr ++ ")" @@ -382,13 +382,13 @@ blockListToTextile :: PandocMonad m -> [Block] -- ^ List of block elements -> TW m String blockListToTextile opts blocks = - mapM (blockToTextile opts) blocks >>= return . vcat + vcat <$> mapM (blockToTextile opts) blocks -- | Convert list of Pandoc inline elements to Textile. inlineListToTextile :: PandocMonad m => WriterOptions -> [Inline] -> TW m String inlineListToTextile opts lst = - mapM (inlineToTextile opts) lst >>= return . concat + concat <$> mapM (inlineToTextile opts) lst -- | Convert Pandoc inline element to Textile. inlineToTextile :: PandocMonad m => WriterOptions -> Inline -> TW m String @@ -463,15 +463,15 @@ inlineToTextile _ SoftBreak = return " " inlineToTextile _ Space = return " " inlineToTextile opts (Link (_, cls, _) txt (src, _)) = do - let classes = if null cls - then "" - else "(" ++ unwords cls ++ ")" label <- case txt of [Code _ s] | s == src -> return "$" [Str s] | s == src -> return "$" _ -> inlineListToTextile opts txt + let classes = if null cls || cls == ["uri"] && label == "$" + then "" + else "(" ++ unwords cls ++ ")" return $ "\"" ++ classes ++ label ++ "\":" ++ src inlineToTextile opts (Image attr@(_, cls, _) alt (source, tit)) = do |