From 9f984ff26ac248a27212a37ab34754a2e9261e8c Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Sat, 7 Sep 2019 11:23:12 -0700
Subject: [PATCH] Replace Element and makeHierarchical with makeSections.
Text.Pandoc.Shared:
+ Remove `Element` type [API change]
+ Remove `makeHierarchicalize` [API change]
+ Add `makeSections` [API change]
+ Export `deLink` [API change]
Now that we have Divs, we can use them to represent the structure
of sections, and we don't need a special Element type.
`makeSections` reorganizes a block list, adding Divs with
class `section` around sections, and adding numbering
if needed.
This change also fixes some longstanding issues recognizing
section structure when the document contains Divs.
Closes #3057, see also #997.
All writers have been changed to use `makeSections`.
Note that in the process we have reverted the change
c1d058aeb1c6a331a2cc22786ffaab17f7118ccd
made in response to #5168, which I'm not completely
sure was a good idea.
Lua modules have also been adjusted accordingly.
Existing lua filters that use `hierarchicalize` will
need to be rewritten to use `make_sections`.
---
doc/lua-filters.md | 62 ++----
src/Text/Pandoc/Lua/Marshaling/AST.hs | 31 ---
src/Text/Pandoc/Lua/Module/Types.hs | 5 -
src/Text/Pandoc/Lua/Module/Utils.hs | 9 +-
src/Text/Pandoc/Shared.hs | 125 ++++++------
src/Text/Pandoc/Slides.hs | 2 +-
src/Text/Pandoc/Writers/AsciiDoc.hs | 15 +-
src/Text/Pandoc/Writers/ConTeXt.hs | 18 +-
src/Text/Pandoc/Writers/Docbook.hs | 62 +++---
src/Text/Pandoc/Writers/Docx.hs | 2 +-
src/Text/Pandoc/Writers/EPUB.hs | 54 ++---
src/Text/Pandoc/Writers/FB2.hs | 31 ++-
src/Text/Pandoc/Writers/HTML.hs | 233 +++++++++------------
src/Text/Pandoc/Writers/JATS.hs | 39 ++--
src/Text/Pandoc/Writers/LaTeX.hs | 283 ++++++++++++--------------
src/Text/Pandoc/Writers/OPML.hs | 35 ++--
src/Text/Pandoc/Writers/Shared.hs | 27 ++-
src/Text/Pandoc/Writers/TEI.hs | 48 ++---
test/command/1710.md | 2 -
test/command/4016.md | 8 +-
test/command/4690.md | 2 -
test/command/empty_paragraphs.md | 2 -
test/lua/module/pandoc-utils.lua | 13 +-
test/writer.html4 | 1 -
test/writer.html5 | 1 -
25 files changed, 477 insertions(+), 633 deletions(-)
diff --git a/doc/lua-filters.md b/doc/lua-filters.md
index 15fa49378..87071ffc4 100644
--- a/doc/lua-filters.md
+++ b/doc/lua-filters.md
@@ -1314,40 +1314,6 @@ Object equality is determined via
: delimiter of list numbers; one of `DefaultDelim`, `Period`,
`OneParen`, and `TwoParens` (string)
-## Hierarchical Element {#type-ref-Element}
-
-Hierarchical elements can be either *Sec* (sections) or *Blk*
-(blocks). *Blk* elements are treated like
-[Block](#type-ref-Block)s.
-
-### Sec {#type-ref-Sec}
-
-Section elements used to provide hierarchical information on
-document contents.
-
-**Objects of this type are read-only.**
-
-`level`
-: header level (integer)
-
-`numbering`
-: section numbering ([list](#module-pandoc.list) of integers)
-
-`attr`
-: header attributes ([Attr](#type-ref-Attr))
-
-`label`
-: header content ([list](#module-pandoc.list) of
- [Inline](#type-ref-Inline)s)
-
-`contents`
-: list of contents in this section
- ([list](#module-pandoc.list) of [hierarchical
- element](#Element)s)
-
-`tag`, `t`
-: constant `Sec` (string)
-
## ReaderOptions {#type-ref-ReaderOptions}
Pandoc reader options
@@ -2392,23 +2358,23 @@ Returns:
- Whether the two objects represent the same element (boolean)
-### hierarchicalize {#utils-hierarchicalize}
+### make\_sections {#utils-make_sections}
-`hierarchicalize (blocks)`
+`make_sections (number_sections, base_level, blocks)`
-Convert list of [Blocks](#Blocks) into an hierarchical list. An
-hierarchical elements is either a normal block (but no Header),
-or a `Sec` element. The latter has the following fields:
-
-- level: level in the document hierarchy;
-- numbering: list of integers of length `level`, specifying
- the absolute position of the section in the document;
-- attr: section attributes (see [Attr](#Attr));
-- contents: nested list of hierarchical elements.
+Converst list of [Blocks](#Blocks) into sections.
+`Div`s will be created beginning at each `Header`
+and containing following content until the next `Header`
+of comparable level. If `number_sections` is true,
+a `number` attribute will be added to each `Header`
+containing the section number. If `base_level` is
+non-null, `Header` levels will be reorganized so
+that there are no gaps, and so that the base level
+is the level specified.
Returns:
-- List of hierarchical elements.
+- List of [Blocks](#Blocks).
Usage:
@@ -2416,9 +2382,7 @@ Usage:
pandoc.Header(2, pandoc.Str 'first'),
pandoc.Header(2, pandoc.Str 'second'),
}
- local elements = pandoc.utils.hierarchicalize(blocks)
- print(table.concat(elements[1].numbering, '.')) -- 0.1
- print(table.concat(elements[2].numbering, '.')) -- 0.2
+ local newblocks = pandoc.utils.make_sections(true, 1, blocks)
### run\_json\_filter {#utils-run_json_filter}
diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs
index 7b428b5f0..c9d61d3e4 100644
--- a/src/Text/Pandoc/Lua/Marshaling/AST.hs
+++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs
@@ -22,12 +22,9 @@ module Text.Pandoc.Lua.Marshaling.AST
import Prelude
import Control.Applicative ((<|>))
import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
-import Foreign.Lua.Userdata ( ensureUserdataMetatable, pushAnyWithMetatable
- , metatableName)
import Text.Pandoc.Definition
import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor)
import Text.Pandoc.Lua.Marshaling.CommonState ()
-import Text.Pandoc.Shared (Element (Blk, Sec))
import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.Lua.Util as LuaUtil
@@ -285,31 +282,3 @@ instance Pushable LuaListAttributes where
instance Peekable LuaListAttributes where
peek = defineHowTo "get ListAttributes value" .
fmap LuaListAttributes . Lua.peek
-
---
--- Hierarchical elements
---
-instance Pushable Element where
- push (Blk blk) = Lua.push blk
- push sec = pushAnyWithMetatable pushElementMetatable sec
- where
- pushElementMetatable = ensureUserdataMetatable (metatableName sec) $
- LuaUtil.addFunction "__index" indexElement
-
-instance Peekable Element where
- peek idx = Lua.ltype idx >>= \case
- Lua.TypeUserdata -> Lua.peekAny idx
- _ -> Blk <$> Lua.peek idx
-
-indexElement :: Element -> String -> Lua Lua.NumResults
-indexElement = \case
- (Blk _) -> const (1 <$ Lua.pushnil) -- this shouldn't happen
- (Sec lvl num attr label contents) -> fmap (return 1) . \case
- "level" -> Lua.push lvl
- "numbering" -> Lua.push num
- "attr" -> Lua.push (LuaAttr attr)
- "label" -> Lua.push label
- "contents" -> Lua.push contents
- "tag" -> Lua.push "Sec"
- "t" -> Lua.push "Sec"
- _ -> Lua.pushnil
diff --git a/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs
index fdc63cd99..a6bfa529c 100644
--- a/src/Text/Pandoc/Lua/Module/Types.hs
+++ b/src/Text/Pandoc/Lua/Module/Types.hs
@@ -19,7 +19,6 @@ import Text.Pandoc.Definition
import Text.Pandoc.Lua.Marshaling.AST (LuaAttr, LuaListAttributes)
import Text.Pandoc.Lua.Marshaling.Version ()
import Text.Pandoc.Lua.Util (addFunction)
-import Text.Pandoc.Shared (Element (..))
import qualified Foreign.Lua as Lua
@@ -38,7 +37,6 @@ pushCloneTable = do
addFunction "Attr" cloneAttr
addFunction "Block" cloneBlock
addFunction "Citation" cloneCitation
- addFunction "Element" cloneElement
addFunction "Inline" cloneInline
addFunction "Meta" cloneMeta
addFunction "MetaValue" cloneMetaValue
@@ -55,9 +53,6 @@ cloneBlock = return
cloneCitation :: Citation -> Lua Citation
cloneCitation = return
-cloneElement :: Element -> Lua Element
-cloneElement = return
-
cloneInline :: Inline -> Lua Inline
cloneInline = return
diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs
index 21e3f5674..057e6580b 100644
--- a/src/Text/Pandoc/Lua/Module/Utils.hs
+++ b/src/Text/Pandoc/Lua/Module/Utils.hs
@@ -38,7 +38,7 @@ pushModule mbDatadir = do
Lua.newtable
addFunction "blocks_to_inlines" blocksToInlines
addFunction "equals" equals
- addFunction "hierarchicalize" hierarchicalize
+ addFunction "make_sections" makeSections
addFunction "normalize_date" normalizeDate
addFunction "run_json_filter" (runJSONFilter mbDatadir)
addFunction "sha1" sha1
@@ -55,9 +55,10 @@ blocksToInlines blks optSep = do
Nothing -> Shared.defaultBlocksSeparator
return $ B.toList (Shared.blocksToInlinesWithSep sep blks)
--- | Convert list of Pandoc blocks into (hierarchical) list of Elements.
-hierarchicalize :: [Block] -> Lua [Shared.Element]
-hierarchicalize = return . Shared.hierarchicalize
+-- | Convert list of Pandoc blocks into sections using Divs.
+makeSections :: Bool -> Lua.Optional Int -> [Block] -> Lua [Block]
+makeSections number baselevel =
+ return . Shared.makeSections number (Lua.fromOptional baselevel)
-- | Parse a date and convert (if possible) to "YYYY-MM-DD" format. We
-- limit years to the range 1601-9999 (ISO 8601 accepts greater than
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 7c3546f44..06715145e 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -47,13 +47,13 @@ module Text.Pandoc.Shared (
extractSpaces,
removeFormatting,
deNote,
+ deLink,
stringify,
capitalize,
compactify,
compactifyDL,
linesToPara,
- Element (..),
- hierarchicalize,
+ makeSections,
uniqueIdent,
inlineListToIdentifier,
isHeaderBlock,
@@ -104,11 +104,10 @@ import qualified Data.Bifunctor as Bifunctor
import Data.Char (isAlpha, isLower, isSpace, isUpper, toLower, isAlphaNum,
generalCategory, GeneralCategory(NonSpacingMark,
SpacingCombiningMark, EnclosingMark, ConnectorPunctuation))
-import Data.Data (Data, Typeable)
import Data.List (find, intercalate, intersperse, stripPrefix, sortBy)
import Data.Ord (comparing)
import qualified Data.Map as M
-import Data.Maybe (mapMaybe)
+import Data.Maybe (mapMaybe, fromMaybe)
import Data.Monoid (Any (..))
import Data.Sequence (ViewL (..), ViewR (..), viewl, viewr)
import qualified Data.Set as Set
@@ -366,6 +365,10 @@ deNote :: Inline -> Inline
deNote (Note _) = Str ""
deNote x = x
+deLink :: Inline -> Inline
+deLink (Link _ ils _) = Span nullAttr ils
+deLink x = x
+
deQuote :: Inline -> Inline
deQuote (Quoted SingleQuote xs) =
Span ("",[],[]) (Str "\8216" : xs ++ [Str "\8217"])
@@ -449,34 +452,6 @@ isPara :: Block -> Bool
isPara (Para _) = True
isPara _ = False
--- | Data structure for defining hierarchical Pandoc documents
-data Element = Blk Block
- | Sec Int [Int] Attr [Inline] [Element]
- -- lvl num attributes label contents
- deriving (Eq, Read, Show, Typeable, Data)
-
-instance Walkable Inline Element where
- walk f (Blk x) = Blk (walk f x)
- walk f (Sec lev nums attr ils elts) = Sec lev nums attr (walk f ils) (walk f elts)
- walkM f (Blk x) = Blk `fmap` walkM f x
- walkM f (Sec lev nums attr ils elts) = do
- ils' <- walkM f ils
- elts' <- walkM f elts
- return $ Sec lev nums attr ils' elts'
- query f (Blk x) = query f x
- query f (Sec _ _ _ ils elts) = query f ils `mappend` query f elts
-
-instance Walkable Block Element where
- walk f (Blk x) = Blk (walk f x)
- walk f (Sec lev nums attr ils elts) = Sec lev nums attr (walk f ils) (walk f elts)
- walkM f (Blk x) = Blk `fmap` walkM f x
- walkM f (Sec lev nums attr ils elts) = do
- ils' <- walkM f ils
- elts' <- walkM f elts
- return $ Sec lev nums attr ils' elts'
- query f (Blk x) = query f x
- query f (Sec _ _ _ ils elts) = query f ils `mappend` query f elts
-
-- | Convert Pandoc inline list to plain text identifier. HTML
-- identifiers must start with a letter, and may contain only
-- letters, digits, and the characters _-.
@@ -504,37 +479,67 @@ inlineListToIdentifier exts =
| otherwise = c == '_' || c == '-' || c == '.'
spaceToDash = map (\c -> if isSpace c then '-' else c)
--- | Convert list of Pandoc blocks into (hierarchical) list of Elements
-hierarchicalize :: [Block] -> [Element]
-hierarchicalize blocks = S.evalState (hierarchicalizeWithIds blocks) []
-hierarchicalizeWithIds :: [Block] -> S.State [Int] [Element]
-hierarchicalizeWithIds [] = return []
-hierarchicalizeWithIds (Header level attr@(_,classes,_) title':xs) = do
- lastnum <- S.get
- let lastnum' = take level lastnum
- let newnum = case length lastnum' of
- x | "unnumbered" `elem` classes -> []
- | x >= level -> init lastnum' ++ [last lastnum' + 1]
- | otherwise -> lastnum ++
- replicate (level - length lastnum - 1) 0 ++ [1]
- unless (null newnum) $ S.put newnum
- let (sectionContents, rest) = break (headerLtEq level) xs
- sectionContents' <- hierarchicalizeWithIds sectionContents
- rest' <- hierarchicalizeWithIds rest
- return $ Sec level newnum attr title' sectionContents' : rest'
-hierarchicalizeWithIds (Div ("refs",classes',kvs')
- (Header level (ident,classes,kvs) title' : xs):ys) =
- hierarchicalizeWithIds (Header level (ident,"references":classes,kvs)
- title' : Div ("refs",classes',kvs') xs : ys)
-hierarchicalizeWithIds (x:rest) = do
- rest' <- hierarchicalizeWithIds rest
- return $ Blk x : rest'
+-- | Put a list of Pandoc blocks into a hierarchical structure:
+-- a list of sections (each a Div with class "section" and first
+-- element a Header). If the 'numbering' parameter is True, Header
+-- numbers are added via the number attribute on the header.
+-- If the baseLevel parameter is Just n, Header levels are
+-- adjusted to be gapless starting at level n.
+makeSections :: Bool -> Maybe Int -> [Block] -> [Block]
+makeSections numbering mbBaseLevel bs =
+ S.evalState (go bs) (mbBaseLevel, [])
+ where
+ go :: [Block] -> S.State (Maybe Int, [Int]) [Block]
+ go (Header level (ident,classes,kvs) title':xs) = do
+ (mbLevel, lastnum) <- S.get
+ let level' = fromMaybe level mbLevel
+ let lastnum' = take level' lastnum
+ let newnum =
+ if level' > 0
+ then case length lastnum' of
+ x | "unnumbered" `elem` classes -> []
+ | x >= level' -> init lastnum' ++ [last lastnum' + 1]
+ | otherwise -> lastnum ++
+ replicate (level' - length lastnum - 1) 0 ++ [1]
+ else []
+ unless (null newnum) $ S.modify $ \(mbl, _) -> (mbl, newnum)
+ let (sectionContents, rest) = break (headerLtEq level) xs
+ S.modify $ \(_, ln) -> (fmap (+ 1) mbLevel, ln)
+ sectionContents' <- go sectionContents
+ S.modify $ \(_, ln) -> (mbLevel, ln)
+ rest' <- go rest
+ let divattr = (ident, ["section"], [])
+ let attr = ("",classes,kvs ++
+ [("number", intercalate "." (map show newnum))
+ | numbering])
+ return $
+ Div divattr (Header level' attr title' : sectionContents') : rest'
+ go (Div (dident,dclasses,dkvs)
+ (Header level (ident,classes,kvs) title':ys) : xs) = do
+ inner <- go (Header level (ident,classes,kvs) title':ys)
+ let inner' =
+ case inner of
+ (Div (dident',dclasses',dkvs') zs@(Header{}:zs') : ws)
+ | null dident ->
+ Div (dident',dclasses' ++ dclasses,dkvs' ++ dkvs) zs : ws
+ | otherwise -> -- keep id on header so we don't lose anchor
+ Div (dident,dclasses ++ dclasses',dkvs ++ dkvs')
+ (Header level (dident',classes,kvs) title':zs') : ws
+ _ -> inner -- shouldn't happen
+ rest <- go xs
+ return $ inner' ++ rest
+ go (Div attr xs : rest) = do
+ xs' <- go xs
+ rest' <- go rest
+ return $ Div attr xs' : rest'
+ go (x:xs) = (x :) <$> go xs
+ go [] = return []
headerLtEq :: Int -> Block -> Bool
-headerLtEq level (Header l _ _) = l <= level
-headerLtEq level (Div ("",["references"],[]) (Header l _ _ : _)) = l <= level
-headerLtEq _ _ = False
+headerLtEq level (Header l _ _) = l <= level
+headerLtEq level (Div _ (b:_)) = headerLtEq level b
+headerLtEq _ _ = False
-- | Generate a unique identifier from a list of inlines.
-- Second argument is a list of already used identifiers.
diff --git a/src/Text/Pandoc/Slides.hs b/src/Text/Pandoc/Slides.hs
index 58f3be273..8fb1b63aa 100644
--- a/src/Text/Pandoc/Slides.hs
+++ b/src/Text/Pandoc/Slides.hs
@@ -28,7 +28,7 @@ getSlideLevel = go 6
nonHOrHR HorizontalRule = False
nonHOrHR _ = True
--- | Prepare a block list to be passed to hierarchicalize.
+-- | Prepare a block list to be passed to makeSections.
prepSlides :: Int -> [Block] -> [Block]
prepSlides slideLevel = ensureStartWithH . splitHrule . extractRefsHeader
where splitHrule (HorizontalRule : Header n attr xs : ys)
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'
+ 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 -> 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
+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
diff --git a/test/command/1710.md b/test/command/1710.md
index 4d9c64b30..64d86cffe 100644
--- a/test/command/1710.md
+++ b/test/command/1710.md
@@ -56,7 +56,6 @@ ok
^D
\begin{frame}{Slide one}
\protect\hypertarget{slide-one}{}
-
\begin{columns}[T]
\begin{column}{0.4\textwidth}
\begin{itemize}
@@ -82,6 +81,5 @@ ok
ok
\end{column}
\end{columns}
-
\end{frame}
```
diff --git a/test/command/4016.md b/test/command/4016.md
index 5e4e35e0d..577ac1b09 100644
--- a/test/command/4016.md
+++ b/test/command/4016.md
@@ -15,32 +15,28 @@ pandoc -t beamer
^D
\begin{frame}{Level 2 blocks}
\protect\hypertarget{level-2-blocks}{}
-
\begin{columns}[T]
\begin{column}{0.4\textwidth}
\begin{block}{Block one}
-
+\protect\hypertarget{block-one}{}
\begin{itemize}
\tightlist
\item
Item
\end{itemize}
-
\end{block}
\end{column}
\begin{column}{0.6\textwidth}
\begin{block}{Block two}
-
+\protect\hypertarget{block-two}{}
\begin{itemize}
\tightlist
\item
Item
\end{itemize}
-
\end{block}
\end{column}
\end{columns}
-
\end{frame}
```
diff --git a/test/command/4690.md b/test/command/4690.md
index deccfba13..9a46823cc 100644
--- a/test/command/4690.md
+++ b/test/command/4690.md
@@ -13,7 +13,6 @@ content2
^D
\begin{frame}{title}
\protect\hypertarget{title}{}
-
\begin{columns}[T]
\begin{column}{0.08\textwidth}
content
@@ -23,6 +22,5 @@ content
content2
\end{column}
\end{columns}
-
\end{frame}
```
diff --git a/test/command/empty_paragraphs.md b/test/command/empty_paragraphs.md
index 001aaf1b0..14bd8d060 100644
--- a/test/command/empty_paragraphs.md
+++ b/test/command/empty_paragraphs.md
@@ -37,8 +37,6 @@
[Para [Str "hi"], Para [], Para [], Para [Str "lo"]]
^D
<p>hi</p>
-
-
<p>lo</p>
```
diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua
index dc37ec354..963e70686 100644
--- a/test/lua/module/pandoc-utils.lua
+++ b/test/lua/module/pandoc-utils.lua
@@ -39,20 +39,17 @@ return {
end)
},
- group 'hierarchicalize' {
+ group 'make_sections' {
test('sanity check', function ()
local blks = {
pandoc.Header(1, {pandoc.Str 'First'}),
pandoc.Header(2, {pandoc.Str 'Second'}),
pandoc.Header(2, {pandoc.Str 'Third'}),
}
- local hblks = utils.hierarchicalize(blks)
- -- cannot create Elements directly; performing only an approximate
- -- sanity checking instead of a full equality comparison.
- assert.are_equal('Sec', hblks[1].t)
- assert.are_equal('Sec', hblks[1].contents[1].t)
- assert.are_equal(1, hblks[1].contents[2].numbering[1])
- assert.are_equal(2, hblks[1].contents[2].numbering[2])
+ local hblks = utils.make_sections(true, 1, blks)
+ assert.are_equal('Div', hblks[1].t)
+ assert.are_equal('Header', hblks[1].content[1].t)
+ assert.are_equal('1', hblks[1].content[1].attributes['number'])
end)
},
diff --git a/test/writer.html4 b/test/writer.html4
index 6882d6b6c..fdfb56f15 100644
--- a/test/writer.html4
+++ b/test/writer.html4
@@ -442,7 +442,6 @@ Blah
<li>Escaped <code>$</code>: $73 <em>this should be emphasized</em> 23$.</li>
</ul>
<p>Here’s a LaTeX table:</p>
-
<hr />
<h1 id="special-characters">Special Characters</h1>
<p>Here is some unicode:</p>
diff --git a/test/writer.html5 b/test/writer.html5
index 9b0f19b64..35772350c 100644
--- a/test/writer.html5
+++ b/test/writer.html5
@@ -445,7 +445,6 @@ Blah
<li>Escaped <code>$</code>: $73 <em>this should be emphasized</em> 23$.</li>
</ul>
<p>Here’s a LaTeX table:</p>
-
<hr />
<h1 id="special-characters">Special Characters</h1>
<p>Here is some unicode:</p>