diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/HTML.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 1134 |
1 files changed, 810 insertions, 324 deletions
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 3c8c264d2..1647df7ea 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -1,6 +1,10 @@ -{-# LANGUAGE OverloadedStrings, CPP, ViewPatterns, ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE MultiWayIf #-} {- -Copyright (C) 2006-2015 John MacFarlane <jgm@berkeley.edu> +Copyright (C) 2006-2018 John MacFarlane <jgm@berkeley.edu> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +23,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.HTML - Copyright : Copyright (C) 2006-2015 John MacFarlane + Copyright : Copyright (C) 2006-2018 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley.edu> @@ -28,60 +32,92 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' documents to HTML. -} -module Text.Pandoc.Writers.HTML ( writeHtml , writeHtmlString ) where -import Text.Pandoc.Definition +module Text.Pandoc.Writers.HTML ( + writeHtml4, + writeHtml4String, + writeHtml5, + writeHtml5String, + writeHtmlStringForEPUB, + writeS5, + writeSlidy, + writeSlideous, + writeDZSlides, + writeRevealJs, + tagWithAttributes + ) where +import Control.Monad.State.Strict +import Data.Char (ord, toLower) +import Data.List (intercalate, intersperse, isPrefixOf, partition) +import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing) import Data.Monoid ((<>)) -import Text.Pandoc.Shared -import Text.Pandoc.Writers.Shared -import Text.Pandoc.Options +import qualified Data.Set as Set +import Data.String (fromString) +import Data.Text (Text) +import qualified Data.Text.Lazy as TL +import Network.HTTP (urlEncode) +import Network.URI (URI (..), parseURIReference, unEscapeString) +import Numeric (showHex) +import Text.Blaze.Internal (customLeaf, MarkupM(Empty)) +#if MIN_VERSION_blaze_markup(0,6,3) +#else +import Text.Blaze.Internal (preEscapedString, preEscapedText) +#endif +import Text.Blaze.Html hiding (contents) +import Text.Pandoc.Definition +import Text.Pandoc.Highlighting (formatHtmlBlock, formatHtmlInline, highlight, + styleToCss) import Text.Pandoc.ImageSize -import Text.Pandoc.Templates -import Text.Pandoc.Readers.TeXMath +import Text.Pandoc.Options +import Text.Pandoc.Shared import Text.Pandoc.Slides -import Text.Pandoc.Highlighting ( highlight, styleToCss, - formatHtmlInline, formatHtmlBlock ) -import Text.Pandoc.XML (fromEntities, escapeStringForXML) -import Network.URI ( parseURIReference, URI(..), unEscapeString ) -import Network.HTTP ( urlEncode ) -import Numeric ( showHex ) -import Data.Char ( ord, toLower ) -import Data.List ( isPrefixOf, intersperse ) -import Data.String ( fromString ) -import Data.Maybe ( catMaybes, fromMaybe, isJust ) -import Control.Monad.State -import Text.Blaze.Html hiding(contents) +import Text.Pandoc.Templates +import Text.Pandoc.Walk +import Text.Pandoc.Writers.Math +import Text.Pandoc.Writers.Shared +import Text.Pandoc.XML (escapeStringForXML, fromEntities) #if MIN_VERSION_blaze_markup(0,6,3) #else -import Text.Blaze.Internal(preEscapedString) +import Text.Blaze.Internal (preEscapedString, preEscapedText) #endif #if MIN_VERSION_blaze_html(0,5,1) import qualified Text.Blaze.XHtml5 as H5 #else import qualified Text.Blaze.Html5 as H5 #endif +import Control.Monad.Except (throwError) +import Data.Aeson (Value) +import System.FilePath (takeBaseName, takeExtension) +import Text.Blaze.Html.Renderer.Text (renderHtml) import qualified Text.Blaze.XHtml1.Transitional as H import qualified Text.Blaze.XHtml1.Transitional.Attributes as A -import Text.Blaze.Html.Renderer.String (renderHtml) +import Text.Pandoc.Class (PandocMonad, report, runPure) +import Text.Pandoc.Error +import Text.Pandoc.Logging import Text.TeXMath -import Text.XML.Light.Output -import Text.XML.Light (unode, elChildren, unqual) +import Text.XML.Light (elChildren, unode, unqual) import qualified Text.XML.Light as XML -import System.FilePath (takeExtension) -import Data.Aeson (Value) +import Text.XML.Light.Output data WriterState = WriterState - { stNotes :: [Html] -- ^ List of notes - , 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 + { stNotes :: [Html] -- ^ List of notes + , 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 + , stCodeBlockNum :: Int -- ^ Number of code block } defaultWriterState :: WriterState defaultWriterState = WriterState {stNotes= [], stMath = False, stQuotes = False, stHighlighting = False, stSecNum = [], - stElement = False} + stElement = False, stHtml5 = False, + stEPUBVersion = Nothing, + stSlideVariant = NoSlides, + stCodeBlockNum = 0} -- Helpers to render HTML with the appropriate function. @@ -98,62 +134,141 @@ nl opts = if writerWrapText opts == WrapNone then mempty else preEscapedString "\n" --- | Convert Pandoc document to Html string. -writeHtmlString :: WriterOptions -> Pandoc -> String -writeHtmlString opts d = - let (body, context) = evalState (pandocToHtml opts d) defaultWriterState - in case writerTemplate opts of - Nothing -> renderHtml body - Just tpl -> renderTemplate' tpl $ - defField "body" (renderHtml body) context - --- | Convert Pandoc document to Html structure. -writeHtml :: WriterOptions -> Pandoc -> Html -writeHtml opts d = - let (body, context) = evalState (pandocToHtml opts d) defaultWriterState - in case writerTemplate opts of - Nothing -> body - Just tpl -> renderTemplate' tpl $ - defField "body" (renderHtml body) context +-- | Convert Pandoc document to Html 5 string. +writeHtml5String :: PandocMonad m => WriterOptions -> Pandoc -> m Text +writeHtml5String = writeHtmlString' + defaultWriterState{ stHtml5 = True } + +-- | Convert Pandoc document to Html 5 structure. +writeHtml5 :: PandocMonad m => WriterOptions -> Pandoc -> m Html +writeHtml5 = writeHtml' defaultWriterState{ stHtml5 = True } + +-- | Convert Pandoc document to Html 4 string. +writeHtml4String :: PandocMonad m => WriterOptions -> Pandoc -> m Text +writeHtml4String = writeHtmlString' + defaultWriterState{ stHtml5 = False } + +-- | Convert Pandoc document to Html 4 structure. +writeHtml4 :: PandocMonad m => WriterOptions -> Pandoc -> m Html +writeHtml4 = writeHtml' defaultWriterState{ stHtml5 = False } + +-- | Convert Pandoc document to Html appropriate for an epub version. +writeHtmlStringForEPUB :: PandocMonad m + => EPUBVersion -> WriterOptions -> Pandoc + -> m Text +writeHtmlStringForEPUB version o = writeHtmlString' + defaultWriterState{ stHtml5 = version == EPUB3, + stEPUBVersion = Just version } o + +-- | Convert Pandoc document to Reveal JS HTML slide show. +writeRevealJs :: PandocMonad m + => WriterOptions -> Pandoc -> m Text +writeRevealJs = writeHtmlSlideShow' RevealJsSlides + +-- | Convert Pandoc document to S5 HTML slide show. +writeS5 :: PandocMonad m + => WriterOptions -> Pandoc -> m Text +writeS5 = writeHtmlSlideShow' S5Slides + +-- | Convert Pandoc document to Slidy HTML slide show. +writeSlidy :: PandocMonad m + => WriterOptions -> Pandoc -> m Text +writeSlidy = writeHtmlSlideShow' SlidySlides + +-- | Convert Pandoc document to Slideous HTML slide show. +writeSlideous :: PandocMonad m + => WriterOptions -> Pandoc -> m Text +writeSlideous = writeHtmlSlideShow' SlideousSlides + +-- | Convert Pandoc document to DZSlides HTML slide show. +writeDZSlides :: PandocMonad m + => WriterOptions -> Pandoc -> m Text +writeDZSlides = writeHtmlSlideShow' DZSlides + +writeHtmlSlideShow' :: PandocMonad m + => HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text +writeHtmlSlideShow' variant = writeHtmlString' + defaultWriterState{ stSlideVariant = variant + , stHtml5 = case variant of + RevealJsSlides -> True + S5Slides -> False + SlidySlides -> False + DZSlides -> True + SlideousSlides -> False + NoSlides -> False + } + +renderHtml' :: Html -> Text +renderHtml' = TL.toStrict . renderHtml + +writeHtmlString' :: PandocMonad m + => WriterState -> WriterOptions -> Pandoc -> m Text +writeHtmlString' st opts d = do + (body, context) <- evalStateT (pandocToHtml opts d) st + case writerTemplate opts of + Nothing -> return $ renderHtml' body + Just tpl -> do + -- warn if empty lang + when (isNothing (getField "lang" context :: Maybe String)) $ + report NoLangSpecified + -- check for empty pagetitle + context' <- + case getField "pagetitle" context of + Just (s :: String) | not (null s) -> return context + _ -> do + let fallback = fromMaybe "Untitled" $ takeBaseName <$> + lookup "sourcefile" (writerVariables opts) + report $ NoTitleElement fallback + return $ resetField "pagetitle" fallback context + renderTemplate' tpl $ + defField "body" (renderHtml' body) context' + +writeHtml' :: PandocMonad m => WriterState -> WriterOptions -> Pandoc -> m Html +writeHtml' st opts d = + case writerTemplate opts of + Just _ -> preEscapedText <$> writeHtmlString' st opts d + Nothing -> do + (body, _) <- evalStateT (pandocToHtml opts d) st + return body -- result is (title, authors, date, toc, body, new variables) -pandocToHtml :: WriterOptions +pandocToHtml :: PandocMonad m + => WriterOptions -> Pandoc - -> State WriterState (Html, Value) + -> StateT WriterState m (Html, Value) pandocToHtml opts (Pandoc meta blocks) = do metadata <- metaToJSON opts - (fmap renderHtml . blockListToHtml opts) - (fmap renderHtml . inlineListToHtml opts) + (fmap renderHtml' . blockListToHtml opts) + (fmap renderHtml' . inlineListToHtml opts) meta 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 $ - if writerSlideVariant opts == NoSlides + if slideVariant == NoSlides then blocks else prepSlides slideLevel blocks - toc <- if writerTableOfContents opts - then tableOfContents opts sects + toc <- if writerTableOfContents opts && slideVariant /= S5Slides + then fmap renderHtml' <$> tableOfContents opts sects else return Nothing blocks' <- liftM (mconcat . intersperse (nl opts)) $ mapM (elementToHtml slideLevel opts) sects st <- get - let notes = reverse (stNotes st) - let thebody = blocks' >> footnoteSection opts notes + notes <- footnoteSection opts (reverse (stNotes st)) + let thebody = blocks' >> notes let math = case writerHTMLMathMethod opts of LaTeXMathML (Just url) -> H.script ! A.src (toValue url) ! A.type_ "text/javascript" $ mempty - MathML (Just url) -> + MathJax url + | slideVariant /= RevealJsSlides -> + -- mathjax is handled via a special plugin in revealjs H.script ! A.src (toValue url) ! A.type_ "text/javascript" - $ mempty - MathJax url -> - H.script ! A.src (toValue url) - ! A.type_ "text/javascript" - $ case writerSlideVariant opts of + $ case slideVariant of SlideousSlides -> preEscapedString "MathJax.Hub.Queue([\"Typeset\",MathJax.Hub]);" @@ -162,37 +277,55 @@ pandocToHtml opts (Pandoc meta blocks) = do H.script ! A.src (toValue url) ! A.type_ "text/javascript" $ mempty - KaTeX js css -> - (H.script ! A.src (toValue js) $ mempty) <> - (H.link ! A.rel "stylesheet" ! A.href (toValue css)) <> - (H.script ! A.type_ "text/javascript" $ toHtml renderKaTeX) + KaTeX url -> + (H.script ! + A.src (toValue $ url ++ "katex.min.js") $ mempty) <> + (H.script ! + A.src (toValue $ url ++ "contrib/auto-render.min.js") + $ mempty) <> + ( + H.script + "document.addEventListener(\"DOMContentLoaded\", function() {\n renderMathInElement(document.body);\n});") <> + (H.link ! A.rel "stylesheet" ! + A.href (toValue $ url ++ "katex.min.css")) + _ -> case lookup "mathml-script" (writerVariables opts) of - Just s | not (writerHtml5 opts) -> + Just s | not (stHtml5 st) -> H.script ! A.type_ "text/javascript" $ preEscapedString ("/*<![CDATA[*/\n" ++ s ++ "/*]]>*/\n") | otherwise -> mempty Nothing -> mempty let context = (if stHighlighting st - then defField "highlighting-css" - (styleToCss $ writerHighlightStyle opts) + then case writerHighlightStyle opts of + Just sty -> defField "highlighting-css" + (styleToCss sty) + Nothing -> id else id) $ (if stMath st - then defField "math" (renderHtml math) + then defField "math" (renderHtml' math) else id) $ + defField "mathjax" + (case writerHTMLMathMethod opts of + MathJax _ -> True + _ -> False) $ defField "quotes" (stQuotes st) $ - maybe id (defField "toc" . renderHtml) toc $ + -- for backwards compatibility we populate toc + -- with the contents of the toc, rather than a + -- boolean: + maybe id (defField "toc") toc $ + maybe id (defField "table-of-contents") toc $ defField "author-meta" authsMeta $ maybe id (defField "date-meta") (normalizeDate dateMeta) $ - defField "pagetitle" (stringifyHTML $ docTitle meta) $ + defField "pagetitle" (stringifyHTML (docTitle meta)) $ defField "idprefix" (writerIdentifierPrefix opts) $ -- these should maybe be set in pandoc.hs defField "slidy-url" - ("http://www.w3.org/Talks/Tools/Slidy2" :: String) $ + ("https://www.w3.org/Talks/Tools/Slidy2" :: String) $ defField "slideous-url" ("slideous" :: String) $ defField "revealjs-url" ("reveal.js" :: String) $ defField "s5-url" ("s5/default" :: String) $ - defField "html5" (writerHtml5 opts) $ + defField "html5" (stHtml5 st) metadata return (thebody, context) @@ -200,44 +333,52 @@ pandocToHtml opts (Pandoc meta blocks) = do prefixedId :: WriterOptions -> String -> Attribute prefixedId opts s = case s of - "" -> mempty - _ -> A.id $ toValue $ writerIdentifierPrefix opts ++ s + "" -> mempty + _ -> A.id $ toValue $ writerIdentifierPrefix opts ++ s -toList :: (Html -> Html) -> WriterOptions -> ([Html] -> Html) +toList :: PandocMonad m + => (Html -> Html) + -> WriterOptions + -> [Html] + -> StateT WriterState m Html toList listop opts items = do - if (writerIncremental opts) - then if (writerSlideVariant opts /= RevealJsSlides) - then (listop $ mconcat items) ! A.class_ "incremental" - else listop $ mconcat $ map (! A.class_ "fragment") items - else listop $ mconcat items + slideVariant <- gets stSlideVariant + return $ + if writerIncremental opts + then if slideVariant /= RevealJsSlides + then listop (mconcat items) ! A.class_ "incremental" + else listop $ mconcat $ map (! A.class_ "fragment") items + else listop $ mconcat items -unordList :: WriterOptions -> [Html] -> Html +unordList :: PandocMonad m + => WriterOptions -> [Html] -> StateT WriterState m Html unordList opts = toList H.ul opts . toListItems opts -ordList :: WriterOptions -> [Html] -> Html +ordList :: PandocMonad m + => WriterOptions -> [Html] -> StateT WriterState m Html ordList opts = toList H.ol opts . toListItems opts -defList :: WriterOptions -> [Html] -> Html +defList :: PandocMonad m + => WriterOptions -> [Html] -> StateT WriterState m Html defList opts items = toList H.dl opts (items ++ [nl opts]) -- | Construct table of contents from list of elements. -tableOfContents :: WriterOptions -> [Element] -> State WriterState (Maybe Html) +tableOfContents :: PandocMonad m => WriterOptions -> [Element] -> StateT WriterState m (Maybe Html) tableOfContents _ [] = return Nothing tableOfContents opts sects = do - let opts' = opts { writerIgnoreNotes = True } - contents <- mapM (elementToListItem opts') sects + contents <- mapM (elementToListItem opts) sects let tocList = catMaybes contents - return $ if null tocList - then Nothing - else Just $ unordList opts tocList + if null tocList + then return Nothing + else Just <$> unordList opts tocList -- | Convert section number to string showSecNum :: [Int] -> String -showSecNum = concat . intersperse "." . map show +showSecNum = intercalate "." . map show -- | Converts an Element to a list item for a table of contents, -- retrieving the appropriate identifier from state. -elementToListItem :: WriterOptions -> Element -> State WriterState (Maybe Html) +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 @@ -249,45 +390,52 @@ elementToListItem opts (Sec lev num (id',classes,_) headerText subsecs) then (H.span ! A.class_ "toc-section-number" $ toHtml $ showSecNum num') >> preEscapedString " " else mempty - txt <- liftM (sectnum >>) $ inlineListToHtml opts headerText + txt <- liftM (sectnum >>) $ inlineListToHtml opts $ walk deNote headerText subHeads <- mapM (elementToListItem opts) subsecs >>= return . catMaybes - let subList = if null subHeads - then mempty - else unordList opts subHeads + subList <- if null subHeads + then return mempty + else unordList opts subHeads -- in reveal.js, we need #/apples, not #apples: - let revealSlash = ['/' | writerSlideVariant opts == RevealJsSlides] + slideVariant <- gets stSlideVariant + let revealSlash = ['/' | slideVariant== RevealJsSlides] return $ Just $ if null id' - then (H.a $ toHtml txt) >> subList + then H.a (toHtml txt) >> subList else (H.a ! A.href (toValue $ "#" ++ revealSlash ++ writerIdentifierPrefix opts ++ id') $ toHtml txt) >> subList elementToListItem _ _ = return Nothing -- | Convert an Element to Html. -elementToHtml :: Int -> WriterOptions -> Element -> State WriterState Html +elementToHtml :: PandocMonad m => Int -> WriterOptions -> Element -> StateT WriterState m Html elementToHtml _slideLevel opts (Blk block) = blockToHtml opts block elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elements) = do - let slide = writerSlideVariant opts /= NoSlides && level <= slideLevel + slideVariant <- gets stSlideVariant + let slide = slideVariant /= NoSlides && level <= slideLevel 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') + (Header level' (id',classes,keyvals) title') modify (\st -> st{ stElement = False}) return res - let isSec (Sec _ _ _ _ _) = True - isSec (Blk _) = False + let isSec Sec{} = True + isSec (Blk _) = False let isPause (Blk x) = x == Para [Str ".",Space,Str ".",Space,Str "."] isPause _ = False - let fragmentClass = case writerSlideVariant opts of - RevealJsSlides -> "fragment" - _ -> "incremental" + let fragmentClass = case slideVariant of + RevealJsSlides -> "fragment" + _ -> "incremental" let inDiv xs = Blk (RawBlock (Format "html") ("<div class=\"" ++ fragmentClass ++ "\">")) : (xs ++ [Blk (RawBlock (Format "html") "</div>")]) @@ -299,45 +447,51 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen [] -> [] (x:xs) -> x ++ concatMap inDiv xs let inNl x = mconcat $ nl opts : intersperse (nl opts) x ++ [nl opts] - let classes' = ["titleslide" | titleSlide] ++ ["slide" | slide] ++ + let classes' = ["title-slide" | titleSlide] ++ ["slide" | slide] ++ ["section" | (slide || writerSectionDivs opts) && - not (writerHtml5 opts) ] ++ + not html5 ] ++ ["level" ++ show level | slide || writerSectionDivs opts ] ++ classes - let secttag = if writerHtml5 opts + let secttag = if html5 then H5.section else H.div let attr = (id',classes',keyvals) - return $ if titleSlide - then (if writerSlideVariant opts == RevealJsSlides - then H5.section - else id) $ mconcat $ - (addAttrs opts attr $ secttag $ header') : innerContents - else if writerSectionDivs opts || slide - then addAttrs opts attr - $ secttag $ inNl $ header' : innerContents - else mconcat $ intersperse (nl opts) - $ addAttrs opts attr header' : innerContents + if titleSlide + then do + t <- addAttrs opts attr $ + secttag header' + return $ + (if slideVariant == RevealJsSlides + 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) -- | Convert list of Note blocks to a footnote <div>. -- Assumes notes are sorted. -footnoteSection :: WriterOptions -> [Html] -> Html -footnoteSection opts notes = - if null notes - then mempty - else nl opts >> (container - $ nl opts >> hrtag >> nl opts >> - H.ol (mconcat notes >> nl opts) >> nl opts) - where container x = if writerHtml5 opts - then H5.section ! A.class_ "footnotes" $ x - else if writerSlideVariant opts /= NoSlides - then H.div ! A.class_ "footnotes slide" $ x - else H.div ! A.class_ "footnotes" $ x - hrtag = if writerHtml5 opts then H5.hr else H.hr +footnoteSection :: PandocMonad m + => WriterOptions -> [Html] -> StateT WriterState m Html +footnoteSection opts notes = do + html5 <- gets stHtml5 + slideVariant <- gets stSlideVariant + let hrtag = if html5 then H5.hr else H.hr + let container x + | html5 = H5.section ! A.class_ "footnotes" $ x + | slideVariant /= NoSlides = H.div ! A.class_ "footnotes slide" $ x + | otherwise = H.div ! A.class_ "footnotes" $ x + return $ + if null notes + then mempty + else nl opts >> container (nl opts >> hrtag >> nl opts >> + H.ol (mconcat notes >> nl opts) >> nl opts) -- | Parse a mailto link; return Just (name, domain) or Nothing. parseMailto :: String -> Maybe (String, String) -parseMailto s = do +parseMailto s = case break (==':') s of (xs,':':addr) | map toLower xs == "mailto" -> do let (name', rest) = span (/='@') addr @@ -346,10 +500,12 @@ parseMailto s = do _ -> fail "not a mailto: URL" -- | Obfuscate a "mailto:" link. -obfuscateLink :: WriterOptions -> Attr -> Html -> String -> Html +obfuscateLink :: PandocMonad m + => WriterOptions -> Attr -> Html -> String + -> StateT WriterState m Html obfuscateLink opts attr txt s | writerEmailObfuscation opts == NoObfuscation = addAttrs opts attr $ H.a ! A.href (toValue s) $ txt -obfuscateLink opts attr (renderHtml -> txt) s = +obfuscateLink opts attr (TL.unpack . renderHtml -> txt) s = let meth = writerEmailObfuscation opts s' = map toLower (take 7 s) ++ drop 7 s in case parseMailto s' of @@ -361,20 +517,25 @@ obfuscateLink opts attr (renderHtml -> txt) s = then ("e", name' ++ " at " ++ domain') else ("'" ++ obfuscateString txt ++ "'", txt ++ " (" ++ name' ++ " at " ++ domain' ++ ")") + (_, classNames, _) = attr + classNamesStr = concatMap (' ':) classNames in case meth of ReferenceObfuscation -> -- need to use preEscapedString or &'s are escaped to & in URL - preEscapedString $ "<a href=\"" ++ (obfuscateString s') - ++ "\" class=\"email\">" ++ (obfuscateString txt) ++ "</a>" + return $ + preEscapedString $ "<a href=\"" ++ obfuscateString s' + ++ "\" class=\"email\">" ++ obfuscateString txt ++ "</a>" JavascriptObfuscation -> + return $ (H.script ! A.type_ "text/javascript" $ preEscapedString ("\n<!--\nh='" ++ obfuscateString domain ++ "';a='" ++ at' ++ "';n='" ++ obfuscateString name' ++ "';e=n+a+h;\n" ++ - "document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\" clas'+'s=\"em' + 'ail\">'+" ++ + "document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\" clas'+'s=\"em' + 'ail" ++ + classNamesStr ++ "\">'+" ++ linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) >> H.noscript (preEscapedString $ obfuscateString altText) - _ -> error $ "Unknown obfuscation method: " ++ show meth + _ -> throwError $ PandocSomeError $ "Unknown obfuscation method: " ++ show meth _ -> addAttrs opts attr $ H.a ! A.href (toValue s) $ toHtml txt -- malformed email -- | Obfuscate character as entity. @@ -388,36 +549,71 @@ obfuscateChar char = obfuscateString :: String -> String obfuscateString = concatMap obfuscateChar . fromEntities -addAttrs :: WriterOptions -> Attr -> Html -> Html -addAttrs opts attr h = foldl (!) h (attrsToHtml opts attr) +-- | Create HTML tag with attributes. +tagWithAttributes :: WriterOptions + -> Bool -- ^ True for HTML5 + -> Bool -- ^ True if self-closing tag + -> Text -- ^ Tag text + -> Attr -- ^ Pandoc style tag attributes + -> Text +tagWithAttributes opts html5 selfClosing tagname attr = + let mktag = (TL.toStrict . renderHtml <$> evalStateT + (addAttrs opts attr (customLeaf (textTag tagname) selfClosing)) + defaultWriterState{ stHtml5 = html5 }) + in case runPure mktag of + Left _ -> mempty + Right t -> t -toAttrs :: [(String, String)] -> [Attribute] -toAttrs kvs = map (\(x,y) -> customAttribute (fromString x) (toValue y)) kvs +addAttrs :: PandocMonad m + => WriterOptions -> Attr -> Html -> StateT WriterState m Html +addAttrs opts attr h = foldl (!) h <$> attrsToHtml opts attr -attrsToHtml :: WriterOptions -> Attr -> [Attribute] -attrsToHtml opts (id',classes',keyvals) = - [prefixedId opts id' | not (null id')] ++ - [A.class_ (toValue $ unwords classes') | not (null classes')] ++ toAttrs keyvals +toAttrs :: PandocMonad m + => [(String, String)] -> StateT WriterState m [Attribute] +toAttrs kvs = do + html5 <- gets stHtml5 + return $ map (\(x,y) -> + customAttribute + (fromString (if not html5 || x `Set.member` html5Attributes + || "data-" `isPrefixOf` x + then x + else "data-" ++ x)) (toValue y)) kvs -imgAttrsToHtml :: WriterOptions -> Attr -> [Attribute] -imgAttrsToHtml opts attr = - attrsToHtml opts (ident,cls,kvs') ++ - toAttrs (dimensionsToAttrList opts attr) +attrsToHtml :: PandocMonad m + => WriterOptions -> Attr -> StateT WriterState m [Attribute] +attrsToHtml opts (id',classes',keyvals) = do + attrs <- toAttrs keyvals + return $ + [prefixedId opts id' | not (null id')] ++ + [A.class_ (toValue $ unwords classes') | not (null classes')] ++ attrs + +imgAttrsToHtml :: PandocMonad m + => WriterOptions -> Attr -> StateT WriterState m [Attribute] +imgAttrsToHtml opts attr = do + attrs <- attrsToHtml opts (ident,cls,kvs') + dimattrs <- toAttrs (dimensionsToAttrList attr) + return $ attrs ++ dimattrs where (ident,cls,kvs) = attr kvs' = filter isNotDim kvs isNotDim ("width", _) = False isNotDim ("height", _) = False - isNotDim _ = True + isNotDim _ = True -dimensionsToAttrList :: WriterOptions -> Attr -> [(String, String)] -dimensionsToAttrList opts attr = (go Width) ++ (go Height) +dimensionsToAttrList :: Attr -> [(String, String)] +dimensionsToAttrList attr = consolidateStyles $ go Width ++ go Height where - go dir = case (dimension dir attr) of - (Just (Percent a)) -> [("style", show dir ++ ":" ++ show (Percent a))] - (Just dim) -> [(show dir, showInPixel opts dim)] - _ -> [] - + consolidateStyles :: [(String, String)] -> [(String, String)] + consolidateStyles xs = + case partition isStyle xs of + ([], _) -> xs + (ss, rest) -> ("style", intercalate ";" $ map snd ss) : rest + isStyle ("style", _) = True + isStyle _ = False + go dir = case dimension dir attr of + (Just (Pixel a)) -> [(show dir, show a)] + (Just x) -> [("style", show dir ++ ":" ++ show x)] + Nothing -> [] imageExts :: [String] imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf", @@ -427,71 +623,121 @@ imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf", treatAsImage :: FilePath -> Bool treatAsImage fp = - let path = case uriPath `fmap` parseURIReference fp of - Nothing -> fp - Just up -> up + let path = maybe fp uriPath (parseURIReference fp) ext = map toLower $ drop 1 $ takeExtension path in null ext || ext `elem` imageExts --- | Convert Pandoc block element to HTML. -blockToHtml :: WriterOptions -> Block -> State WriterState Html -blockToHtml _ Null = return mempty -blockToHtml opts (Plain lst) = inlineListToHtml opts lst --- title beginning with fig: indicates that the image is a figure -blockToHtml opts (Para [Image attr txt (s,'f':'i':'g':':':tit)]) = do +figure :: PandocMonad m + => WriterOptions -> Attr -> [Inline] -> (String, String) + -> StateT WriterState m Html +figure opts attr txt (s,tit) = do img <- inlineToHtml opts (Image attr txt (s,tit)) - let tocapt = if writerHtml5 opts + html5 <- gets stHtml5 + let tocapt = if html5 then H5.figcaption else H.p ! A.class_ "caption" capt <- if null txt then return mempty else tocapt `fmap` inlineListToHtml opts txt - return $ if writerHtml5 opts + return $ if html5 then H5.figure $ mconcat [nl opts, img, capt, nl opts] else H.div ! A.class_ "figure" $ mconcat [nl opts, img, nl opts, capt, nl opts] + +-- | 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)]) + | "stretch" `elem` classes = do + slideVariant <- gets stSlideVariant + case slideVariant of + RevealJsSlides -> + -- a "stretched" image in reveal.js must be a direct child + -- of the slide container + 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,'f':'i':'g':':':tit)]) = + figure opts attr txt (s,tit) blockToHtml opts (Para lst) | isEmptyRaw lst = return mempty + | null lst && not (isEnabled Ext_empty_paragraphs opts) = return mempty | otherwise = do contents <- inlineListToHtml opts lst return $ H.p contents where - isEmptyRaw [RawInline f _] = f /= (Format "html") - isEmptyRaw _ = False + isEmptyRaw [RawInline f _] = f `notElem` [Format "html", + Format "html4", Format "html5"] + isEmptyRaw _ = False blockToHtml opts (LineBlock lns) = if writerWrapText opts == WrapNone then blockToHtml opts $ linesToPara lns else do - let lf = preEscapedString "\n" - htmlLines <- mconcat . intersperse lf <$> mapM (inlineListToHtml opts) lns - return $ H.div ! A.style "white-space: pre-line;" $ htmlLines -blockToHtml opts (Div attr@(ident, classes, kvs) bs) = do + htmlLines <- inlineListToHtml opts $ intercalate [LineBreak] lns + return $ H.div ! A.class_ "line-block" $ htmlLines +blockToHtml opts (Div attr@(ident, classes, kvs') bs) = do + html5 <- gets stHtml5 + slideVariant <- gets stSlideVariant + let kvs = [(k,v) | (k,v) <- kvs', k /= "width"] ++ + [("style", "width:" ++ w ++ ";") + | ("width",w) <- kvs', "column" `elem` classes] let speakerNotes = "notes" `elem` classes -- we don't want incremental output inside speaker notes, see #1394 - let opts' = if speakerNotes then opts{ writerIncremental = False } else opts - contents <- blockListToHtml opts' bs + let opts' = if | speakerNotes -> opts{ writerIncremental = False } + | "incremental" `elem` classes -> opts{ writerIncremental = True } + | "nonincremental" `elem` classes -> opts{ writerIncremental = False } + | otherwise -> opts + -- we remove "incremental" and "nonincremental" if we're in a + -- slide presentaiton format. + classes' = case slideVariant of + NoSlides -> classes + _ -> filter (\k -> k /= "incremental" && k /= "nonincremental") classes + contents <- if "columns" `elem` classes' + then -- we don't use blockListToHtml because it inserts + -- a newline between the column divs, which throws + -- off widths! see #4028 + mconcat <$> mapM (blockToHtml opts) bs + else blockListToHtml opts' bs let contents' = nl opts >> contents >> nl opts - let (divtag, classes') = if writerHtml5 opts && "section" `elem` classes - then (H5.section, filter (/= "section") classes) - else (H.div, classes) - return $ - if speakerNotes - then case writerSlideVariant opts of - RevealJsSlides -> addAttrs opts' attr $ H5.aside $ contents' - DZSlides -> (addAttrs opts' attr $ H5.div $ contents') - ! (H5.customAttribute "role" "note") - NoSlides -> addAttrs opts' attr $ H.div $ contents' - _ -> mempty - else addAttrs opts (ident, classes', kvs) $ divtag $ contents' -blockToHtml opts (RawBlock f str) - | f == Format "html" = return $ preEscapedString str - | (f == Format "latex" || f == Format "tex") && - allowsMathEnvironments (writerHTMLMathMethod opts) && - isMathEnvironment str = blockToHtml opts $ Plain [Math DisplayMath str] - | otherwise = return mempty -blockToHtml opts (HorizontalRule) = return $ if writerHtml5 opts then H5.hr else H.hr + let (divtag, classes'') = if html5 && "section" `elem` classes' + then (H5.section, filter (/= "section") classes') + else (H.div, classes') + if speakerNotes + then case slideVariant of + RevealJsSlides -> addAttrs opts' attr $ + H5.aside contents' + DZSlides -> do + t <- addAttrs opts' attr $ + H5.div contents' + return $ t ! H5.customAttribute "role" "note" + NoSlides -> addAttrs opts' attr $ + H.div contents' + _ -> return mempty + else addAttrs opts (ident, classes'', kvs) $ + divtag contents' +blockToHtml opts (RawBlock f str) = do + ishtml <- isRawHtml f + if ishtml + then return $ preEscapedString str + else if (f == Format "latex" || f == Format "tex") && + allowsMathEnvironments (writerHTMLMathMethod opts) && + isMathEnvironment str + then blockToHtml opts $ Plain [Math DisplayMath str] + else do + report $ BlockNotRendered (RawBlock f str) + return mempty +blockToHtml _ HorizontalRule = do + html5 <- gets stHtml5 + return $ if html5 then H5.hr else H.hr blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do + id'' <- if null id' + then do + modify $ \st -> st{ stCodeBlockNum = stCodeBlockNum st + 1 } + codeblocknum <- gets stCodeBlockNum + return ("cb" ++ show codeblocknum) + else return id' let tolhs = isEnabled Ext_literate_haskell opts && any (\c -> map toLower c == "haskell") classes && any (\c -> map toLower c == "literate") classes @@ -503,19 +749,24 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do adjCode = if tolhs then unlines . map ("> " ++) . lines $ rawCode else rawCode - hlCode = if writerHighlight opts -- check highlighting options - then highlight formatHtmlBlock (id',classes',keyvals) adjCode - else Nothing + hlCode = if isJust (writerHighlightStyle opts) + then highlight (writerSyntaxMap opts) formatHtmlBlock + (id'',classes',keyvals) adjCode + else Left "" case hlCode of - Nothing -> return $ addAttrs opts (id',classes,keyvals) - $ H.pre $ H.code $ toHtml adjCode - Just h -> modify (\st -> st{ stHighlighting = True }) >> - return (addAttrs opts (id',[],keyvals) h) -blockToHtml opts (BlockQuote blocks) = + Left msg -> do + unless (null msg) $ + report $ CouldNotHighlight msg + addAttrs opts (id',classes,keyvals) + $ H.pre $ H.code $ toHtml adjCode + Right h -> modify (\st -> st{ stHighlighting = True }) >> + addAttrs opts (id'',[],keyvals) h +blockToHtml opts (BlockQuote blocks) = do -- in S5, treat list in blockquote specially -- if default is incremental, make it nonincremental; -- otherwise incremental - if writerSlideVariant opts /= NoSlides + slideVariant <- gets stSlideVariant + if slideVariant /= NoSlides then let inc = not (writerIncremental opts) in case blocks of [BulletList lst] -> blockToHtml (opts {writerIncremental = inc}) @@ -541,7 +792,7 @@ blockToHtml opts (Header level attr@(_,classes,_) lst) = do $ showSecNum secnum) >> strToHtml " " >> contents else contents inElement <- gets stElement - return $ (if inElement then id else addAttrs opts attr) + (if inElement then return else addAttrs opts attr) $ case level of 1 -> H.h1 contents' 2 -> H.h2 contents' @@ -552,20 +803,17 @@ blockToHtml opts (Header level attr@(_,classes,_) lst) = do _ -> H.p contents' blockToHtml opts (BulletList lst) = do contents <- mapM (blockListToHtml opts) lst - return $ unordList opts contents + unordList opts contents blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do contents <- mapM (blockListToHtml opts) lst + html5 <- gets stHtml5 let numstyle' = case numstyle of Example -> "decimal" _ -> camelCaseToHyphenated $ show numstyle - let attribs = (if startnum /= 1 - then [A.start $ toValue startnum] - else []) ++ - (if numstyle == Example - then [A.class_ "example"] - else []) ++ + let attribs = [A.start $ toValue startnum | startnum /= 1] ++ + [A.class_ "example" | numstyle == Example] ++ (if numstyle /= DefaultStyle - then if writerHtml5 opts + then if html5 then [A.type_ $ case numstyle of Decimal -> "1" @@ -577,23 +825,25 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do else [A.style $ toValue $ "list-style-type: " ++ numstyle'] else []) - return $ foldl (!) (ordList opts contents) attribs + l <- ordList opts contents + return $ foldl (!) l attribs blockToHtml opts (DefinitionList lst) = do contents <- mapM (\(term, defs) -> do term' <- if null term then return mempty else liftM H.dt $ inlineListToHtml opts term - defs' <- mapM ((liftM (\x -> H.dd $ (x >> nl opts))) . + defs' <- mapM (liftM (\x -> H.dd (x >> nl opts)) . blockListToHtml opts) defs return $ mconcat $ nl opts : term' : nl opts : intersperse (nl opts) defs') lst - return $ defList opts contents + defList opts contents blockToHtml opts (Table capt aligns widths headers rows') = do captionDoc <- if null capt then return mempty else do cs <- inlineListToHtml opts capt return $ H.caption cs >> nl opts + html5 <- gets stHtml5 let percent w = show (truncate (100*w) :: Integer) ++ "%" let coltags = if all (== 0.0) widths then mempty @@ -601,7 +851,7 @@ blockToHtml opts (Table capt aligns widths headers rows') = do H.colgroup $ do nl opts mapM_ (\w -> do - if writerHtml5 opts + if html5 then H.col ! A.style (toValue $ "width: " ++ percent w) else H.col ! A.width (toValue $ percent w) @@ -624,18 +874,19 @@ blockToHtml opts (Table capt aligns widths headers rows') = do else tbl ! A.style (toValue $ "width:" ++ show (round (totalWidth * 100) :: Int) ++ "%;") -tableRowToHtml :: WriterOptions +tableRowToHtml :: PandocMonad m + => WriterOptions -> [Alignment] -> Int -> [[Block]] - -> State WriterState Html + -> StateT WriterState m Html tableRowToHtml opts aligns rownum cols' = do let mkcell = if rownum == 0 then H.th else H.td let rowclass = case rownum of - 0 -> "header" + 0 -> "header" x | x `rem` 2 == 1 -> "odd" - _ -> "even" - cols'' <- sequence $ zipWith + _ -> "even" + cols'' <- zipWithM (\alignment item -> tableItemToHtml opts mkcell alignment item) aligns cols' return $ (H.tr ! A.class_ rowclass $ nl opts >> mconcat cols'') @@ -648,21 +899,23 @@ alignmentToString alignment = case alignment of AlignCenter -> "center" AlignDefault -> "" -tableItemToHtml :: WriterOptions +tableItemToHtml :: PandocMonad m + => WriterOptions -> (Html -> Html) -> Alignment -> [Block] - -> State WriterState Html + -> StateT WriterState m Html tableItemToHtml opts tag' align' item = do contents <- blockListToHtml opts item + html5 <- gets stHtml5 let alignStr = alignmentToString align' - let attribs = if writerHtml5 opts + let attribs = if html5 then A.style (toValue $ "text-align: " ++ alignStr ++ ";") else A.align (toValue alignStr) let tag'' = if null alignStr then tag' else tag' ! attribs - return $ (tag'' $ contents) >> nl opts + return $ tag'' contents >> nl opts toListItems :: WriterOptions -> [Html] -> [Html] toListItems opts items = map (toListItem opts) items ++ [nl opts] @@ -670,12 +923,16 @@ toListItems opts items = map (toListItem opts) items ++ [nl opts] toListItem :: WriterOptions -> Html -> Html toListItem opts item = nl opts >> H.li item -blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html +blockListToHtml :: PandocMonad m + => WriterOptions -> [Block] -> StateT WriterState m Html blockListToHtml opts lst = - fmap (mconcat . intersperse (nl opts)) $ mapM (blockToHtml opts) lst + (mconcat . intersperse (nl opts) . filter nonempty) + <$> mapM (blockToHtml opts) lst + where nonempty (Empty _) = False + nonempty _ = True -- | Convert list of Pandoc inline elements to HTML. -inlineListToHtml :: WriterOptions -> [Inline] -> State WriterState Html +inlineListToHtml :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m Html inlineListToHtml opts lst = mapM (inlineToHtml opts) lst >>= return . mconcat @@ -684,9 +941,9 @@ annotateMML :: XML.Element -> String -> XML.Element annotateMML e tex = math (unode "semantics" [cs, unode "annotation" (annotAttrs, tex)]) where cs = case elChildren e of - [] -> unode "mrow" () + [] -> unode "mrow" () [x] -> x - xs -> unode "mrow" xs + xs -> unode "mrow" xs math childs = XML.Element q as [XML.Elem childs] l where (XML.Element q as _ l) = e @@ -694,27 +951,29 @@ annotateMML e tex = math (unode "semantics" [cs, unode "annotation" (annotAttrs, -- | Convert Pandoc inline element to HTML. -inlineToHtml :: WriterOptions -> Inline -> State WriterState Html -inlineToHtml opts inline = +inlineToHtml :: PandocMonad m + => WriterOptions -> Inline -> StateT WriterState m Html +inlineToHtml opts inline = do + html5 <- gets stHtml5 case inline of (Str str) -> return $ strToHtml str - (Space) -> return $ strToHtml " " - (SoftBreak) -> return $ case writerWrapText opts of - WrapNone -> preEscapedString " " - WrapAuto -> preEscapedString " " - WrapPreserve -> preEscapedString "\n" - (LineBreak) -> return $ (if writerHtml5 opts then H5.br else H.br) + Space -> return $ strToHtml " " + SoftBreak -> return $ case writerWrapText opts of + WrapNone -> preEscapedString " " + WrapAuto -> preEscapedString " " + WrapPreserve -> preEscapedString "\n" + LineBreak -> return $ (if html5 then H5.br else H.br) <> strToHtml "\n" (Span (id',classes,kvs) ils) -> inlineListToHtml opts ils >>= - return . addAttrs opts attr' . H.span + addAttrs opts attr' . H.span where attr' = (id',classes',kvs') classes' = filter (`notElem` ["csl-no-emph", "csl-no-strong", "csl-no-smallcaps"]) classes kvs' = if null styles then kvs - else (("style", concat styles) : kvs) + else ("style", concat styles) : kvs styles = ["font-style:normal;" | "csl-no-emph" `elem` classes] ++ ["font-weight:normal;" @@ -724,20 +983,23 @@ inlineToHtml opts inline = (Emph lst) -> inlineListToHtml opts lst >>= return . H.em (Strong lst) -> inlineListToHtml opts lst >>= return . H.strong (Code attr str) -> case hlCode of - Nothing -> return - $ addAttrs opts attr - $ H.code $ strToHtml str - Just h -> do + Left msg -> do + unless (null msg) $ + report $ CouldNotHighlight msg + addAttrs opts attr $ H.code $ strToHtml str + Right h -> do modify $ \st -> st{ stHighlighting = True } - return $ addAttrs opts (id',[],keyvals) h + addAttrs opts (id',[],keyvals) h where (id',_,keyvals) = attr - hlCode = if writerHighlight opts - then highlight formatHtmlInline attr str - else Nothing + hlCode = if isJust (writerHighlightStyle opts) + then highlight + (writerSyntaxMap opts) + formatHtmlInline attr str + else Left "" (Strikeout lst) -> inlineListToHtml opts lst >>= return . H.del (SmallCaps lst) -> inlineListToHtml opts lst >>= - return . (H.span ! A.style "font-variant: small-caps;") + return . (H.span ! A.class_ "smallcaps") (Superscript lst) -> inlineListToHtml opts lst >>= return . H.sup (Subscript lst) -> inlineListToHtml opts lst >>= return . H.sub (Quoted quoteType lst) -> @@ -768,15 +1030,15 @@ inlineToHtml opts inline = JsMath _ -> do let m = preEscapedString str return $ case t of - InlineMath -> H.span ! A.class_ mathClass $ m + InlineMath -> H.span ! A.class_ mathClass $ m DisplayMath -> H.div ! A.class_ mathClass $ m WebTeX url -> do - let imtag = if writerHtml5 opts then H5.img else H.img + let imtag = if html5 then H5.img else H.img let m = imtag ! A.style "vertical-align:middle" ! A.src (toValue $ url ++ urlEncode str) ! A.alt (toValue str) ! A.title (toValue str) - let brtag = if writerHtml5 opts then H5.br else H.br + let brtag = if html5 then H5.br else H.br return $ case t of InlineMath -> m DisplayMath -> brtag >> m >> brtag @@ -784,103 +1046,124 @@ inlineToHtml opts inline = return $ case t of InlineMath -> preEscapedString $ "<EQ ENV=\"math\">" ++ str ++ "</EQ>" DisplayMath -> preEscapedString $ "<EQ ENV=\"displaymath\">" ++ str ++ "</EQ>" - MathML _ -> do - let dt = if t == InlineMath - then DisplayInline - else DisplayBlock + MathML -> do let conf = useShortEmptyTags (const False) defaultConfigPP - case writeMathML dt <$> readTeX str of + res <- lift $ convertMath writeMathML t str + case res of Right r -> return $ preEscapedString $ ppcElement conf (annotateMML r str) - Left _ -> inlineListToHtml opts - (texMathToInlines t str) >>= - return . (H.span ! A.class_ mathClass) + Left il -> (H.span ! A.class_ mathClass) <$> + inlineToHtml opts il MathJax _ -> return $ H.span ! A.class_ mathClass $ toHtml $ case t of InlineMath -> "\\(" ++ str ++ "\\)" DisplayMath -> "\\[" ++ str ++ "\\]" - KaTeX _ _ -> return $ H.span ! A.class_ mathClass $ - toHtml (case t of - InlineMath -> str - DisplayMath -> "\\displaystyle " ++ str) + KaTeX _ -> return $ H.span ! A.class_ mathClass $ toHtml $ + case t of + InlineMath -> "\\(" ++ str ++ "\\)" + DisplayMath -> "\\[" ++ str ++ "\\]" PlainMath -> do - x <- inlineListToHtml opts (texMathToInlines t str) + x <- lift (texMathToInlines t str) >>= inlineListToHtml opts let m = H.span ! A.class_ mathClass $ x - let brtag = if writerHtml5 opts then H5.br else H.br + let brtag = if html5 then H5.br else H.br return $ case t of InlineMath -> m DisplayMath -> brtag >> m >> brtag - (RawInline f str) - | f == Format "html" -> return $ preEscapedString str - | otherwise -> return mempty + (RawInline f str) -> do + ishtml <- isRawHtml f + if ishtml + then return $ preEscapedString str + else if (f == Format "latex" || f == Format "tex") && + "\\begin" `isPrefixOf` str && + allowsMathEnvironments (writerHTMLMathMethod opts) && + isMathEnvironment str + then inlineToHtml opts $ Math DisplayMath str + else do + report $ InlineNotRendered inline + return mempty (Link attr txt (s,_)) | "mailto:" `isPrefixOf` s -> do linkText <- inlineListToHtml opts txt - return $ obfuscateLink opts attr linkText s - (Link attr txt (s,tit)) -> do + obfuscateLink opts attr linkText s + (Link (ident,classes,kvs) txt (s,tit)) -> do linkText <- inlineListToHtml opts txt + slideVariant <- gets stSlideVariant let s' = case s of - '#':xs | writerSlideVariant opts == - RevealJsSlides -> '#':'/':xs - _ -> s + '#':xs -> let prefix = if slideVariant == RevealJsSlides + then "/" + else writerIdentifierPrefix opts + in '#' : prefix ++ xs + _ -> s let link = H.a ! A.href (toValue s') $ linkText - let link' = if txt == [Str (unEscapeString s)] - then link ! A.class_ "uri" - else link - let link'' = addAttrs opts attr link' + let attr = if txt == [Str (unEscapeString s)] + then (ident, "uri" : classes, kvs) + else (ident, classes, kvs) + link' <- addAttrs opts attr link return $ if null tit - then link'' - else link'' ! A.title (toValue tit) + then link' + else link' ! A.title (toValue tit) (Image attr txt (s,tit)) | treatAsImage s -> do let alternate' = stringify txt - let attributes = [A.src $ toValue s] ++ - [A.title $ toValue tit | not (null tit)] ++ - [A.alt $ toValue alternate' | not (null txt)] ++ - imgAttrsToHtml opts attr - let tag = if writerHtml5 opts then H5.img else H.img + slideVariant <- gets stSlideVariant + let isReveal = slideVariant == RevealJsSlides + attrs <- imgAttrsToHtml opts attr + let attributes = + -- reveal.js uses data-src for lazy loading + (if isReveal + then customAttribute "data-src" $ toValue s + else A.src $ toValue s) : + [A.title $ toValue tit | not (null tit)] ++ + [A.alt $ toValue alternate' | not (null txt)] ++ + attrs + let tag = if html5 then H5.img else H.img return $ foldl (!) tag attributes -- note: null title included, as in Markdown.pl (Image attr _ (s,tit)) -> do - let attributes = [A.src $ toValue s] ++ - [A.title $ toValue tit | not (null tit)] ++ - imgAttrsToHtml opts attr + slideVariant <- gets stSlideVariant + let isReveal = slideVariant == RevealJsSlides + attrs <- imgAttrsToHtml opts attr + let attributes = + (if isReveal + then customAttribute "data-src" $ toValue s + else A.src $ toValue s) : + [A.title $ toValue tit | not (null tit)] ++ + attrs return $ foldl (!) H5.embed attributes -- note: null title included, as in Markdown.pl - (Note contents) - | writerIgnoreNotes opts -> return mempty - | otherwise -> do + (Note contents) -> do notes <- gets stNotes - let number = (length notes) + 1 + let number = length notes + 1 let ref = show number htmlContents <- blockListToNote opts ref contents + epubVersion <- gets stEPUBVersion -- push contents onto front of notes - modify $ \st -> st {stNotes = (htmlContents:notes)} - let revealSlash = ['/' | writerSlideVariant opts - == RevealJsSlides] + modify $ \st -> st {stNotes = htmlContents:notes} + slideVariant <- gets stSlideVariant + let revealSlash = ['/' | slideVariant == RevealJsSlides] let link = H.a ! A.href (toValue $ "#" ++ revealSlash ++ writerIdentifierPrefix opts ++ "fn" ++ ref) - ! A.class_ "footnoteRef" + ! A.class_ "footnote-ref" ! prefixedId opts ("fnref" ++ ref) - $ (if isJust (writerEpubVersion opts) + $ (if isJust epubVersion then id else H.sup) $ toHtml ref - return $ case writerEpubVersion opts of + return $ case epubVersion of Just EPUB3 -> link ! customAttribute "epub:type" "noteref" _ -> link (Cite cits il)-> do contents <- inlineListToHtml opts il let citationIds = unwords $ map citationId cits let result = H.span ! A.class_ "citation" $ contents - return $ if writerHtml5 opts + return $ if html5 then result ! customAttribute "data-cites" (toValue citationIds) else result -blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html +blockListToNote :: PandocMonad m => WriterOptions -> String -> [Block] -> StateT WriterState m Html blockListToNote opts ref blocks = -- If last block is Para or Plain, include the backlink at the end of -- that block. Otherwise, insert a new Plain block with the backlink. - let backlink = [Link nullAttr [Str "↩"] ("#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref,[])] + let backlink = [Link ("",["footnote-back"],[]) [Str "↩"] ("#" ++ "fnref" ++ ref,[])] blocks' = if null blocks then [] else let lastBlock = last blocks @@ -893,23 +1176,13 @@ blockListToNote opts ref blocks = _ -> otherBlocks ++ [lastBlock, Plain backlink] in do contents <- blockListToHtml opts blocks' - let noteItem = H.li ! (prefixedId opts ("fn" ++ ref)) $ contents - let noteItem' = case writerEpubVersion opts of + let noteItem = H.li ! prefixedId opts ("fn" ++ ref) $ contents + epubVersion <- gets stEPUBVersion + let noteItem' = case epubVersion of Just EPUB3 -> noteItem ! customAttribute "epub:type" "footnote" _ -> noteItem return $ nl opts >> noteItem' --- Javascript snippet to render all KaTeX elements -renderKaTeX :: String -renderKaTeX = unlines [ - "window.onload = function(){var mathElements = document.getElementsByClassName(\"math\");" - , "for (var i=0; i < mathElements.length; i++)" - , "{" - , " var texText = mathElements[i].firstChild" - , " katex.render(texText.data, mathElements[i])" - , "}}" - ] - isMathEnvironment :: String -> Bool isMathEnvironment s = "\\begin{" `isPrefixOf` s && envName `elem` mathmlenvs @@ -944,6 +1217,219 @@ isMathEnvironment s = "\\begin{" `isPrefixOf` s && allowsMathEnvironments :: HTMLMathMethod -> Bool allowsMathEnvironments (MathJax _) = True -allowsMathEnvironments (MathML _) = True +allowsMathEnvironments MathML = True allowsMathEnvironments (WebTeX _) = True allowsMathEnvironments _ = False + +isRawHtml :: PandocMonad m => Format -> StateT WriterState m Bool +isRawHtml f = do + html5 <- gets stHtml5 + return $ f == Format "html" || + ((html5 && f == Format "html5") || f == Format "html4") + +html5Attributes :: Set.Set String +html5Attributes = Set.fromList + [ "abbr" + , "accept" + , "accept-charset" + , "accesskey" + , "action" + , "allowfullscreen" + , "allowpaymentrequest" + , "allowusermedia" + , "alt" + , "as" + , "async" + , "autocomplete" + , "autofocus" + , "autoplay" + , "charset" + , "checked" + , "cite" + , "class" + , "color" + , "cols" + , "colspan" + , "content" + , "contenteditable" + , "controls" + , "coords" + , "crossorigin" + , "data" + , "datetime" + , "default" + , "defer" + , "dir" + , "dirname" + , "disabled" + , "download" + , "draggable" + , "enctype" + , "for" + , "form" + , "formaction" + , "formenctype" + , "formmethod" + , "formnovalidate" + , "formtarget" + , "headers" + , "height" + , "hidden" + , "high" + , "href" + , "hreflang" + , "http-equiv" + , "id" + , "inputmode" + , "integrity" + , "is" + , "ismap" + , "itemid" + , "itemprop" + , "itemref" + , "itemscope" + , "itemtype" + , "kind" + , "label" + , "lang" + , "list" + , "loop" + , "low" + , "manifest" + , "max" + , "maxlength" + , "media" + , "method" + , "min" + , "minlength" + , "multiple" + , "muted" + , "name" + , "nomodule" + , "nonce" + , "novalidate" + , "onabort" + , "onafterprint" + , "onauxclick" + , "onbeforeprint" + , "onbeforeunload" + , "onblur" + , "oncancel" + , "oncanplay" + , "oncanplaythrough" + , "onchange" + , "onclick" + , "onclose" + , "oncontextmenu" + , "oncopy" + , "oncuechange" + , "oncut" + , "ondblclick" + , "ondrag" + , "ondragend" + , "ondragenter" + , "ondragexit" + , "ondragleave" + , "ondragover" + , "ondragstart" + , "ondrop" + , "ondurationchange" + , "onemptied" + , "onended" + , "onerror" + , "onfocus" + , "onhashchange" + , "oninput" + , "oninvalid" + , "onkeydown" + , "onkeypress" + , "onkeyup" + , "onlanguagechange" + , "onload" + , "onloadeddata" + , "onloadedmetadata" + , "onloadend" + , "onloadstart" + , "onmessage" + , "onmessageerror" + , "onmousedown" + , "onmouseenter" + , "onmouseleave" + , "onmousemove" + , "onmouseout" + , "onmouseover" + , "onmouseup" + , "onoffline" + , "ononline" + , "onpagehide" + , "onpageshow" + , "onpaste" + , "onpause" + , "onplay" + , "onplaying" + , "onpopstate" + , "onprogress" + , "onratechange" + , "onrejectionhandled" + , "onreset" + , "onresize" + , "onscroll" + , "onsecuritypolicyviolation" + , "onseeked" + , "onseeking" + , "onselect" + , "onstalled" + , "onstorage" + , "onsubmit" + , "onsuspend" + , "ontimeupdate" + , "ontoggle" + , "onunhandledrejection" + , "onunload" + , "onvolumechange" + , "onwaiting" + , "onwheel" + , "open" + , "optimum" + , "pattern" + , "ping" + , "placeholder" + , "playsinline" + , "poster" + , "preload" + , "readonly" + , "referrerpolicy" + , "rel" + , "required" + , "reversed" + , "rows" + , "rowspan" + , "sandbox" + , "scope" + , "selected" + , "shape" + , "size" + , "sizes" + , "slot" + , "span" + , "spellcheck" + , "src" + , "srcdoc" + , "srclang" + , "srcset" + , "start" + , "step" + , "style" + , "tabindex" + , "target" + , "title" + , "translate" + , "type" + , "typemustmatch" + , "updateviacache" + , "usemap" + , "value" + , "width" + , "workertype" + , "wrap" + ] |