aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Writers')
-rw-r--r--src/Text/Pandoc/Writers/AsciiDoc.hs15
-rw-r--r--src/Text/Pandoc/Writers/ConTeXt.hs18
-rw-r--r--src/Text/Pandoc/Writers/Docbook.hs62
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs2
-rw-r--r--src/Text/Pandoc/Writers/EPUB.hs54
-rw-r--r--src/Text/Pandoc/Writers/FB2.hs33
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs233
-rw-r--r--src/Text/Pandoc/Writers/JATS.hs39
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs283
-rw-r--r--src/Text/Pandoc/Writers/OPML.hs35
-rw-r--r--src/Text/Pandoc/Writers/Shared.hs27
-rw-r--r--src/Text/Pandoc/Writers/TEI.hs48
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-22 14:32:43 +0000