diff options
Diffstat (limited to 'src/Text/Pandoc/Writers')
| -rw-r--r-- | src/Text/Pandoc/Writers/AsciiDoc.hs | 15 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/ConTeXt.hs | 18 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Docbook.hs | 62 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 2 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/EPUB.hs | 54 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/FB2.hs | 33 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 233 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/JATS.hs | 39 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 283 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/OPML.hs | 35 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Shared.hs | 27 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/TEI.hs | 48 |
12 files changed, 387 insertions, 462 deletions
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index f360aeee1..c0f215d57 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -84,7 +84,7 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do (blockListToAsciiDoc opts) (fmap chomp . inlineListToAsciiDoc opts) meta - main <- vcat <$> mapM (elementToAsciiDoc 1 opts) (hierarchicalize blocks) + main <- blockListToAsciiDoc opts $ makeSections False (Just 1) blocks st <- get let context = defField "body" main $ defField "toc" @@ -97,14 +97,6 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do Nothing -> main Just tpl -> renderTemplate tpl context -elementToAsciiDoc :: PandocMonad m - => Int -> WriterOptions -> Element -> ADW m (Doc Text) -elementToAsciiDoc _ opts (Blk b) = blockToAsciiDoc opts b -elementToAsciiDoc nestlevel opts (Sec _lvl _num attr label children) = do - hdr <- blockToAsciiDoc opts (Header nestlevel attr label) - rest <- vcat <$> mapM (elementToAsciiDoc (nestlevel + 1) opts) children - return $ hdr $$ rest - -- | Escape special characters for AsciiDoc. escapeString :: String -> String escapeString = escapeStringUsing escs @@ -137,6 +129,11 @@ blockToAsciiDoc :: PandocMonad m -> Block -- ^ Block element -> ADW m (Doc Text) blockToAsciiDoc _ Null = return empty +blockToAsciiDoc opts (Div (id',"section":_,_) + (Header level (_,cls,kvs) ils : xs)) = do + hdr <- blockToAsciiDoc opts (Header level (id',cls,kvs) ils) + rest <- blockListToAsciiDoc opts xs + return $ hdr $$ rest blockToAsciiDoc opts (Plain inlines) = do contents <- inlineListToAsciiDoc opts inlines return $ contents <> blankline diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 3a142fdb8..bef1e6265 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -65,8 +65,7 @@ pandocToConTeXt options (Pandoc meta blocks) = do blockListToConTeXt (fmap chomp . inlineListToConTeXt) meta - body <- mapM (elementToConTeXt options) $ hierarchicalize blocks - let main = vcat body + main <- blockListToConTeXt $ makeSections False Nothing blocks let layoutFromMargins = mconcat $ intersperse ("," :: Doc Text) $ mapMaybe (\(x,y) -> ((x <> "=") <>) <$> getField y metadata) @@ -147,18 +146,15 @@ toLabel z = concatMap go z | x `elem` ("\\#[]\",{}%()|=" :: String) = "ux" ++ printf "%x" (ord x) | otherwise = [x] --- | Convert Elements to ConTeXt -elementToConTeXt :: PandocMonad m => WriterOptions -> Element -> WM m (Doc Text) -elementToConTeXt _ (Blk block) = blockToConTeXt block -elementToConTeXt opts (Sec level _ attr title' elements) = do - header' <- sectionHeader attr level title' - footer' <- sectionFooter attr level - innerContents <- mapM (elementToConTeXt opts) elements - return $ header' $$ vcat innerContents $$ footer' - -- | Convert Pandoc block element to ConTeXt. blockToConTeXt :: PandocMonad m => Block -> WM m (Doc Text) blockToConTeXt Null = return empty +blockToConTeXt (Div attr@(_,"section":_,_) + (Header level _ title' : xs)) = do + header' <- sectionHeader attr level title' + footer' <- sectionFooter attr level + innerContents <- blockListToConTeXt xs + return $ header' $$ innerContents $$ footer' blockToConTeXt (Plain lst) = inlineListToConTeXt lst -- title beginning with fig: indicates that the image is a figure blockToConTeXt (Para [Image attr txt (src,'f':'i':'g':':':_)]) = do diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 6f42d05e3..b0472e1d1 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -78,7 +78,6 @@ writeDocbook5 opts d = -- | Convert Pandoc document to string in Docbook format. writeDocbook :: PandocMonad m => WriterOptions -> Pandoc -> DB m Text writeDocbook opts (Pandoc meta blocks) = do - let elements = hierarchicalize blocks let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing @@ -88,15 +87,15 @@ writeDocbook opts (Pandoc meta blocks) = do TopLevelChapter -> 0 TopLevelSection -> 1 TopLevelDefault -> 1 + let fromBlocks = blocksToDocbook opts . + makeSections False (Just startLvl) auths' <- mapM (authorToDocbook opts) $ docAuthors meta let meta' = B.setMeta "author" auths' meta metadata <- metaToContext opts - (fmap vcat . - mapM (elementToDocbook opts startLvl) . - hierarchicalize) + (fromBlocks) (inlinesToDocbook opts) meta' - main <- vcat <$> mapM (elementToDocbook opts startLvl) elements + main <- fromBlocks blocks let context = defField "body" main $ defField "mathml" (case writerHTMLMathMethod opts of MathML -> True @@ -107,34 +106,6 @@ writeDocbook opts (Pandoc meta blocks) = do Nothing -> main Just tpl -> renderTemplate tpl context --- | Convert an Element to Docbook. -elementToDocbook :: PandocMonad m => WriterOptions -> Int -> Element -> DB m (Doc Text) -elementToDocbook opts _ (Blk block) = blockToDocbook opts block -elementToDocbook opts lvl (Sec _ _num (id',_,_) title elements) = do - version <- ask - -- Docbook doesn't allow sections with no content, so insert some if needed - let elements' = if null elements - then [Blk (Para [])] - else elements - tag = case lvl of - -1 -> "part" - 0 -> "chapter" - n | n >= 1 && n <= 5 -> if version == DocBook5 - then "section" - else "sect" ++ show n - _ -> "simplesect" - idName = if version == DocBook5 - then "xml:id" - else "id" - idAttr = [(idName, writerIdentifierPrefix opts ++ id') | not (null id')] - nsAttr = if version == DocBook5 && lvl == 0 then [("xmlns", "http://docbook.org/ns/docbook"),("xmlns:xlink", "http://www.w3.org/1999/xlink")] - else [] - attribs = nsAttr ++ idAttr - contents <- mapM (elementToDocbook opts (lvl + 1)) elements' - title' <- inlinesToDocbook opts title - return $ inTags True tag attribs $ - inTagsSimple "title" title' $$ vcat contents - -- | Convert a list of Pandoc blocks to Docbook. blocksToDocbook :: PandocMonad m => WriterOptions -> [Block] -> DB m (Doc Text) blocksToDocbook opts = fmap vcat . mapM (blockToDocbook opts) @@ -184,6 +155,29 @@ blockToDocbook :: PandocMonad m => WriterOptions -> Block -> DB m (Doc Text) blockToDocbook _ Null = return empty -- Add ids to paragraphs in divs with ids - this is needed for -- pandoc-citeproc to get link anchors in bibliographies: +blockToDocbook opts (Div (id',"section":_,_) (Header lvl _ ils : xs)) = do + version <- ask + -- Docbook doesn't allow sections with no content, so insert some if needed + let bs = if null xs + then [Para []] + else xs + tag = case lvl of + -1 -> "part" + 0 -> "chapter" + n | n >= 1 && n <= 5 -> if version == DocBook5 + then "section" + else "sect" ++ show n + _ -> "simplesect" + idName = if version == DocBook5 + then "xml:id" + else "id" + idAttr = [(idName, writerIdentifierPrefix opts ++ id') | not (null id')] + nsAttr = if version == DocBook5 && lvl == 0 then [("xmlns", "http://docbook.org/ns/docbook"),("xmlns:xlink", "http://www.w3.org/1999/xlink")] + else [] + attribs = nsAttr ++ idAttr + title' <- inlinesToDocbook opts ils + contents <- blocksToDocbook opts bs + return $ inTags True tag attribs $ inTagsSimple "title" title' $$ contents blockToDocbook opts (Div (ident,_,_) [Para lst]) = let attribs = [("id", ident) | not (null ident)] in if hasLineBreaks lst @@ -197,7 +191,7 @@ blockToDocbook opts (Div (ident,_,_) bs) = do then mempty else selfClosingTag "anchor" [("id", ident)]) $$ contents blockToDocbook _ h@Header{} = do - -- should not occur after hierarchicalize, except inside lists/blockquotes + -- should be handled by Div section above, except inside lists/blockquotes report $ BlockNotRendered h return empty blockToDocbook opts (Plain lst) = inlinesToDocbook opts lst diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index ad88162b6..b41b17ff9 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -47,7 +47,7 @@ import Text.Pandoc.MIME (MimeType, extensionFromMimeType, getMimeType, getMimeTypeDef) import Text.Pandoc.Options import Text.Pandoc.Readers.Docx.StyleMap -import Text.Pandoc.Shared hiding (Element) +import Text.Pandoc.Shared import Text.Pandoc.Walk import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Shared diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 0f4e338e6..d0e85ae39 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -26,7 +26,7 @@ import Control.Monad.State.Strict (State, StateT, evalState, evalStateT, get, import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy.Char8 as B8 import Data.Char (isAlphaNum, isAscii, isDigit, toLower) -import Data.List (intercalate, isInfixOf, isPrefixOf) +import Data.List (isInfixOf, isPrefixOf) import qualified Data.Map as M import Data.Maybe (fromMaybe, isNothing, mapMaybe, isJust) import qualified Data.Set as Set @@ -47,9 +47,8 @@ import Text.Pandoc.MIME (MimeType, extensionFromMimeType, getMimeType) import Text.Pandoc.Options (EPUBVersion (..), HTMLMathMethod (..), ObfuscationMethod (NoObfuscation), WrapOption (..), WriterOptions (..)) -import Text.Pandoc.Shared (hierarchicalize, normalizeDate, renderTags', +import Text.Pandoc.Shared (makeSections, normalizeDate, renderTags', safeRead, stringify, trim, uniqueIdent) -import qualified Text.Pandoc.Shared as S (Element (..)) import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.UUID (getUUID) import Text.Pandoc.Walk (query, walk, walkM) @@ -712,31 +711,34 @@ pandocToEPUB version opts doc = do contentsEntry <- mkEntry "content.opf" contentsData -- toc.ncx - let secs = hierarchicalize blocks' + let secs = makeSections True (Just 1) blocks' let tocLevel = writerTOCDepth opts let navPointNode :: PandocMonad m => (Int -> [Inline] -> String -> [Element] -> Element) - -> S.Element -> StateT Int m Element - navPointNode formatter (S.Sec _ nums (ident,_,_) ils children) = do - n <- get - modify (+1) - let showNums :: [Int] -> String - showNums = intercalate "." . map show - let tit = if writerNumberSections opts && not (null nums) - then Span ("", ["section-header-number"], []) - [Str (showNums nums)] : Space : ils - else ils - src <- case lookup ident reftable of - Just x -> return x - Nothing -> throwError $ PandocSomeError $ ident ++ " not found in reftable" - let isSec (S.Sec lev _ _ _ _) = lev <= tocLevel - isSec _ = False - let subsecs = filter isSec children - subs <- mapM (navPointNode formatter) subsecs - return $ formatter n tit src subs - navPointNode _ (S.Blk _) = throwError $ PandocSomeError "navPointNode encountered Blk" + -> Block -> StateT Int m [Element] + navPointNode formatter (Div (ident,"section":_,_) + (Header lvl (_,_,kvs) ils : children)) = do + if lvl > tocLevel + then return [] + else do + n <- get + modify (+1) + let num = fromMaybe "" $ lookup "number" kvs + let tit = if writerNumberSections opts && not (null num) + then Span ("", ["section-header-number"], []) + [Str num] : Space : ils + else ils + src <- case lookup ident reftable of + Just x -> return x + Nothing -> throwError $ PandocSomeError $ + ident ++ " not found in reftable" + subs <- concat <$> mapM (navPointNode formatter) children + return [formatter n tit src subs] + navPointNode formatter (Div _ bs) = + concat <$> mapM (navPointNode formatter) bs + navPointNode _ _ = return [] let navMapFormatter :: Int -> [Inline] -> String -> [Element] -> Element navMapFormatter n tit src subs = unode "navPoint" ! @@ -750,7 +752,8 @@ pandocToEPUB version opts doc = do , unode "content" ! [("src", "text/title_page.xhtml")] $ () ] - navMap <- lift $ evalStateT (mapM (navPointNode navMapFormatter) secs) 1 + navMap <- lift $ evalStateT + (concat <$> mapM (navPointNode navMapFormatter) secs) 1 let tocData = UTF8.fromStringLazy $ ppTopElement $ unode "ncx" ! [("version","2005-1") ,("xmlns","http://www.daisy.org/z3986/2005/ncx/")] $ @@ -800,7 +803,8 @@ pandocToEPUB version opts doc = do clean x = x let navtag = if epub3 then "nav" else "div" - tocBlocks <- lift $ evalStateT (mapM (navPointNode navXhtmlFormatter) secs) 1 + tocBlocks <- lift $ evalStateT + (concat <$> mapM (navPointNode navXhtmlFormatter) secs) 1 let navBlocks = [RawBlock (Format "html") $ showElement $ -- prettyprinting introduces bad spaces unode navtag ! ([("epub:type","toc") | epub3] ++ diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index d2527a0a9..744eb2a06 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -39,9 +39,9 @@ import qualified Text.Pandoc.Class as P import Text.Pandoc.Definition import Text.Pandoc.Logging import Text.Pandoc.Options (HTMLMathMethod (..), WriterOptions (..), def) -import Text.Pandoc.Shared (capitalize, isURI, orderedListMarkers, hierarchicalize) +import Text.Pandoc.Shared (capitalize, isURI, orderedListMarkers, + makeSections) import Text.Pandoc.Writers.Shared (lookupMetaString) -import qualified Text.Pandoc.Shared as Shared (Element(Blk, Sec)) -- | Data to be written at the end of the document: -- (foot)notes, URLs, references, images. @@ -162,28 +162,27 @@ docdate meta' = do -- representation. renderSections :: PandocMonad m => Int -> [Block] -> FBM m [Content] renderSections level blocks = do - let elements = hierarchicalize blocks - let isSection Shared.Sec{} = True + let blocks' = makeSections False Nothing blocks + let isSection (Div (_,"section":_,_) (Header{}:_)) = True isSection _ = False - let (initialBlocks, secs) = break isSection elements - let elements' = if null initialBlocks - then secs - else Shared.Sec 1 [] nullAttr mempty initialBlocks : secs - cMapM (renderSection level) elements' - - - -renderSection :: PandocMonad m => Int -> Shared.Element -> FBM m [Content] -renderSection _ (Shared.Blk block) = blockToXml block -renderSection lvl (Shared.Sec _ _num (id',_,_) title elements) = do - content <- cMapM (renderSection (lvl + 1)) elements + let (initialBlocks, secs) = break isSection blocks' + let blocks'' = if null initialBlocks + then blocks' + else Div ("",["section"],[]) + (Header 1 nullAttr mempty : initialBlocks) : secs + cMapM (renderSection level) blocks'' + +renderSection :: PandocMonad m => Int -> Block -> FBM m [Content] +renderSection lvl (Div (id',"section":_,_) (Header _ _ title : xs)) = do title' <- if null title then return [] else list . el "title" <$> formatTitle title + content <- cMapM (renderSection (lvl + 1)) xs let sectionContent = if null id' then el "section" (title' ++ content) else el "section" ([uattr "id" id'], title' ++ content) return [sectionContent] +renderSection _ b = blockToXml b -- | Only <p> and <empty-line> are allowed within <title> in FB2. formatTitle :: PandocMonad m => [Inline] -> FBM m [Content] @@ -334,7 +333,7 @@ blockToXml (DefinitionList defs) = t <- wrap "strong" term return (el "p" t : items) blockToXml h@Header{} = do - -- should not occur after hierarchicalize, except inside lists/blockquotes + -- should not occur after makeSections, except inside lists/blockquotes report $ BlockNotRendered h return [] blockToXml HorizontalRule = return [ el "empty-line" () ] diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 38b0e1974..52825fb09 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -32,9 +32,10 @@ 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, mapMaybe) +import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe) import qualified Data.Set as Set import Data.String (fromString) +import Data.List.Split (splitWhen) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL @@ -90,20 +91,20 @@ data WriterState = WriterState , stMath :: Bool -- ^ Math is used in document , stQuotes :: Bool -- ^ <q> tag is used , stHighlighting :: Bool -- ^ Syntax highlighting is used - , stSecNum :: [Int] -- ^ Number of current section - , stElement :: Bool -- ^ Processing an Element , stHtml5 :: Bool -- ^ Use HTML5 , stEPUBVersion :: Maybe EPUBVersion -- ^ EPUB version if for epub , stSlideVariant :: HTMLSlideVariant + , stSlideLevel :: Int -- ^ Slide level , stCodeBlockNum :: Int -- ^ Number of code block } defaultWriterState :: WriterState defaultWriterState = WriterState {stNotes= [], stMath = False, stQuotes = False, - stHighlighting = False, stSecNum = [], - stElement = False, stHtml5 = False, + stHighlighting = False, + stHtml5 = False, stEPUBVersion = Nothing, stSlideVariant = NoSlides, + stSlideLevel = 1, stCodeBlockNum = 0} -- Helpers to render HTML with the appropriate function. @@ -243,6 +244,8 @@ pandocToHtml :: PandocMonad m -> Pandoc -> StateT WriterState m (Html, Context Text) pandocToHtml opts (Pandoc meta blocks) = do + let slideLevel = fromMaybe (getSlideLevel blocks) $ writerSlideLevel opts + modify $ \st -> st{ stSlideLevel = slideLevel } metadata <- metaToContext opts (fmap renderHtml' . blockListToHtml opts) (fmap renderHtml' . inlineListToHtml opts) @@ -250,17 +253,15 @@ pandocToHtml opts (Pandoc meta blocks) = do let stringifyHTML = escapeStringForXML . stringify let authsMeta = map stringifyHTML $ docAuthors meta let dateMeta = stringifyHTML $ docDate meta - let slideLevel = fromMaybe (getSlideLevel blocks) $ writerSlideLevel opts slideVariant <- gets stSlideVariant - let sects = hierarchicalize $ + let sects = makeSections (writerNumberSections opts) Nothing $ if slideVariant == NoSlides then blocks else prepSlides slideLevel blocks toc <- if writerTableOfContents opts && slideVariant /= S5Slides then fmap renderHtml' <$> tableOfContents opts sects else return Nothing - blocks' <- liftM (mconcat . intersperse (nl opts)) $ - mapM (elementToHtml Nothing slideLevel opts) sects + blocks' <- blockListToHtml opts sects st <- get notes <- footnoteSection opts (reverse (stNotes st)) let thebody = blocks' >> notes @@ -380,130 +381,20 @@ listItemToHtml opts bls return $ constr (checkbox >> isContents) >> bsContents -- | Construct table of contents from list of elements. -tableOfContents :: PandocMonad m => WriterOptions -> [Element] +tableOfContents :: PandocMonad m => WriterOptions -> [Block] -> StateT WriterState m (Maybe Html) tableOfContents _ [] = return Nothing tableOfContents opts sects = do - contents <- mapM (elementToListItem opts) sects - let tocList = catMaybes contents - if null tocList - then return Nothing - else Just <$> unordList opts tocList - --- | Convert section number to string -showSecNum :: [Int] -> String -showSecNum = intercalate "." . map show - --- | Converts an Element to a list item for a table of contents, --- retrieving the appropriate identifier from state. -elementToListItem :: PandocMonad m => WriterOptions -> Element - -> StateT WriterState m (Maybe Html) --- Don't include the empty headers created in slide shows --- shows when an hrule is used to separate slides without a new title: -elementToListItem _ (Sec _ _ _ [Str "\0"] _) = return Nothing -elementToListItem opts (Sec lev num (id',classes,_) headerText subsecs) - | lev <= writerTOCDepth opts = do - let num' = zipWith (+) num (writerNumberOffset opts ++ repeat 0) - let sectnum = if writerNumberSections opts && not (null num) && - "unnumbered" `notElem` classes - then (H.span ! A.class_ "toc-section-number" - $ toHtml $ showSecNum num') >> preEscapedString " " - else mempty - txt <- liftM (sectnum >>) $ - inlineListToHtml opts $ walk (deLink . deNote) headerText - subHeads <- mapM (elementToListItem opts) subsecs >>= return . catMaybes - subList <- if null subHeads - then return mempty - else unordList opts subHeads -- in reveal.js, we need #/apples, not #apples: slideVariant <- gets stSlideVariant - let revealSlash = ['/' | slideVariant== RevealJsSlides] - return $ Just - $ if null id' - then H.a (toHtml txt) >> subList - else (H.a ! A.href (toValue $ "#" ++ revealSlash ++ - writerIdentifierPrefix opts ++ id') - $ toHtml txt) >> subList -elementToListItem _ _ = return Nothing - -deLink :: Inline -> Inline -deLink (Link _ ils _) = Span nullAttr ils -deLink x = x - --- | Convert an Element to Html. -elementToHtml :: PandocMonad m => Maybe Int -> Int -> WriterOptions -> Element - -> StateT WriterState m Html -elementToHtml _ _ opts (Blk block) = blockToHtml opts block -elementToHtml mbparentlevel slideLevel opts - (Sec level num (id',classes,keyvals) title' elements) - = do - slideVariant <- gets stSlideVariant - let slide = slideVariant /= NoSlides && - (level <= slideLevel || - -- we're missing a header at slide level (see #5168) - maybe False (< slideLevel) mbparentlevel) - let num' = zipWith (+) num (writerNumberOffset opts ++ repeat 0) - modify $ \st -> st{stSecNum = num'} -- update section number - html5 <- gets stHtml5 - let titleSlide = slide && level < slideLevel - header' <- if title' == [Str "\0"] -- marker for hrule - then return mempty - else do - modify (\st -> st{ stElement = True}) - let level' = if level <= slideLevel && - slideVariant == SlidySlides - then 1 -- see #3566 - else level - res <- blockToHtml opts - (Header level' (id',classes,keyvals) title') - modify (\st -> st{ stElement = False}) - return res - - let isSec Sec{} = True - isSec (Blk _) = False - let isPause (Blk x) = x == Para [Str ".",Space,Str ".",Space,Str "."] - isPause _ = False - let fragmentClass = case slideVariant of - RevealJsSlides -> "fragment" - _ -> "incremental" - let inDiv xs = Blk (RawBlock (Format "html") ("<div class=\"" - ++ fragmentClass ++ "\">")) : - (xs ++ [Blk (RawBlock (Format "html") "</div>")]) - let (titleBlocks, innerSecs) = - if titleSlide - -- title slides have no content of their own - then ([x | Blk x <- elements], - filter isSec elements) - else case splitBy isPause elements of - [] -> ([],[]) - (x:xs) -> ([],x ++ concatMap inDiv xs) - titleContents <- blockListToHtml opts titleBlocks - innerContents <- mapM (elementToHtml (Just level) slideLevel opts) innerSecs - let inNl x = mconcat $ nl opts : intersperse (nl opts) x ++ [nl opts] - let classes' = ["title-slide" | titleSlide] ++ ["slide" | slide] ++ - ["section" | (slide || writerSectionDivs opts) && - not html5 ] ++ - ["level" ++ show level | slide || writerSectionDivs opts ] - ++ classes - let secttag = if html5 - then H5.section - else H.div - let attr = (id',classes',keyvals) - if titleSlide - then do - t <- addAttrs opts attr $ secttag $ header' <> titleContents - return $ - (if slideVariant == RevealJsSlides && not (null innerContents) - -- revealjs doesn't like more than one level of section nesting: - && isNothing mbparentlevel - then H5.section - else id) $ mconcat $ t : innerContents - else if writerSectionDivs opts || slide - then addAttrs opts attr - $ secttag $ inNl $ header' : innerContents - else do - t <- addAttrs opts attr header' - return $ mconcat $ intersperse (nl opts) (t : innerContents) + let opts' = case slideVariant of + RevealJsSlides -> + opts{ writerIdentifierPrefix = + '/' : writerIdentifierPrefix opts } + _ -> opts + case toTableOfContents opts sects of + bl@(BulletList (_:_)) -> Just <$> blockToHtml opts' bl + _ -> return Nothing -- | Convert list of Note blocks to a footnote <div>. -- Assumes notes are sorted. @@ -686,6 +577,16 @@ figure opts attr txt (s,tit) = do else H.div ! A.class_ "figure" $ mconcat [nl opts, img, nl opts, capt, nl opts] +showSecNum :: [Int] -> String +showSecNum = intercalate "." . map show + +getNumber :: WriterOptions -> Attr -> String +getNumber opts (_,_,kvs) = + showSecNum $ zipWith (+) num (writerNumberOffset opts ++ repeat 0) + where + num = maybe [] (map (fromMaybe 0 . safeRead) . splitWhen (=='.')) $ + lookup "number" kvs + -- | Convert Pandoc block element to HTML. blockToHtml :: PandocMonad m => WriterOptions -> Block -> StateT WriterState m Html blockToHtml _ Null = return mempty @@ -713,6 +614,73 @@ blockToHtml opts (LineBlock lns) = else do htmlLines <- inlineListToHtml opts $ intercalate [LineBreak] lns return $ H.div ! A.class_ "line-block" $ htmlLines +blockToHtml opts (Div (ident, "section":dclasses, dkvs) + (Header level hattr ils : xs)) = do + slideVariant <- gets stSlideVariant + slideLevel <- gets stSlideLevel + let slide = slideVariant /= NoSlides && + level <= slideLevel {- DROPPED old fix for #5168 here -} + html5 <- gets stHtml5 + let titleSlide = slide && level < slideLevel + let level' = if level <= slideLevel && slideVariant == SlidySlides + then 1 -- see #3566 + else level + header' <- if ils == [Str "\0"] -- marker for hrule + then return mempty + else blockToHtml opts (Header level' hattr ils) + let isSec (Div (_,"section":_,_) _) = True + isSec (Div _ zs) = any isSec zs + isSec _ = False + let isPause (Para [Str ".",Space,Str ".",Space,Str "."]) = True + isPause _ = False + let fragmentClass = case slideVariant of + RevealJsSlides -> "fragment" + _ -> "incremental" + let inDiv zs = (RawBlock (Format "html") ("<div class=\"" + ++ fragmentClass ++ "\">")) : + (zs ++ [RawBlock (Format "html") "</div>"]) + let (titleBlocks, innerSecs) = + if titleSlide + -- title slides have no content of their own + then break isSec xs + else case splitBy isPause xs of + [] -> ([],[]) + (z:zs) -> ([],z ++ concatMap inDiv zs) + titleContents <- blockListToHtml opts titleBlocks + innerContents <- blockListToHtml opts innerSecs + let classes' = ["title-slide" | titleSlide] ++ ["slide" | slide] ++ + ["section" | (slide || writerSectionDivs opts) && + not html5 ] ++ + ["level" ++ show level | slide || writerSectionDivs opts ] + ++ dclasses + let secttag = if html5 + then H5.section + else H.div + let attr = (ident, classes', dkvs) + if titleSlide + then do + t <- addAttrs opts attr $ secttag $ header' <> titleContents + return $ + (if slideVariant == RevealJsSlides && not (null innerSecs) + -- revealjs doesn't like more than one level of section nesting: + {- REMOVED && isNothing mbparentlevel -} + then H5.section + else id) $ t <> if null innerSecs + then mempty + else nl opts <> innerContents + else if writerSectionDivs opts || slide || not (null dclasses) || + not (null dkvs) + then addAttrs opts attr + $ secttag + $ nl opts <> header' <> nl opts <> + if null innerSecs + then mempty + else innerContents <> nl opts + else do + t <- addAttrs opts attr header' + return $ t <> if null innerSecs + then mempty + else nl opts <> innerContents blockToHtml opts (Div attr@(ident, classes, kvs') bs) = do html5 <- gets stHtml5 slideVariant <- gets stSlideVariant @@ -826,14 +794,13 @@ blockToHtml opts (BlockQuote blocks) = do return $ H.blockquote $ nl opts >> contents >> nl opts blockToHtml opts (Header level attr@(_,classes,_) lst) = do contents <- inlineListToHtml opts lst - secnum <- liftM stSecNum get + let secnum = getNumber opts attr let contents' = if writerNumberSections opts && not (null secnum) && "unnumbered" `notElem` classes - then (H.span ! A.class_ "header-section-number" $ toHtml - $ showSecNum secnum) >> strToHtml " " >> contents + then (H.span ! A.class_ "header-section-number" + $ toHtml secnum) >> strToHtml " " >> contents else contents - inElement <- gets stElement - (if inElement then return else addAttrs opts attr) + addAttrs opts attr $ case level of 1 -> H.h1 contents' 2 -> H.h2 contents' diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index ffeceb1c2..c0ed15f52 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -63,30 +63,27 @@ docToJATS opts (Pandoc meta blocks) = do let isBackBlock (Div ("refs",_,_) _) = True isBackBlock _ = False let (backblocks, bodyblocks) = partition isBackBlock blocks - let elements = hierarchicalize bodyblocks - let backElements = hierarchicalize $ backblocks - let colwidth = if writerWrapText opts == WrapAuto - then Just $ writerColumns opts - else Nothing -- The numbering here follows LaTeX's internal numbering let startLvl = case writerTopLevelDivision opts of TopLevelPart -> -1 TopLevelChapter -> 0 TopLevelSection -> 1 TopLevelDefault -> 1 + let fromBlocks = blocksToJATS opts . makeSections False (Just startLvl) + let colwidth = if writerWrapText opts == WrapAuto + then Just $ writerColumns opts + else Nothing metadata <- metaToContext opts - (fmap vcat . - mapM (elementToJATS opts startLvl) . - hierarchicalize) + fromBlocks (fmap chomp . inlinesToJATS opts) meta - main <- vcat <$> mapM (elementToJATS opts startLvl) elements + main <- fromBlocks bodyblocks notes <- reverse . map snd <$> gets jatsNotes - backs <- mapM (elementToJATS opts startLvl) backElements + backs <- fromBlocks backblocks let fns = if null notes then mempty else inTagsIndented "fn-group" $ vcat notes - let back = vcat backs $$ fns + let back = backs $$ fns let date = case getField "date" metadata of Nothing -> NullVal @@ -116,18 +113,6 @@ docToJATS opts (Pandoc meta blocks) = do Nothing -> main Just tpl -> renderTemplate tpl context --- | Convert an Element to JATS. -elementToJATS :: PandocMonad m => WriterOptions -> Int -> Element -> JATS m (Doc Text) -elementToJATS opts _ (Blk block) = blockToJATS opts block -elementToJATS opts lvl (Sec _ _num (id',_,kvs) title elements) = do - let idAttr = [("id", writerIdentifierPrefix opts ++ id') | not (null id')] - let otherAttrs = ["sec-type", "specific-use"] - let attribs = idAttr ++ [(k,v) | (k,v) <- kvs, k `elem` otherAttrs] - contents <- mapM (elementToJATS opts (lvl + 1)) elements - title' <- inlinesToJATS opts title - return $ inTags True "sec" attribs $ - inTagsSimple "title" title' $$ vcat contents - -- | Convert a list of Pandoc blocks to JATS. blocksToJATS :: PandocMonad m => WriterOptions -> [Block] -> JATS m (Doc Text) blocksToJATS = wrappedBlocksToJATS (const False) @@ -225,6 +210,14 @@ codeAttr (ident,classes,kvs) = (lang, attr) -- | Convert a Pandoc block element to JATS. blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m (Doc Text) blockToJATS _ Null = return empty +blockToJATS opts (Div (id',"section":_,kvs) (Header _lvl _ ils : xs)) = do + let idAttr = [("id", writerIdentifierPrefix opts ++ id') | not (null id')] + let otherAttrs = ["sec-type", "specific-use"] + let attribs = idAttr ++ [(k,v) | (k,v) <- kvs, k `elem` otherAttrs] + title' <- inlinesToJATS opts ils + contents <- blocksToJATS opts xs + return $ inTags True "sec" attribs $ + inTagsSimple "title" title' $$ contents -- Bibliography reference: blockToJATS opts (Div ('r':'e':'f':'-':_,_,_) [Para lst]) = inlinesToJATS opts lst diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 3c952c2d1..2e340b411 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -168,9 +168,8 @@ pandocToLaTeX options (Pandoc meta blocks) = do blocks''' <- if beamer then toSlides blocks'' else return blocks'' - body <- mapM (elementToLaTeX options) $ hierarchicalize blocks''' + main <- blockListToLaTeX $ makeSections False Nothing blocks''' biblioTitle <- inlineListToLaTeX lastHeader - let main = vsep body st <- get titleMeta <- stringToLaTeX TextString $ stringify $ docTitle meta authorsMeta <- mapM (stringToLaTeX TextString . stringify) $ docAuthors meta @@ -298,16 +297,6 @@ pandocToLaTeX options (Pandoc meta blocks) = do Nothing -> main Just tpl -> renderTemplate tpl context' --- | Convert Elements to LaTeX -elementToLaTeX :: PandocMonad m => WriterOptions -> Element -> LW m (Doc Text) -elementToLaTeX _ (Blk block) = blockToLaTeX block -elementToLaTeX opts (Sec level _ (id',classes,_) title' elements) = do - modify $ \s -> s{stInHeading = True} - header' <- sectionHeader ("unnumbered" `elem` classes) id' level title' - modify $ \s -> s{stInHeading = False} - innerContents <- mapM (elementToLaTeX opts) elements - return $ vsep (header' : innerContents) - data StringContext = TextString | URLString | CodeString @@ -459,68 +448,16 @@ toSlides bs = do opts <- gets stOptions let slideLevel = fromMaybe (getSlideLevel bs) $ writerSlideLevel opts let bs' = prepSlides slideLevel bs - concat `fmap` mapM (elementToBeamer slideLevel) (hierarchicalize bs') + walkM (elementToBeamer slideLevel) (makeSections False Nothing bs') -elementToBeamer :: PandocMonad m => Int -> Element -> LW m [Block] -elementToBeamer _slideLevel (Blk (Div attrs bs)) = do - -- make sure we support "blocks" inside divs - bs' <- concat `fmap` mapM (elementToBeamer 0) (hierarchicalize bs) - return [Div attrs bs'] - -elementToBeamer _slideLevel (Blk b) = return [b] -elementToBeamer slideLevel (Sec lvl _num (ident,classes,kvs) tit elts) - | lvl > slideLevel = do - bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts - return $ Para ( RawInline "latex" "\\begin{block}{" - : tit ++ [RawInline "latex" "}"] ) - : bs ++ [RawBlock "latex" "\\end{block}"] - | lvl < slideLevel = do - let isSec Sec{} = True - isSec _ = False - let (contentElts, secElts) = break isSec elts - let elts' = if null contentElts - then secElts - else Sec slideLevel [] nullAttr tit contentElts : - secElts - bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts' - return $ Header lvl (ident,classes,kvs) tit : bs - | otherwise = do -- lvl == slideLevel - -- note: [fragile] is required or verbatim breaks - let hasCodeBlock (CodeBlock _ _) = [True] - hasCodeBlock _ = [] - let hasCode (Code _ _) = [True] - hasCode _ = [] - let fragile = "fragile" `elem` classes || - not (null $ query hasCodeBlock elts ++ query hasCode elts) - let frameoptions = ["allowdisplaybreaks", "allowframebreaks", "fragile", - "b", "c", "t", "environment", - "label", "plain", "shrink", "standout", - "noframenumbering"] - let optionslist = ["fragile" | fragile - , isNothing (lookup "fragile" kvs) - , "fragile" `notElem` classes] ++ - [k | k <- classes, k `elem` frameoptions] ++ - [k ++ "=" ++ v | (k,v) <- kvs, k `elem` frameoptions] - let options = if null optionslist - then "" - else "[" ++ intercalate "," optionslist ++ "]" - let latex = RawInline (Format "latex") - slideTitle <- - if tit == [Str "\0"] -- marker for hrule - then return [] - else return $ latex "{" : tit ++ [latex "}"] - ref <- toLabel ident - let slideAnchor = if null ident - then [] - else [latex ("\n\\protect\\hypertarget{" ++ - ref ++ "}{}")] - let slideStart = Para $ - RawInline "latex" ("\\begin{frame}" ++ options) : - slideTitle ++ slideAnchor - let slideEnd = RawBlock "latex" "\\end{frame}" - -- now carve up slide into blocks if there are sections inside - bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts - return $ slideStart : bs ++ [slideEnd] +-- this creates section slides and marks slides with class "slide","block" +elementToBeamer :: PandocMonad m => Int -> Block -> LW m Block +elementToBeamer slideLevel d@(Div (ident,dclasses,dkvs) + xs@(Header lvl _ _ : _)) + | lvl > slideLevel = return $ Div (ident,"block":dclasses,dkvs) xs + | lvl < slideLevel = return d + | otherwise = return $ Div (ident,"slide":dclasses,dkvs) xs +elementToBeamer _ x = return x isListBlock :: Block -> Bool isListBlock (BulletList _) = True @@ -533,85 +470,87 @@ blockToLaTeX :: PandocMonad m => Block -- ^ Block to convert -> LW m (Doc Text) blockToLaTeX Null = return empty -blockToLaTeX (Div (identifier,classes,kvs) bs) - | "incremental" `elem` classes = do - let classes' = filter ("incremental"/=) classes - beamer <- gets stBeamer - if beamer - then do oldIncremental <- gets stIncremental - modify $ \s -> s{ stIncremental = True } - result <- blockToLaTeX $ Div (identifier,classes',kvs) bs - modify $ \s -> s{ stIncremental = oldIncremental } - return result - else blockToLaTeX $ Div (identifier,classes',kvs) bs - | "nonincremental" `elem` classes = do - let classes' = filter ("nonincremental"/=) classes - beamer <- gets stBeamer - if beamer - then do oldIncremental <- gets stIncremental - modify $ \s -> s{ stIncremental = False } - result <- blockToLaTeX $ Div (identifier,classes',kvs) bs - modify $ \s -> s{ stIncremental = oldIncremental } - return result - else blockToLaTeX $ Div (identifier,classes',kvs) bs - | identifier == "refs" = do - modify $ \st -> st{ stHasCslRefs = True - , stCslHangingIndent = - "hanging-indent" `elem` classes } - contents <- blockListToLaTeX bs - return $ "\\begin{cslreferences}" $$ - contents $$ - "\\end{cslreferences}" - | otherwise = do - beamer <- gets stBeamer - linkAnchor' <- hypertarget True identifier empty - -- see #2704 for the motivation for adding \leavevmode: - let linkAnchor = - case bs of - Para _ : _ - | not (isEmpty linkAnchor') - -> "\\leavevmode" <> linkAnchor' <> "%" - _ -> linkAnchor' - let align dir txt = inCmd "begin" dir $$ txt $$ inCmd "end" dir - lang <- toLang $ lookup "lang" kvs - let wrapColumns = if beamer && "columns" `elem` classes - then \contents -> - inCmd "begin" "columns" <> brackets "T" - $$ contents - $$ inCmd "end" "columns" - else id - wrapColumn = if beamer && "column" `elem` classes - then \contents -> - let w = maybe "0.48" fromPct (lookup "width" kvs) - in inCmd "begin" "column" <> - braces (text w <> "\\textwidth") - $$ contents - $$ inCmd "end" "column" - else id - fromPct xs = - case reverse xs of - '%':ds -> case safeRead (reverse ds) of - Just digits -> showFl (digits / 100 :: Double) - Nothing -> xs - _ -> xs - wrapDir = case lookup "dir" kvs of - Just "rtl" -> align "RTL" - Just "ltr" -> align "LTR" - _ -> id - wrapLang txt = case lang of - Just lng -> let (l, o) = toPolyglossiaEnv lng - ops = if null o - then "" - else brackets $ text o - in inCmd "begin" (text l) <> ops - $$ blankline <> txt <> blankline - $$ inCmd "end" (text l) - Nothing -> txt - wrapNotes txt = if beamer && "notes" `elem` classes - then "\\note" <> braces txt -- speaker notes - else linkAnchor $$ txt - (wrapColumns . wrapColumn . wrapDir . wrapLang . wrapNotes) - <$> blockListToLaTeX bs +blockToLaTeX (Div attr@(identifier,"block":_,_) (Header _ _ ils : bs)) = do + ref <- toLabel identifier + let anchor = if null identifier + then empty + else cr <> "\\protect\\hypertarget" <> + braces (text ref) <> braces empty + title' <- inlineListToLaTeX ils + contents <- blockListToLaTeX bs + wrapDiv attr $ ("\\begin{block}" <> braces title' <> anchor) $$ + contents $$ "\\end{block}" +blockToLaTeX (Div (identifier,"slide":dclasses,dkvs) + (Header _ (_,hclasses,hkvs) ils : bs)) = do + -- note: [fragile] is required or verbatim breaks + let hasCodeBlock (CodeBlock _ _) = [True] + hasCodeBlock _ = [] + let hasCode (Code _ _) = [True] + hasCode _ = [] + let classes = dclasses ++ hclasses + let kvs = dkvs ++ hkvs + let fragile = "fragile" `elem` classes || + not (null $ query hasCodeBlock bs ++ query hasCode bs) + let frameoptions = ["allowdisplaybreaks", "allowframebreaks", "fragile", + "b", "c", "t", "environment", + "label", "plain", "shrink", "standout", + "noframenumbering"] + let optionslist = ["fragile" | fragile + , isNothing (lookup "fragile" kvs) + , "fragile" `notElem` classes] ++ + [k | k <- classes, k `elem` frameoptions] ++ + [k ++ "=" ++ v | (k,v) <- kvs, k `elem` frameoptions] + let options = if null optionslist + then empty + else brackets (text (intercalate "," optionslist)) + slideTitle <- if ils == [Str "\0"] -- marker for hrule + then return empty + else braces <$> inlineListToLaTeX ils + ref <- toLabel identifier + let slideAnchor = if null identifier + then empty + else cr <> "\\protect\\hypertarget" <> + braces (text ref) <> braces empty + contents <- blockListToLaTeX bs >>= wrapDiv (identifier,classes,kvs) + return $ ("\\begin{frame}" <> options <> slideTitle <> slideAnchor) $$ + contents $$ + "\\end{frame}" +blockToLaTeX (Div (identifier@(_:_),dclasses,dkvs) + (Header lvl ("",hclasses,hkvs) ils : bs)) = do + -- move identifier from div to header + blockToLaTeX (Div ("",dclasses,dkvs) + (Header lvl (identifier,hclasses,hkvs) ils : bs)) +blockToLaTeX (Div (identifier,classes,kvs) bs) = do + beamer <- gets stBeamer + oldIncremental <- gets stIncremental + if beamer && "incremental" `elem` classes + then modify $ \st -> st{ stIncremental = True } + else if beamer && "nonincremental" `elem` classes + then modify $ \st -> st { stIncremental = False } + else return () + result <- if identifier == "refs" + then do + inner <- blockListToLaTeX bs + modify $ \st -> st{ stHasCslRefs = True + , stCslHangingIndent = + "hanging-indent" `elem` classes } + return $ "\\begin{cslreferences}" $$ + inner $$ + "\\end{cslreferences}" + else blockListToLaTeX bs + modify $ \st -> st{ stIncremental = oldIncremental } + linkAnchor' <- hypertarget True identifier empty + -- see #2704 for the motivation for adding \leavevmode: + let linkAnchor = + case bs of + Para _ : _ + | not (isEmpty linkAnchor') + -> "\\leavevmode" <> linkAnchor' <> "%" + _ -> linkAnchor' + wrapNotes txt = if beamer && "notes" `elem` classes + then "\\note" <> braces txt -- speaker notes + else linkAnchor $$ txt + wrapNotes <$> wrapDiv (identifier,classes,kvs) result blockToLaTeX (Plain lst) = inlineListToLaTeX lst -- title beginning with fig: indicates that the image is a figure @@ -1077,6 +1016,46 @@ sectionHeader unnumbered ident level lst = do braces txtNoNotes else empty +wrapDiv :: PandocMonad m => Attr -> Doc Text -> LW m (Doc Text) +wrapDiv (_,classes,kvs) t = do + beamer <- gets stBeamer + let align dir txt = inCmd "begin" dir $$ txt $$ inCmd "end" dir + lang <- toLang $ lookup "lang" kvs + let wrapColumns = if beamer && "columns" `elem` classes + then \contents -> + inCmd "begin" "columns" <> brackets "T" + $$ contents + $$ inCmd "end" "columns" + else id + wrapColumn = if beamer && "column" `elem` classes + then \contents -> + let w = maybe "0.48" fromPct (lookup "width" kvs) + in inCmd "begin" "column" <> + braces (text w <> "\\textwidth") + $$ contents + $$ inCmd "end" "column" + else id + fromPct xs = + case reverse xs of + '%':ds -> case safeRead (reverse ds) of + Just digits -> showFl (digits / 100 :: Double) + Nothing -> xs + _ -> xs + wrapDir = case lookup "dir" kvs of + Just "rtl" -> align "RTL" + Just "ltr" -> align "LTR" + _ -> id + wrapLang txt = case lang of + Just lng -> let (l, o) = toPolyglossiaEnv lng + ops = if null o + then "" + else brackets $ text o + in inCmd "begin" (text l) <> ops + $$ blankline <> txt <> blankline + $$ inCmd "end" (text l) + Nothing -> txt + return $ wrapColumns . wrapColumn . wrapDir . wrapLang $ t + hypertarget :: PandocMonad m => Bool -> String -> Doc Text -> LW m (Doc Text) hypertarget _ "" x = return x hypertarget addnewline ident x = do diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs index 7bbb026bb..83f64ec5e 100644 --- a/src/Text/Pandoc/Writers/OPML.hs +++ b/src/Text/Pandoc/Writers/OPML.hs @@ -13,14 +13,12 @@ Conversion of 'Pandoc' documents to OPML XML. -} module Text.Pandoc.Writers.OPML ( writeOPML) where import Prelude -import Control.Monad.Except (throwError) import Data.Text (Text) import qualified Data.Text as T import qualified Text.Pandoc.Builder as B import Text.Pandoc.Class (PandocMonad) import Data.Time import Text.Pandoc.Definition -import Text.Pandoc.Error import Text.Pandoc.Options import Text.DocLayout import Text.Pandoc.Shared @@ -33,8 +31,7 @@ import Text.Pandoc.XML -- | Convert Pandoc document to string in OPML format. writeOPML :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeOPML opts (Pandoc meta blocks) = do - let elements = hierarchicalize blocks - colwidth = if writerWrapText opts == WrapAuto + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta @@ -42,7 +39,8 @@ writeOPML opts (Pandoc meta blocks) = do (writeMarkdown def . Pandoc nullMeta) (\ils -> T.stripEnd <$> writeMarkdown def (Pandoc nullMeta [Plain ils])) meta' - main <- (render colwidth . vcat) <$> mapM (elementToOPML opts) elements + let blocks' = makeSections False (Just 1) blocks + main <- (render colwidth . vcat) <$> mapM (blockToOPML opts) blocks' let context = defField "body" main metadata return $ (if writerPreferAscii opts then toEntities else id) $ @@ -63,25 +61,18 @@ convertDate :: [Inline] -> String convertDate ils = maybe "" showDateTimeRFC822 $ parseTimeM True defaultTimeLocale "%F" =<< normalizeDate (stringify ils) --- | Convert an Element to OPML. -elementToOPML :: PandocMonad m => WriterOptions -> Element -> m (Doc Text) -elementToOPML _ (Blk _) = return empty -elementToOPML opts (Sec _ _num _ title elements) = do - let isBlk :: Element -> Bool - isBlk (Blk _) = True - isBlk _ = False - - fromBlk :: PandocMonad m => Element -> m Block - fromBlk (Blk x) = return x - fromBlk _ = throwError $ PandocSomeError "fromBlk called on non-block" - - (blocks, rest) = span isBlk elements +-- | Convert a Block to OPML. +blockToOPML :: PandocMonad m => WriterOptions -> Block -> m (Doc Text) +blockToOPML opts (Div (_,"section":_,_) (Header _ _ title : xs)) = do + let isSect (Div (_,"section":_,_) (Header{}:_)) = True + isSect _ = False + let (blocks, rest) = break isSect xs htmlIls <- writeHtmlInlines title md <- if null blocks then return mempty - else do blks <- mapM fromBlk blocks - writeMarkdown def $ Pandoc nullMeta blks + else writeMarkdown def $ Pandoc nullMeta blocks let attrs = ("text", T.unpack htmlIls) : [("_note", T.unpack $ T.stripEnd md) | not (null blocks)] - o <- mapM (elementToOPML opts) rest - return $ inTags True "outline" attrs $ vcat o + rest' <- vcat <$> mapM (blockToOPML opts) rest + return $ inTags True "outline" attrs rest' +blockToOPML _ _ = return empty diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index a0e274377..7d4a496f2 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -39,6 +39,7 @@ module Text.Pandoc.Writers.Shared ( where import Prelude import Safe (lastMay) +import Data.Maybe (fromMaybe) import Control.Monad (zipWithM) import Data.Aeson (ToJSON (..), encode) import Data.Char (chr, ord, isSpace) @@ -49,7 +50,7 @@ import qualified Text.Pandoc.Builder as Builder import Text.Pandoc.Definition import Text.Pandoc.Options import Text.DocLayout -import Text.Pandoc.Shared (stringify, hierarchicalize, Element(..), deNote) +import Text.Pandoc.Shared (stringify, makeSections, deNote, deLink) import Text.Pandoc.Walk (walk) import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.XML (escapeStringForXML) @@ -382,20 +383,28 @@ toTableOfContents :: WriterOptions -> [Block] -> Block toTableOfContents opts bs = - BulletList $ map (elementToListItem opts) (hierarchicalize bs) + BulletList $ filter (not . null) + $ map (sectionToListItem opts) + $ makeSections (writerNumberSections opts) Nothing bs -- | Converts an Element to a list item for a table of contents, -elementToListItem :: WriterOptions -> Element -> [Block] -elementToListItem opts (Sec lev _nums (ident,_,_) headerText subsecs) - = Plain headerLink : [BulletList listContents | not (null subsecs) - , lev < writerTOCDepth opts] +sectionToListItem :: WriterOptions -> Block -> [Block] +sectionToListItem opts (Div (ident,_,_) + (Header lev (_,_,kvs) ils : subsecs)) = + Plain headerLink : [BulletList listContents | not (null listContents) + , lev < writerTOCDepth opts] where - headerText' = walk deNote headerText + num = fromMaybe "" $ lookup "number" kvs + addNumber = if null num + then id + else (Span ("",["toc-section-number"],[]) + [Str num] :) . (Space :) + headerText' = addNumber $ walk (deLink . deNote) ils headerLink = if null ident then headerText' else [Link nullAttr headerText' ('#':ident, "")] - listContents = map (elementToListItem opts) subsecs -elementToListItem _ (Blk _) = [] + listContents = filter (not . null) $ map (sectionToListItem opts) subsecs +sectionToListItem _ _ = [] endsWithPlain :: [Block] -> Bool endsWithPlain xs = diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs index 25062d6fc..b9b5aaa85 100644 --- a/src/Text/Pandoc/Writers/TEI.hs +++ b/src/Text/Pandoc/Writers/TEI.hs @@ -32,21 +32,20 @@ import Text.Pandoc.XML -- | Convert Pandoc document to string in Docbook format. writeTEI :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeTEI opts (Pandoc meta blocks) = do - let elements = hierarchicalize blocks - colwidth = if writerWrapText opts == WrapAuto + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing - startLvl = case writerTopLevelDivision opts of + let startLvl = case writerTopLevelDivision opts of TopLevelPart -> -1 TopLevelChapter -> 0 TopLevelSection -> 1 TopLevelDefault -> 1 + let fromBlocks = blocksToTEI opts . makeSections False (Just startLvl) metadata <- metaToContext opts - (fmap vcat . - mapM (elementToTEI opts startLvl) . hierarchicalize) + fromBlocks (fmap chomp . inlinesToTEI opts) meta - main <- vcat <$> mapM (elementToTEI opts startLvl) elements + main <- fromBlocks blocks let context = defField "body" main $ defField "mathml" (case writerHTMLMathMethod opts of MathML -> True @@ -56,25 +55,6 @@ writeTEI opts (Pandoc meta blocks) = do Nothing -> main Just tpl -> renderTemplate tpl context --- | Convert an Element to TEI. -elementToTEI :: PandocMonad m => WriterOptions -> Int -> Element -> m (Doc Text) -elementToTEI opts _ (Blk block) = blockToTEI opts block -elementToTEI opts lvl (Sec _ _num attr title elements) = do - -- TEI doesn't allow sections with no content, so insert some if needed - let elements' = if null elements - then [Blk (Para [])] - else elements - -- level numbering correspond to LaTeX internals - divType = case lvl of - n | n == -1 -> "part" - | n == 0 -> "chapter" - | n >= 1 && n <= 5 -> "level" ++ show n - | otherwise -> "section" - contents <- vcat <$> mapM (elementToTEI opts (lvl + 1)) elements' - titleContents <- inlinesToTEI opts title - return $ inTags True "div" (("type", divType) : idFromAttr opts attr) $ - inTagsSimple "head" titleContents $$ contents - -- | Convert a list of Pandoc blocks to TEI. blocksToTEI :: PandocMonad m => WriterOptions -> [Block] -> m (Doc Text) blocksToTEI opts bs = vcat <$> mapM (blockToTEI opts) bs @@ -121,6 +101,22 @@ imageToTEI opts attr src = return $ selfClosingTag "graphic" $ -- | Convert a Pandoc block element to TEI. blockToTEI :: PandocMonad m => WriterOptions -> Block -> m (Doc Text) blockToTEI _ Null = return empty +blockToTEI opts (Div attr@(_,"section":_,_) (Header lvl _ ils : xs)) = + do + -- TEI doesn't allow sections with no content, so insert some if needed + let xs' = if null xs + then [Para []] + else xs + -- level numbering correspond to LaTeX internals + divType = case lvl of + n | n == -1 -> "part" + | n == 0 -> "chapter" + | n >= 1 && n <= 5 -> "level" ++ show n + | otherwise -> "section" + titleContents <- inlinesToTEI opts ils + contents <- blocksToTEI opts xs' + return $ inTags True "div" (("type", divType) : idFromAttr opts attr) $ + inTagsSimple "head" titleContents $$ contents -- Add ids to paragraphs in divs with ids - this is needed for -- pandoc-citeproc to get link anchors in bibliographies: blockToTEI opts (Div attr [Para lst]) = do @@ -128,7 +124,7 @@ blockToTEI opts (Div attr [Para lst]) = do inTags False "p" attribs <$> inlinesToTEI opts lst blockToTEI opts (Div _ bs) = blocksToTEI opts $ map plainToPara bs blockToTEI _ h@Header{} = do - -- should not occur after hierarchicalize, except inside lists/blockquotes + -- should not occur after makeSections, except inside lists/blockquotes report $ BlockNotRendered h return empty -- For TEI simple, text must be within containing block element, so |