diff options
author | John MacFarlane <jgm@berkeley.edu> | 2019-09-07 11:23:12 -0700 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2019-09-08 22:20:19 -0700 |
commit | 9f984ff26ac248a27212a37ab34754a2e9261e8c (patch) | |
tree | 642ee7fb050587af729fa2585b1c97df510c9d58 | |
parent | 1ccff3339d036db046f37c596bb4ffb6cffbf803 (diff) | |
download | pandoc-9f984ff26ac248a27212a37ab34754a2e9261e8c.tar.gz |
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`.
25 files changed, 479 insertions, 635 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} - -`hierarchicalize (blocks)` +### make\_sections {#utils-make_sections} -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: +`make_sections (number_sections, base_level, blocks)` -- 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' - - - -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 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> |