@@ -50,6 +50,7 @@ import qualified Data.Text.Lazy as TL
5050import Data.List (intersperse, isPrefixOf)
5151import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
5252import Data.Monoid ((<>))
53+import qualified Data.Set as Set
5354import Data.String (fromString)
5455import Network.HTTP (urlEncode)
5556import Network.URI (URI (..), parseURIReference, unEscapeString)
@@ -434,16 +435,19 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen
434435 then H5.section
435436 else H.div
436437 let attr = (id',classes',keyvals)
437− return $ if titleSlide
438− then (if slideVariant == RevealJsSlides
439− then H5.section
440− else id) $ mconcat $
441− (addAttrs opts attr $ secttag $ header') : innerContents
442− else if writerSectionDivs opts || slide
443− then addAttrs opts attr
444− $ secttag $ inNl $ header' : innerContents
445− else mconcat $ intersperse (nl opts)
446− $ addAttrs opts attr header' : innerContents
438+ if titleSlide
439+ then do
440+ t <- addAttrs opts attr $ secttag $ header'
441+ return $
442+ (if slideVariant == RevealJsSlides
443+ then H5.section
444+ else id) $ mconcat $ t : innerContents
445+ else if writerSectionDivs opts || slide
446+ then addAttrs opts attr
447+ $ secttag $ inNl $ header' : innerContents
448+ else do
449+ t <- addAttrs opts attr header'
450+ return $ mconcat $ intersperse (nl opts) (t : innerContents)
447451
448452-- | Convert list of Note blocks to a footnote <div>.
449453-- Assumes notes are sorted.
@@ -476,9 +480,11 @@ parseMailto s = do
476480 _ -> fail "not a mailto: URL"
477481
478482-- | Obfuscate a "mailto:" link.
479−obfuscateLink :: PandocMonad m => WriterOptions -> Attr -> Html -> String -> m Html
483+obfuscateLink :: PandocMonad m
484+ => WriterOptions -> Attr -> Html -> String
485+ -> StateT WriterState m Html
480486obfuscateLink opts attr txt s | writerEmailObfuscation opts == NoObfuscation =
481− return $ addAttrs opts attr $ H.a ! A.href (toValue s) $ txt
487+ addAttrs opts attr $ H.a ! A.href (toValue s) $ txt
482488obfuscateLink opts attr (TL.unpack . renderHtml -> txt) s =
483489 let meth = writerEmailObfuscation opts
484490 s' = map toLower (take 7 s) ++ drop 7 s
@@ -510,7 +516,7 @@ obfuscateLink opts attr (TL.unpack . renderHtml -> txt) s =
510516 linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) >>
511517 H.noscript (preEscapedString $ obfuscateString altText)
512518 _ -> throwError $ PandocSomeError $ "Unknown obfuscation method: " ++ show meth
513− _ -> return $ addAttrs opts attr $ H.a ! A.href (toValue s) $ toHtml txt -- malformed email
519+ _ -> addAttrs opts attr $ H.a ! A.href (toValue s) $ toHtml txt -- malformed email
514520
515521-- | Obfuscate character as entity.
516522obfuscateChar :: Char -> String
@@ -523,21 +529,34 @@ obfuscateChar char =
523529obfuscateString :: String -> String
524530obfuscateString = concatMap obfuscateChar . fromEntities
525531
526−addAttrs :: WriterOptions -> Attr -> Html -> Html
527−addAttrs opts attr h = foldl (!) h (attrsToHtml opts attr)
532+addAttrs :: PandocMonad m
533+ => WriterOptions -> Attr -> Html -> StateT WriterState m Html
534+addAttrs opts attr h = foldl (!) h <$> attrsToHtml opts attr
528535
529−toAttrs :: [(String, String)] -> [Attribute]
530−toAttrs kvs = map (\(x,y) -> customAttribute (fromString x) (toValue y)) kvs
531−
532−attrsToHtml :: WriterOptions -> Attr -> [Attribute]
533−attrsToHtml opts (id',classes',keyvals) =
534− [prefixedId opts id' | not (null id')] ++
535− [A.class_ (toValue $ unwords classes') | not (null classes')] ++ toAttrs keyvals
536−
537−imgAttrsToHtml :: WriterOptions -> Attr -> [Attribute]
538−imgAttrsToHtml opts attr =
539− attrsToHtml opts (ident,cls,kvs') ++
540− toAttrs (dimensionsToAttrList attr)
536+toAttrs :: PandocMonad m
537+ => [(String, String)] -> StateT WriterState m [Attribute]
538+toAttrs kvs = do
539+ html5 <- gets stHtml5
540+ return $ map (\(x,y) ->
541+ customAttribute
542+ (fromString (if not html5 || x `Set.member` html5Attributes
543+ then x
544+ else "data-" ++ x)) (toValue y)) kvs
545+
546+attrsToHtml :: PandocMonad m
547+ => WriterOptions -> Attr -> StateT WriterState m [Attribute]
548+attrsToHtml opts (id',classes',keyvals) = do
549+ attrs <- toAttrs keyvals
550+ return $
551+ [prefixedId opts id' | not (null id')] ++
552+ [A.class_ (toValue $ unwords classes') | not (null classes')] ++ attrs
553+
554+imgAttrsToHtml :: PandocMonad m
555+ => WriterOptions -> Attr -> StateT WriterState m [Attribute]
556+imgAttrsToHtml opts attr = do
557+ attrs <- attrsToHtml opts (ident,cls,kvs')
558+ dimattrs <- toAttrs (dimensionsToAttrList attr)
559+ return $ attrs ++ dimattrs
541560 where
542561 (ident,cls,kvs) = attr
543562 kvs' = filter isNotDim kvs
@@ -628,15 +647,15 @@ blockToHtml opts (Div attr@(ident, classes, kvs) bs) = do
628647 then (H5.section, filter (/= "section") classes)
629648 else (H.div, classes)
630649 slideVariant <- gets stSlideVariant
631− return $
632− if speakerNotes
633− then case slideVariant of
634− RevealJsSlides -> addAttrs opts' attr $ H5.aside $ contents'
635− DZSlides -> (addAttrs opts' attr $ H5.div $ contents')
636− ! (H5.customAttribute "role" "note")
637− NoSlides -> addAttrs opts' attr $ H.div $ contents'
638− _ -> mempty
639− else addAttrs opts (ident, classes', kvs) $ divtag $ contents'
650+ if speakerNotes
651+ then case slideVariant of
652+ RevealJsSlides -> addAttrs opts' attr $ H5.aside $ contents'
653+ DZSlides -> do
654+ t <- addAttrs opts' attr $ H5.div $ contents'
655+ return $ t ! (H5.customAttribute "role" "note")
656+ NoSlides -> addAttrs opts' attr $ H.div $ contents'
657+ _ -> return mempty
658+ else addAttrs opts (ident, classes', kvs) $ divtag $ contents'
640659blockToHtml opts (RawBlock f str) = do
641660 ishtml <- isRawHtml f
642661 if ishtml
@@ -671,10 +690,10 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
671690 Left msg -> do
672691 unless (null msg) $
673692 report $ CouldNotHighlight msg
674− return $ addAttrs opts (id',classes,keyvals)
675− $ H.pre $ H.code $ toHtml adjCode
693+ addAttrs opts (id',classes,keyvals)
694+ $ H.pre $ H.code $ toHtml adjCode
676695 Right h -> modify (\st -> st{ stHighlighting = True }) >>
677− return (addAttrs opts (id',[],keyvals) h)
696+ addAttrs opts (id',[],keyvals) h
678697blockToHtml opts (BlockQuote blocks) = do
679698 -- in S5, treat list in blockquote specially
680699 -- if default is incremental, make it nonincremental;
@@ -706,7 +725,7 @@ blockToHtml opts (Header level attr@(_,classes,_) lst) = do
706725 $ showSecNum secnum) >> strToHtml " " >> contents
707726 else contents
708727 inElement <- gets stElement
709− return $ (if inElement then id else addAttrs opts attr)
728+ (if inElement then return else addAttrs opts attr)
710729 $ case level of
711730 1 -> H.h1 contents'
712731 2 -> H.h2 contents'
@@ -880,7 +899,7 @@ inlineToHtml opts inline = do
880899 <> strToHtml "\n"
881900 (Span (id',classes,kvs) ils)
882901 -> inlineListToHtml opts ils >>=
883− return . addAttrs opts attr' . H.span
902+ addAttrs opts attr' . H.span
884903 where attr' = (id',classes',kvs')
885904 classes' = filter (`notElem` ["csl-no-emph",
886905 "csl-no-strong",
@@ -900,11 +919,10 @@ inlineToHtml opts inline = do
900919 Left msg -> do
901920 unless (null msg) $
902921 report $ CouldNotHighlight msg
903− return $ addAttrs opts attr
904− $ H.code $ strToHtml str
922+ addAttrs opts attr $ H.code $ strToHtml str
905923 Right h -> do
906924 modify $ \st -> st{ stHighlighting = True }
907− return $ addAttrs opts (id',[],keyvals) h
925+ addAttrs opts (id',[],keyvals) h
908926 where (id',_,keyvals) = attr
909927 hlCode = if isJust (writerHighlightStyle opts)
910928 then highlight
@@ -994,7 +1012,7 @@ inlineToHtml opts inline = do
9941012 return mempty
9951013 (Link attr txt (s,_)) | "mailto:" `isPrefixOf` s -> do
9961014 linkText <- inlineListToHtml opts txt
997− lift $ obfuscateLink opts attr linkText s
1015+ obfuscateLink opts attr linkText s
9981016 (Link (ident,classes,kvs) txt (s,tit)) -> do
9991017 linkText <- inlineListToHtml opts txt
10001018 slideVariant <- gets stSlideVariant
@@ -1008,7 +1026,7 @@ inlineToHtml opts inline = do
10081026 let attr = if txt == [Str (unEscapeString s)]
10091027 then (ident, "uri" : classes, kvs)
10101028 else (ident, classes, kvs)
1011− let link' = addAttrs opts attr link
1029+ link' <- addAttrs opts attr link
10121030 return $ if null tit
10131031 then link'
10141032 else link' ! A.title (toValue tit)
@@ -1016,6 +1034,7 @@ inlineToHtml opts inline = do
10161034 let alternate' = stringify txt
10171035 slideVariant <- gets stSlideVariant
10181036 let isReveal = slideVariant == RevealJsSlides
1037+ attrs <- imgAttrsToHtml opts attr
10191038 let attributes =
10201039 -- reveal.js uses data-src for lazy loading
10211040 (if isReveal
@@ -1023,19 +1042,20 @@ inlineToHtml opts inline = do
10231042 else A.src $ toValue s) :
10241043 [A.title $ toValue tit | not (null tit)] ++
10251044 [A.alt $ toValue alternate' | not (null txt)] ++
1026− imgAttrsToHtml opts attr
1045+ attrs
10271046 let tag = if html5 then H5.img else H.img
10281047 return $ foldl (!) tag attributes
10291048 -- note: null title included, as in Markdown.pl
10301049 (Image attr _ (s,tit)) -> do
10311050 slideVariant <- gets stSlideVariant
10321051 let isReveal = slideVariant == RevealJsSlides
1052+ attrs <- imgAttrsToHtml opts attr
10331053 let attributes =
10341054 (if isReveal
10351055 then customAttribute "data-src" $ toValue s
10361056 else A.src $ toValue s) :
10371057 [A.title $ toValue tit | not (null tit)] ++
1038− imgAttrsToHtml opts attr
1058+ attrs
10391059 return $ foldl (!) H5.embed attributes
10401060 -- note: null title included, as in Markdown.pl
10411061 (Note contents) -> do
@@ -1145,3 +1165,244 @@ isRawHtml f = do
11451165 html5 <- gets stHtml5
11461166 return $ f == Format "html" ||
11471167 ((html5 && f == Format "html5") || f == Format "html4")
1168+
1169+html5Attributes :: Set.Set String
1170+html5Attributes = Set.fromList
1171+ [ "abbr"
1172+ , "accept"
1173+ , "accept-charset"
1174+ , "accesskey"
1175+ , "action"
1176+ , "allowfullscreen"
1177+ , "allowpaymentrequest"
1178+ , "allowusermedia"
1179+ , "alt"
1180+ , "as"
1181+ , "async"
1182+ , "autocomplete"
1183+ , "autocomplete"
1184+ , "autofocus"
1185+ , "autoplay"
1186+ , "charset"
1187+ , "charset"
1188+ , "checked"
1189+ , "cite"
1190+ , "class"
1191+ , "color"
1192+ , "cols"
1193+ , "colspan"
1194+ , "content"
1195+ , "contenteditable"
1196+ , "controls"
1197+ , "coords"
1198+ , "crossorigin"
1199+ , "data"
1200+ , "datetime"
1201+ , "datetime"
1202+ , "default"
1203+ , "defer"
1204+ , "dir"
1205+ , "dir"
1206+ , "dirname"
1207+ , "disabled"
1208+ , "download"
1209+ , "draggable"
1210+ , "enctype"
1211+ , "for"
1212+ , "for"
1213+ , "form"
1214+ , "formaction"
1215+ , "formenctype"
1216+ , "formmethod"
1217+ , "formnovalidate"
1218+ , "formtarget"
1219+ , "headers"
1220+ , "height"
1221+ , "hidden"
1222+ , "high"
1223+ , "href"
1224+ , "href"
1225+ , "href"
1226+ , "hreflang"
1227+ , "http-equiv"
1228+ , "id"
1229+ , "inputmode"
1230+ , "integrity"
1231+ , "is"
1232+ , "ismap"
1233+ , "itemid"
1234+ , "itemprop"
1235+ , "itemref"
1236+ , "itemscope"
1237+ , "itemtype"
1238+ , "kind"
1239+ , "label"
1240+ , "lang"
1241+ , "list"
1242+ , "loop"
1243+ , "low"
1244+ , "manifest"
1245+ , "max"
1246+ , "max"
1247+ , "maxlength"
1248+ , "media"
1249+ , "method"
1250+ , "min"
1251+ , "min"
1252+ , "minlength"
1253+ , "multiple"
1254+ , "muted"
1255+ , "name"
1256+ , "name"
1257+ , "name"
1258+ , "name"
1259+ , "name"
1260+ , "name"
1261+ , "name"
1262+ , "nomodule"
1263+ , "nonce"
1264+ , "novalidate"
1265+ , "open"
1266+ , "open"
1267+ , "optimum"
1268+ , "pattern"
1269+ , "ping"
1270+ , "placeholder"
1271+ , "playsinline"
1272+ , "poster"
1273+ , "preload"
1274+ , "readonly"
1275+ , "referrerpolicy"
1276+ , "rel"
1277+ , "rel"
1278+ , "required"
1279+ , "reversed"
1280+ , "rows"
1281+ , "rowspan"
1282+ , "sandbox"
1283+ , "scope"
1284+ , "scope"
1285+ , "selected"
1286+ , "shape"
1287+ , "size"
1288+ , "sizes"
1289+ , "sizes"
1290+ , "slot"
1291+ , "span"
1292+ , "spellcheck"
1293+ , "src"
1294+ , "srcdoc"
1295+ , "srclang"
1296+ , "srcset"
1297+ , "start"
1298+ , "step"
1299+ , "style"
1300+ , "tabindex"
1301+ , "target"
1302+ , "target"
1303+ , "target"
1304+ , "title"
1305+ , "title"
1306+ , "title"
1307+ , "title"
1308+ , "title"
1309+ , "translate"
1310+ , "type"
1311+ , "type"
1312+ , "type"
1313+ , "type"
1314+ , "type"
1315+ , "typemustmatch"
1316+ , "updateviacache"
1317+ , "usemap"
1318+ , "value"
1319+ , "value"
1320+ , "value"
1321+ , "value"
1322+ , "value"
1323+ , "value"
1324+ , "width"
1325+ , "workertype"
1326+ , "wrap"
1327+ , "onabort"
1328+ , "onauxclick"
1329+ , "onafterprint"
1330+ , "onbeforeprint"
1331+ , "onbeforeunload"
1332+ , "onblur"
1333+ , "oncancel"
1334+ , "oncanplay"
1335+ , "oncanplaythrough"
1336+ , "onchange"
1337+ , "onclick"
1338+ , "onclose"
1339+ , "oncontextmenu"
1340+ , "oncopy"
1341+ , "oncuechange"
1342+ , "oncut"
1343+ , "ondblclick"
1344+ , "ondrag"
1345+ , "ondragend"
1346+ , "ondragenter"
1347+ , "ondragexit"
1348+ , "ondragleave"
1349+ , "ondragover"
1350+ , "ondragstart"
1351+ , "ondrop"
1352+ , "ondurationchange"
1353+ , "onemptied"
1354+ , "onended"
1355+ , "onerror"
1356+ , "onfocus"
1357+ , "onhashchange"
1358+ , "oninput"
1359+ , "oninvalid"
1360+ , "onkeydown"
1361+ , "onkeypress"
1362+ , "onkeyup"
1363+ , "onlanguagechange"
1364+ , "onload"
1365+ , "onloadeddata"
1366+ , "onloadedmetadata"
1367+ , "onloadend"
1368+ , "onloadstart"
1369+ , "onmessage"
1370+ , "onmessageerror"
1371+ , "onmousedown"
1372+ , "onmouseenter"
1373+ , "onmouseleave"
1374+ , "onmousemove"
1375+ , "onmouseout"
1376+ , "onmouseover"
1377+ , "onmouseup"
1378+ , "onwheel"
1379+ , "onoffline"
1380+ , "ononline"
1381+ , "onpagehide"
1382+ , "onpageshow"
1383+ , "onpaste"
1384+ , "onpause"
1385+ , "onplay"
1386+ , "onplaying"
1387+ , "onpopstate"
1388+ , "onprogress"
1389+ , "onratechange"
1390+ , "onreset"
1391+ , "onresize"
1392+ , "onrejectionhandled"
1393+ , "onscroll"
1394+ , "onsecuritypolicyviolation"
1395+ , "onseeked"
1396+ , "onseeking"
1397+ , "onselect"
1398+ , "onstalled"
1399+ , "onstorage"
1400+ , "onsubmit"
1401+ , "onsuspend"
1402+ , "ontimeupdate"
1403+ , "ontoggle"
1404+ , "onunhandledrejection"
1405+ , "onunload"
1406+ , "onvolumechange"
1407+ , "onwaiting"
1408+ ]