diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/HTML.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 121 |
1 files changed, 89 insertions, 32 deletions
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 89fc110ef..c96d4622a 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -74,9 +74,11 @@ import Text.TeXMath import Text.XML.Light (elChildren, unode, unqual) import qualified Text.XML.Light as XML import Text.XML.Light.Output +import Data.String (fromString) data WriterState = WriterState { stNotes :: [Html] -- ^ List of notes + , stEmittedNotes :: Int -- ^ How many notes we've already pushed out to the HTML , stMath :: Bool -- ^ Math is used in document , stQuotes :: Bool -- ^ <q> tag is used , stHighlighting :: Bool -- ^ Syntax highlighting is used @@ -88,10 +90,11 @@ data WriterState = WriterState , stCodeBlockNum :: Int -- ^ Number of code block , stCsl :: Bool -- ^ Has CSL references , stCslEntrySpacing :: Maybe Int -- ^ CSL entry spacing + , stBlockLevel :: Int -- ^ Current block depth, excluding section divs } defaultWriterState :: WriterState -defaultWriterState = WriterState {stNotes= [], stMath = False, stQuotes = False, +defaultWriterState = WriterState {stNotes= [], stEmittedNotes = 0, stMath = False, stQuotes = False, stHighlighting = False, stHtml5 = False, stEPUBVersion = Nothing, @@ -100,7 +103,8 @@ defaultWriterState = WriterState {stNotes= [], stMath = False, stQuotes = False, stInSection = False, stCodeBlockNum = 0, stCsl = False, - stCslEntrySpacing = Nothing} + stCslEntrySpacing = Nothing, + stBlockLevel = 0} -- Helpers to render HTML with the appropriate function. @@ -266,8 +270,16 @@ pandocToHtml opts (Pandoc meta blocks) = do then fmap renderHtml' <$> tableOfContents opts sects else return Nothing blocks' <- blockListToHtml opts sects + notes <- do + -- make the st private just to be safe, since we modify it right afterwards + st <- get + if null (stNotes st) + then return mempty + else do + notes <- footnoteSection opts EndOfDocument (stEmittedNotes st + 1) (reverse (stNotes st)) + modify (\st' -> st'{ stNotes = mempty, stEmittedNotes = stEmittedNotes st' + length (stNotes st') }) + return notes st <- get - notes <- footnoteSection opts (reverse (stNotes st)) let thebody = blocks' >> notes let math = case writerHTMLMathMethod opts of MathJax url @@ -490,28 +502,43 @@ tableOfContents opts sects = do -- | Convert list of Note blocks to a footnote <div>. -- Assumes notes are sorted. -footnoteSection :: PandocMonad m - => WriterOptions -> [Html] -> StateT WriterState m Html -footnoteSection opts notes = do +footnoteSection :: + PandocMonad m => WriterOptions -> ReferenceLocation -> Int -> [Html] -> StateT WriterState m Html +footnoteSection opts refLocation startCounter notes = do html5 <- gets stHtml5 slideVariant <- gets stSlideVariant - let hrtag = if html5 then H5.hr else H.hr + let hrtag = if refLocation /= EndOfBlock then (if html5 then H5.hr else H.hr) else mempty + let additionalClassName = case refLocation of + EndOfBlock -> "footnotes-end-of-block" + EndOfDocument -> "footnotes-end-of-document" + EndOfSection -> "footnotes-end-of-section" + let className = "footnotes " <> additionalClassName epubVersion <- gets stEPUBVersion let container x | html5 , epubVersion == Just EPUB3 - = H5.section ! A.class_ "footnotes" + = H5.section ! A.class_ className ! customAttribute "epub:type" "footnotes" $ x - | html5 = H5.section ! A.class_ "footnotes" + | html5 = H5.section ! A.class_ className ! customAttribute "role" "doc-endnotes" $ x | slideVariant /= NoSlides = H.div ! A.class_ "footnotes slide" $ x - | otherwise = H.div ! A.class_ "footnotes" $ x + | otherwise = H.div ! A.class_ className $ x return $ if null notes then mempty - else nl opts >> container (nl opts >> hrtag >> nl opts >> - H.ol (mconcat notes >> nl opts) >> nl opts) + else do + nl opts + container $ do + nl opts + hrtag + nl opts + -- Keep the previous output exactly the same if we don't + -- have multiple notes sections + if startCounter == 1 + then H.ol $ mconcat notes >> nl opts + else H.ol ! A.start (fromString (show startCounter)) $ mconcat notes >> nl opts + nl opts -- | Parse a mailto link; return Just (name, domain) or Nothing. parseMailto :: Text -> Maybe (Text, Text) @@ -702,11 +729,10 @@ adjustNumbers opts doc = fixnum x = x showSecNum = T.intercalate "." . map tshow --- | Convert Pandoc block element to HTML. -blockToHtml :: PandocMonad m => WriterOptions -> Block -> StateT WriterState m Html -blockToHtml _ Null = return mempty -blockToHtml opts (Plain lst) = inlineListToHtml opts lst -blockToHtml opts (Para [Image attr@(_,classes,_) txt (src,tit)]) +blockToHtmlInner :: PandocMonad m => WriterOptions -> Block -> StateT WriterState m Html +blockToHtmlInner _ Null = return mempty +blockToHtmlInner opts (Plain lst) = inlineListToHtml opts lst +blockToHtmlInner opts (Para [Image attr@(_,classes,_) txt (src,tit)]) | "stretch" `elem` classes = do slideVariant <- gets stSlideVariant case slideVariant of @@ -716,20 +742,20 @@ blockToHtml opts (Para [Image attr@(_,classes,_) txt (src,tit)]) inlineToHtml opts (Image attr txt (src, tit)) _ -> figure opts attr txt (src, tit) -- title beginning with fig: indicates that the image is a figure -blockToHtml opts (Para [Image attr txt (s,T.stripPrefix "fig:" -> Just tit)]) = +blockToHtmlInner opts (Para [Image attr txt (s,T.stripPrefix "fig:" -> Just tit)]) = figure opts attr txt (s,tit) -blockToHtml opts (Para lst) = do +blockToHtmlInner opts (Para lst) = do contents <- inlineListToHtml opts lst case contents of Empty _ | not (isEnabled Ext_empty_paragraphs opts) -> return mempty _ -> return $ H.p contents -blockToHtml opts (LineBlock lns) = +blockToHtmlInner opts (LineBlock lns) = if writerWrapText opts == WrapNone then blockToHtml opts $ linesToPara lns else do htmlLines <- inlineListToHtml opts $ intercalate [LineBreak] lns return $ H.div ! A.class_ "line-block" $ htmlLines -blockToHtml opts (Div (ident, "section":dclasses, dkvs) +blockToHtmlInner opts (Div (ident, "section":dclasses, dkvs) (Header level hattr@(hident,hclasses,hkvs) ils : xs)) = do slideVariant <- gets stSlideVariant @@ -810,7 +836,7 @@ blockToHtml opts (Div (ident, "section":dclasses, dkvs) if null innerSecs then mempty else nl opts <> innerContents -blockToHtml opts (Div attr@(ident, classes, kvs') bs) = do +blockToHtmlInner opts (Div attr@(ident, classes, kvs') bs) = do html5 <- gets stHtml5 slideVariant <- gets stSlideVariant let isCslBibBody = ident == "refs" || "csl-bib-body" `elem` classes @@ -864,7 +890,7 @@ blockToHtml opts (Div attr@(ident, classes, kvs') bs) = do _ -> return mempty else addAttrs opts (ident, classes'', kvs) $ divtag contents' -blockToHtml opts (RawBlock f str) = do +blockToHtmlInner opts (RawBlock f str) = do ishtml <- isRawHtml f if ishtml then return $ preEscapedText str @@ -875,10 +901,10 @@ blockToHtml opts (RawBlock f str) = do else do report $ BlockNotRendered (RawBlock f str) return mempty -blockToHtml _ HorizontalRule = do +blockToHtmlInner _ HorizontalRule = do html5 <- gets stHtml5 return $ if html5 then H5.hr else H.hr -blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do +blockToHtmlInner opts (CodeBlock (id',classes,keyvals) rawCode) = do id'' <- if T.null id' then do modify $ \st -> st{ stCodeBlockNum = stCodeBlockNum st + 1 } @@ -910,7 +936,7 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do -- we set writerIdentifierPrefix to "" since id'' already -- includes it: addAttrs opts{writerIdentifierPrefix = ""} (id'',[],keyvals) h -blockToHtml opts (BlockQuote blocks) = do +blockToHtmlInner opts (BlockQuote blocks) = do -- in S5, treat list in blockquote specially -- if default is incremental, make it nonincremental; -- otherwise incremental @@ -932,7 +958,7 @@ blockToHtml opts (BlockQuote blocks) = do else do contents <- blockListToHtml opts blocks return $ H.blockquote $ nl opts >> contents >> nl opts -blockToHtml opts (Header level (ident,classes,kvs) lst) = do +blockToHtmlInner opts (Header level (ident,classes,kvs) lst) = do contents <- inlineListToHtml opts lst let secnum = fromMaybe mempty $ lookup "number" kvs let contents' = if writerNumberSections opts && not (T.null secnum) @@ -955,12 +981,12 @@ blockToHtml opts (Header level (ident,classes,kvs) lst) = do 5 -> H.h5 contents' 6 -> H.h6 contents' _ -> H.p ! A.class_ "heading" $ contents' -blockToHtml opts (BulletList lst) = do +blockToHtmlInner opts (BulletList lst) = do contents <- mapM (listItemToHtml opts) lst let isTaskList = not (null lst) && all isTaskListItem lst (if isTaskList then (! A.class_ "task-list") else id) <$> unordList opts contents -blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do +blockToHtmlInner opts (OrderedList (startnum, numstyle, _) lst) = do contents <- mapM (listItemToHtml opts) lst html5 <- gets stHtml5 let numstyle' = case numstyle of @@ -983,7 +1009,7 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do else []) l <- ordList opts contents return $ foldl' (!) l attribs -blockToHtml opts (DefinitionList lst) = do +blockToHtmlInner opts (DefinitionList lst) = do contents <- mapM (\(term, defs) -> do term' <- liftM H.dt $ inlineListToHtml opts term defs' <- mapM (liftM (\x -> H.dd (x >> nl opts)) . @@ -991,9 +1017,39 @@ blockToHtml opts (DefinitionList lst) = do return $ mconcat $ nl opts : term' : nl opts : intersperse (nl opts) defs') lst defList opts contents -blockToHtml opts (Table attr caption colspecs thead tbody tfoot) = +blockToHtmlInner opts (Table attr caption colspecs thead tbody tfoot) = tableToHtml opts (Ann.toTable attr caption colspecs thead tbody tfoot) +-- | Convert Pandoc block element to HTML. All the legwork is done by +-- 'blockToHtmlInner', this just takes care of emitting the notes after +-- the block if necessary. +blockToHtml :: PandocMonad m => WriterOptions -> Block -> StateT WriterState m Html +blockToHtml opts block = do + -- Ignore inserted section divs -- they are not blocks as they came from + -- the document itself (at least not when coming from markdown) + let isSection = case block of + Div (_, classes, _) _ | "section" `elem` classes -> True + _ -> False + let increaseLevel = not isSection + when increaseLevel $ + modify (\st -> st{ stBlockLevel = stBlockLevel st + 1 }) + doc <- blockToHtmlInner opts block + st <- get + let emitNotes = + (writerReferenceLocation opts == EndOfBlock && stBlockLevel st == 1) || + (writerReferenceLocation opts == EndOfSection && isSection) + res <- if emitNotes + then do + notes <- if null (stNotes st) + then return mempty + else footnoteSection opts (writerReferenceLocation opts) (stEmittedNotes st + 1) (reverse (stNotes st)) + modify (\st' -> st'{ stNotes = mempty, stEmittedNotes = stEmittedNotes st' + length (stNotes st') }) + return (doc <> notes) + else return doc + when increaseLevel $ + modify (\st' -> st'{ stBlockLevel = stBlockLevel st' - 1 }) + return res + tableToHtml :: PandocMonad m => WriterOptions -> Ann.Table @@ -1468,7 +1524,8 @@ inlineToHtml opts inline = do -- note: null title included, as in Markdown.pl (Note contents) -> do notes <- gets stNotes - let number = length notes + 1 + emittedNotes <- gets stEmittedNotes + let number = emittedNotes + length notes + 1 let ref = tshow number htmlContents <- blockListToNote opts ref contents epubVersion <- gets stEPUBVersion |