T.P.Writers.Shared - add toTableOfContents (API change).

This is refactored out from the Markdown writer.
IT can be used in other writers to create a generic TOC.
This commit is contained in:
John MacFarlane 2019-01-04 21:09:49 -08:00
parent 4ac036fe13
commit 0d609a72fd
2 changed files with 25 additions and 22 deletions

View file

@ -212,7 +212,8 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
Nothing -> empty Nothing -> empty
let headerBlocks = filter isHeaderBlock blocks let headerBlocks = filter isHeaderBlock blocks
toc <- if writerTableOfContents opts toc <- if writerTableOfContents opts
then render' <$> tableOfContents opts headerBlocks then render' <$> blockToMarkdown opts
( toTableOfContents opts $ headerBlocks )
else return "" else return ""
-- Strip off final 'references' header if markdown citations enabled -- Strip off final 'references' header if markdown citations enabled
let blocks' = if isEnabled Ext_citations opts let blocks' = if isEnabled Ext_citations opts
@ -319,26 +320,6 @@ escapeString opts =
_ -> '.':go cs _ -> '.':go cs
_ -> c : go cs _ -> c : go cs
-- | Construct table of contents from list of header blocks.
tableOfContents :: PandocMonad m => WriterOptions -> [Block] -> MD m Doc
tableOfContents opts headers = do
contents <- BulletList <$> mapM (elementToListItem opts) (hierarchicalize headers)
blockToMarkdown opts contents
-- | Converts an Element to a list item for a table of contents,
elementToListItem :: PandocMonad m => WriterOptions -> Element -> MD m [Block]
elementToListItem opts (Sec lev _nums (ident,_,_) headerText subsecs)
= do isPlain <- asks envPlain
let headerLink = if null ident || isPlain
then walk deNote headerText
else [Link nullAttr (walk deNote headerText)
('#':ident, "")]
listContents <- if null subsecs || lev >= writerTOCDepth opts
then return []
else mapM (elementToListItem opts) subsecs
return [Plain headerLink, BulletList listContents]
elementToListItem _ (Blk _) = return []
attrsToMarkdown :: Attr -> Doc attrsToMarkdown :: Attr -> Doc
attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys] attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys]
where attribId = case attribs of where attribId = case attribs of

View file

@ -49,6 +49,7 @@ module Text.Pandoc.Writers.Shared (
, stripLeadingTrailingSpace , stripLeadingTrailingSpace
, toSubscript , toSubscript
, toSuperscript , toSuperscript
, toTableOfContents
) )
where where
import Prelude import Prelude
@ -66,7 +67,8 @@ import qualified Text.Pandoc.Builder as Builder
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.Pretty import Text.Pandoc.Pretty
import Text.Pandoc.Shared (stringify) import Text.Pandoc.Shared (stringify, hierarchicalize, Element(..), deNote)
import Text.Pandoc.Walk (walk)
import Text.Pandoc.UTF8 (toStringLazy) import Text.Pandoc.UTF8 (toStringLazy)
import Text.Pandoc.XML (escapeStringForXML) import Text.Pandoc.XML (escapeStringForXML)
@ -412,3 +414,23 @@ toSubscript c
Just $ chr (0x2080 + (ord c - 48)) Just $ chr (0x2080 + (ord c - 48))
| isSpace c = Just c | isSpace c = Just c
| otherwise = Nothing | otherwise = Nothing
-- | Construct table of contents (as a bullet list) from document body.
toTableOfContents :: WriterOptions
-> [Block]
-> Block
toTableOfContents opts bs =
BulletList $ map (elementToListItem opts) (hierarchicalize 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]
where
headerText' = walk deNote headerText
headerLink = if null ident
then headerText'
else [Link nullAttr headerText' ('#':ident, "")]
listContents = map (elementToListItem opts) subsecs
elementToListItem _ (Blk _) = []