git.iko.soy/typeable/pandoc
on master help sign in
HTML writer: ensure headings only have valid attribs in HTML4
25f5b92Albert Krewinkel
src/Text/Pandoc/Writers/HTML.hs+14−2
compare with master
unifiedsplit
@@ -882,7 +882,7 @@ blockToHtml opts (BlockQuote blocks) = do
882 else do
882 else do
883 contents <- blockListToHtml opts blocks
883 contents <- blockListToHtml opts blocks
884 return $ H.blockquote $ nl opts >> contents >> nl opts
884 return $ H.blockquote $ nl opts >> contents >> nl opts
885−blockToHtml opts (Header level attr@(_,classes,kvs) lst) = do
885+blockToHtml opts (Header level (ident,classes,kvs) lst) = do
886 contents <- inlineListToHtml opts lst
886 contents <- inlineListToHtml opts lst
887 let secnum = fromMaybe mempty $ lookup "number" kvs
887 let secnum = fromMaybe mempty $ lookup "number" kvs
888 let contents' = if writerNumberSections opts && not (T.null secnum)
888 let contents' = if writerNumberSections opts && not (T.null secnum)
@@ -890,7 +890,13 @@ blockToHtml opts (Header level attr@(_,classes,kvs) lst) = do
890 then (H.span ! A.class_ "header-section-number"
890 then (H.span ! A.class_ "header-section-number"
891 $ toHtml secnum) >> strToHtml " " >> contents
891 $ toHtml secnum) >> strToHtml " " >> contents
892 else contents
892 else contents
893+ html5 <- gets stHtml5
894+ let kvs' = if html5
895+ then kvs
896+ else [ (k, v) | (k, v) <- kvs
897+ , k `elem` (["lang", "dir", "title", "style"
898+ , "align"] ++ intrinsicEventsHTML4)]
893− addAttrs opts attr
899+ addAttrs opts (ident,classes,kvs')
894 $ case level of
900 $ case level of
895 1 -> H.h1 contents'
901 1 -> H.h1 contents'
896 2 -> H.h2 contents'
902 2 -> H.h2 contents'
@@ -1526,6 +1532,12 @@ allowsMathEnvironments MathML = True
1526allowsMathEnvironments (WebTeX _) = True
1532allowsMathEnvironments (WebTeX _) = True
1527allowsMathEnvironments _ = False
1533allowsMathEnvironments _ = False
1528
1534
1535+-- | List of intrinsic event attributes allowed on all elements in HTML4.
1536+intrinsicEventsHTML4 :: [Text]
1537+intrinsicEventsHTML4 =
1538+ [ "onclick", "ondblclick", "onmousedown", "onmouseup", "onmouseover"
1539+ , "onmouseout", "onmouseout", "onkeypress", "onkeydown", "onkeyup"]
1540+
1529isRawHtml :: PandocMonad m => Format -> StateT WriterState m Bool
1541isRawHtml :: PandocMonad m => Format -> StateT WriterState m Bool
1530isRawHtml f = do
1542isRawHtml f = do
1531 html5 <- gets stHtml5
1543 html5 <- gets stHtml5
test/Tests/Writers/HTML.hs+57−52
@@ -34,55 +34,60 @@ infix 4 =:
34(=:) = test html
34(=:) = test html
35
35
36tests :: [TestTree]
36tests :: [TestTree]
37+tests =
37−tests = [ testGroup "inline code"
38+ [ testGroup "inline code"
38− [ "basic" =: code "@&" =?> "<code>@&amp;</code>"
39+ [ "basic" =: code "@&" =?> "<code>@&amp;</code>"
39− , "haskell" =: codeWith ("",["haskell"],[]) ">>="
40+ , "haskell" =: codeWith ("",["haskell"],[]) ">>="
40− =?> "<code class=\"sourceCode haskell\"><span class=\"op\">&gt;&gt;=</span></code>"
41+ =?> "<code class=\"sourceCode haskell\"><span class=\"op\">&gt;&gt;=</span></code>"
41− , "nolanguage" =: codeWith ("",["nolanguage"],[]) ">>="
42+ , "nolanguage" =: codeWith ("",["nolanguage"],[]) ">>="
42− =?> "<code class=\"nolanguage\">&gt;&gt;=</code>"
43+ =?> "<code class=\"nolanguage\">&gt;&gt;=</code>"
43− ]
44+ ]
44− , testGroup "images"
45+ , testGroup "images"
45− [ "alt with formatting" =:
46+ [ "alt with formatting" =:
46− image "/url" "title" ("my " <> emph "image")
47+ image "/url" "title" ("my " <> emph "image")
47− =?> "<img src=\"/url\" title=\"title\" alt=\"my image\" />"
48+ =?> "<img src=\"/url\" title=\"title\" alt=\"my image\" />"
48− ]
49+ ]
49− , testGroup "blocks"
50+ , testGroup "blocks"
50− [ "definition list with empty <dt>" =:
51+ [ "definition list with empty <dt>" =:
51− definitionList [(mempty, [para $ text "foo bar"])]
52+ definitionList [(mempty, [para $ text "foo bar"])]
52− =?> "<dl><dt></dt><dd><p>foo bar</p></dd></dl>"
53+ =?> "<dl><dt></dt><dd><p>foo bar</p></dd></dl>"
54+ , "heading with disallowed attributes" =:
55+ headerWith ("", [], [("invalid","1"), ("lang", "en")]) 1 "test"
56+ =?>
57+ "<h1 lang=\"en\">test</h1>"
53− ]
58+ ]
54− , testGroup "quotes"
59+ , testGroup "quotes"
55− [ "quote with cite attribute (without q-tags)" =:
60+ [ "quote with cite attribute (without q-tags)" =:
56− doubleQuoted (spanWith ("", [], [("cite", "http://example.org")]) (str "examples"))
61+ doubleQuoted (spanWith ("", [], [("cite", "http://example.org")]) (str "examples"))
57− =?> "“<span cite=\"http://example.org\">examples</span>”"
62+ =?> "“<span cite=\"http://example.org\">examples</span>”"
58− , tQ "quote with cite attribute (with q-tags)" $
63+ , tQ "quote with cite attribute (with q-tags)" $
59− doubleQuoted (spanWith ("", [], [("cite", "http://example.org")]) (str "examples"))
64+ doubleQuoted (spanWith ("", [], [("cite", "http://example.org")]) (str "examples"))
60− =?> "<q cite=\"http://example.org\">examples</q>"
65+ =?> "<q cite=\"http://example.org\">examples</q>"
61− ]
66+ ]
62− , testGroup "sample"
67+ , testGroup "sample"
63− [ "sample should be rendered correctly" =:
68+ [ "sample should be rendered correctly" =:
64− plain (codeWith ("",["sample"],[]) "Answer is 42") =?>
69+ plain (codeWith ("",["sample"],[]) "Answer is 42") =?>
65− "<samp>Answer is 42</samp>"
70+ "<samp>Answer is 42</samp>"
66− ]
71+ ]
67− , testGroup "variable"
72+ , testGroup "variable"
68− [ "variable should be rendered correctly" =:
73+ [ "variable should be rendered correctly" =:
69− plain (codeWith ("",["variable"],[]) "result") =?>
74+ plain (codeWith ("",["variable"],[]) "result") =?>
70− "<var>result</var>"
75+ "<var>result</var>"
71− ]
76+ ]
72− , testGroup "sample with style"
77+ , testGroup "sample with style"
73− [ "samp should wrap highlighted code" =:
78+ [ "samp should wrap highlighted code" =:
74− codeWith ("",["sample","haskell"],[]) ">>="
79+ codeWith ("",["sample","haskell"],[]) ">>="
75− =?> ("<samp><code class=\"sourceCode haskell\">" ++
80+ =?> ("<samp><code class=\"sourceCode haskell\">" ++
76− "<span class=\"op\">&gt;&gt;=</span></code></samp>")
81+ "<span class=\"op\">&gt;&gt;=</span></code></samp>")
77− ]
82+ ]
78− , testGroup "variable with style"
83+ , testGroup "variable with style"
79− [ "var should wrap highlighted code" =:
84+ [ "var should wrap highlighted code" =:
80− codeWith ("",["haskell","variable"],[]) ">>="
85+ codeWith ("",["haskell","variable"],[]) ">>="
81− =?> ("<var><code class=\"sourceCode haskell\">" ++
86+ =?> ("<var><code class=\"sourceCode haskell\">" ++
82− "<span class=\"op\">&gt;&gt;=</span></code></var>")
87+ "<span class=\"op\">&gt;&gt;=</span></code></var>")
83− ]
88+ ]
84− ]
89+ ]
85− where
90+ where
86− tQ :: (ToString a, ToPandoc a)
91+ tQ :: (ToString a, ToPandoc a)
87− => String -> (a, String) -> TestTree
92+ => String -> (a, String) -> TestTree
88− tQ = test htmlQTags
93+ tQ = test htmlQTags