Revamped raw HTML block parsing in markdown.

- We no longer include trailing spaces and newlines in the
  raw blocks.
- We look for closing tags for elements (but without backtracking).
- Each block-level tag is its own RawBlock; we no longer try to
  consolidate them (though `--normalize` will do so).

Closes #1330.
This commit is contained in:
John MacFarlane 2014-07-07 15:47:51 -06:00
parent 91b902f02f
commit e4263d306e
14 changed files with 277 additions and 196 deletions

View file

@ -752,7 +752,7 @@ listLine = try $ do
notFollowedBy' (do indentSpaces
many spaceChar
listStart)
notFollowedBy' $ htmlTag (~== TagClose "div")
notFollowedByHtmlCloser
optional (() <$ indentSpaces)
chunks <- manyTill
( many1 (satisfy $ \c -> c /= '\n' && c /= '<')
@ -781,11 +781,18 @@ listContinuation = try $ do
blanks <- many blankline
return $ concat result ++ blanks
notFollowedByHtmlCloser :: MarkdownParser ()
notFollowedByHtmlCloser = do
inHtmlBlock <- stateInHtmlBlock <$> getState
case inHtmlBlock of
Just t -> notFollowedBy' $ htmlTag (~== TagClose t)
Nothing -> return ()
listContinuationLine :: MarkdownParser String
listContinuationLine = try $ do
notFollowedBy blankline
notFollowedBy' listStart
notFollowedBy' $ htmlTag (~== TagClose "div")
notFollowedByHtmlCloser
optional indentSpaces
result <- anyLine
return $ result ++ "\n"
@ -914,16 +921,23 @@ htmlElement = rawVerbatimBlock
htmlBlock :: MarkdownParser (F Blocks)
htmlBlock = do
guardEnabled Ext_raw_html
res <- (guardEnabled Ext_markdown_in_html_blocks >> rawHtmlBlocks)
<|> htmlBlock'
return $ return $ B.rawBlock "html" res
try (do
(TagOpen t attrs) <- lookAhead $ fst <$> htmlTag isBlockTag
(guard (t `elem` ["pre","style","script"]) >>
(return . B.rawBlock "html") <$> rawVerbatimBlock)
<|> (guardEnabled Ext_markdown_attribute >>
case lookup "markdown" attrs of
Just "1" -> rawHtmlBlocks
_ -> htmlBlock')
<|> (guardEnabled Ext_markdown_in_html_blocks >> rawHtmlBlocks))
<|> htmlBlock'
htmlBlock' :: MarkdownParser String
htmlBlock' :: MarkdownParser (F Blocks)
htmlBlock' = try $ do
first <- htmlElement
finalSpace <- many spaceChar
finalNewlines <- many newline
return $ first ++ finalSpace ++ finalNewlines
skipMany spaceChar
optional blanklines
return $ return $ B.rawBlock "html" first
strictHtmlBlock :: MarkdownParser String
strictHtmlBlock = htmlInBalanced (not . isInlineTag)
@ -946,38 +960,24 @@ rawTeXBlock = do
spaces
return $ return result
rawHtmlBlocks :: MarkdownParser String
rawHtmlBlocks :: MarkdownParser (F Blocks)
rawHtmlBlocks = do
htmlBlocks <- many1 $ try $ do
s <- rawVerbatimBlock <|> try (
do (t,raw) <- htmlTag isBlockTag
guard $ t ~/= TagOpen "div" [] &&
t ~/= TagClose "div"
exts <- getOption readerExtensions
-- if open tag, need markdown="1" if
-- markdown_attributes extension is set
case t of
TagOpen _ as
| Ext_markdown_attribute `Set.member`
exts ->
if "markdown" `notElem`
map fst as
then mzero
else return $
stripMarkdownAttribute raw
| otherwise -> return raw
_ -> return raw )
sps <- do sp1 <- many spaceChar
sp2 <- option "" (blankline >> return "\n")
sp3 <- many spaceChar
sp4 <- option "" blanklines
return $ sp1 ++ sp2 ++ sp3 ++ sp4
-- note: we want raw html to be able to
-- precede a code block, when separated
-- by a blank line
return $ s ++ sps
let combined = concat htmlBlocks
return $ if last combined == '\n' then init combined else combined
(TagOpen tagtype _, raw) <- htmlTag isBlockTag
-- try to find closing tag
-- we set stateInHtmlBlock so that closing tags that can be either block or
-- inline will not be parsed as inline tags
oldInHtmlBlock <- stateInHtmlBlock <$> getState
updateState $ \st -> st{ stateInHtmlBlock = Just tagtype }
let closer = htmlTag (\x -> x ~== TagClose tagtype)
contents <- mconcat <$> many (notFollowedBy' closer >> block)
result <-
(closer >>= \(_, rawcloser) -> return (
return (B.rawBlock "html" $ stripMarkdownAttribute raw) <>
contents <>
return (B.rawBlock "html" rawcloser)))
<|> return (return (B.rawBlock "html" raw) <> contents)
updateState $ \st -> st{ stateInHtmlBlock = oldInHtmlBlock }
return result
-- remove markdown="1" attribute
stripMarkdownAttribute :: String -> String
@ -1765,10 +1765,15 @@ divHtml = try $ do
rawHtmlInline :: MarkdownParser (F Inlines)
rawHtmlInline = do
guardEnabled Ext_raw_html
inHtmlBlock <- stateInHtmlBlock <$> getState
let isCloseBlockTag t = case inHtmlBlock of
Just t' -> t ~== TagClose t'
Nothing -> False
mdInHtml <- option False $
guardEnabled Ext_markdown_in_html_blocks >> return True
(_,result) <- htmlTag $ if mdInHtml
then isInlineTag
then (\x -> isInlineTag x &&
not (isCloseBlockTag x))
else not . isTextTag
return $ return $ B.rawInline "html" result

View file

@ -222,7 +222,7 @@ tests = [ testGroup "inline code"
=?> bulletList [divWith nullAttr (plain $ text "first div breaks") <>
rawBlock "html" "<button>" <>
plain (text "if this button exists") <>
rawBlock "html" "</button>\n" <>
rawBlock "html" "</button>" <>
divWith nullAttr (plain $ text "with this div too.")]
]
]

View file

@ -232,11 +232,17 @@ Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "John",Spa
,Para [Str "And",Space,Str "nested",Space,Str "without",Space,Str "indentation:"]
,Div ("",[],[]) [Div ("",[],[]) [Div ("",[],[]) [Plain [Str "foo"]]],Div ("",[],[]) [Plain [Str "bar"]]]
,Para [Str "Interpreted",Space,Str "markdown",Space,Str "in",Space,Str "a",Space,Str "table:"]
,RawBlock (Format "html") "<table>\n<tr>\n<td>"
,RawBlock (Format "html") "<table>"
,RawBlock (Format "html") "<tr>"
,RawBlock (Format "html") "<td>"
,Plain [Str "This",Space,Str "is",Space,Emph [Str "emphasized"]]
,RawBlock (Format "html") "</td>\n<td>"
,RawBlock (Format "html") "</td>"
,RawBlock (Format "html") "<td>"
,Plain [Str "And",Space,Str "this",Space,Str "is",Space,Strong [Str "strong"]]
,RawBlock (Format "html") "</td>\n</tr>\n</table>\n\n<script type=\"text/javascript\">document.write('This *should not* be interpreted as markdown');</script>\n"
,RawBlock (Format "html") "</td>"
,RawBlock (Format "html") "</tr>"
,RawBlock (Format "html") "</table>"
,RawBlock (Format "html") "<script type=\"text/javascript\">document.write('This *should not* be interpreted as markdown');</script>"
,Para [Str "Here\8217s",Space,Str "a",Space,Str "simple",Space,Str "block:"]
,Div ("",[],[]) [Plain [Str "foo"]]
,Para [Str "This",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "code",Space,Str "block,",Space,Str "though:"]
@ -246,17 +252,26 @@ Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "John",Spa
,Para [Str "Now,",Space,Str "nested:"]
,Div ("",[],[]) [Div ("",[],[]) [Div ("",[],[]) [Plain [Str "foo"]]]]
,Para [Str "This",Space,Str "should",Space,Str "just",Space,Str "be",Space,Str "an",Space,Str "HTML",Space,Str "comment:"]
,RawBlock (Format "html") "<!-- Comment -->\n"
,RawBlock (Format "html") "<!-- Comment -->"
,Para [Str "Multiline:"]
,RawBlock (Format "html") "<!--\nBlah\nBlah\n-->\n\n<!--\n This is another comment.\n-->\n"
,RawBlock (Format "html") "<!--\nBlah\nBlah\n-->"
,RawBlock (Format "html") "<!--\n This is another comment.\n-->"
,Para [Str "Code",Space,Str "block:"]
,CodeBlock ("",[],[]) "<!-- Comment -->"
,Para [Str "Just",Space,Str "plain",Space,Str "comment,",Space,Str "with",Space,Str "trailing",Space,Str "spaces",Space,Str "on",Space,Str "the",Space,Str "line:"]
,RawBlock (Format "html") "<!-- foo --> \n"
,RawBlock (Format "html") "<!-- foo -->"
,Para [Str "Code:"]
,CodeBlock ("",[],[]) "<hr />"
,Para [Str "Hr\8217s:"]
,RawBlock (Format "html") "<hr>\n\n<hr />\n\n<hr />\n\n<hr> \n\n<hr /> \n\n<hr /> \n\n<hr class=\"foo\" id=\"bar\" />\n\n<hr class=\"foo\" id=\"bar\" />\n\n<hr class=\"foo\" id=\"bar\">\n"
,RawBlock (Format "html") "<hr>"
,RawBlock (Format "html") "<hr />"
,RawBlock (Format "html") "<hr />"
,RawBlock (Format "html") "<hr>"
,RawBlock (Format "html") "<hr />"
,RawBlock (Format "html") "<hr />"
,RawBlock (Format "html") "<hr class=\"foo\" id=\"bar\" />"
,RawBlock (Format "html") "<hr class=\"foo\" id=\"bar\" />"
,RawBlock (Format "html") "<hr class=\"foo\" id=\"bar\">"
,HorizontalRule
,Header 1 ("inline-markup",[],[]) [Str "Inline",Space,Str "Markup"]
,Para [Str "This",Space,Str "is",Space,Emph [Str "emphasized"],Str ",",Space,Str "and",Space,Str "so",Space,Emph [Str "is",Space,Str "this"],Str "."]

View file

@ -887,7 +887,6 @@ These should not be escaped: \$ \\ \&gt; \[ \{
</td>
</tr>
</table>
<script type="text/javascript">document.write('This *should not* be interpreted as markdown');</script>
<para>
Heres a simple block:
@ -926,7 +925,6 @@ These should not be escaped: \$ \\ \&gt; \[ \{
Blah
Blah
-->
<!--
This is another comment.
-->
@ -939,7 +937,7 @@ These should not be escaped: \$ \\ \&gt; \[ \{
<para>
Just plain comment, with trailing spaces on the line:
</para>
<!-- foo -->
<!-- foo -->
<para>
Code:
</para>
@ -950,21 +948,13 @@ These should not be escaped: \$ \\ \&gt; \[ \{
Hrs:
</para>
<hr>
<hr />
<hr />
<hr>
<hr />
<hr />
<hr>
<hr />
<hr />
<hr class="foo" id="bar" />
<hr class="foo" id="bar" />
<hr class="foo" id="bar">
</sect1>
<sect1 id="inline-markup">

File diff suppressed because one or more lines are too long

View file

@ -346,9 +346,7 @@ And this is <strong>strong</strong>
</td>
</tr>
</table>
<script type="text/javascript">document.write('This *should not* be interpreted as markdown');</script>
<p>Heres a simple block:</p>
<div>
foo
@ -369,43 +367,30 @@ foo
</div>
<p>This should just be an HTML comment:</p>
<!-- Comment -->
<p>Multiline:</p>
<!--
Blah
Blah
-->
<!--
This is another comment.
-->
<p>Code block:</p>
<pre><code>&lt;!-- Comment --&gt;</code></pre>
<p>Just plain comment, with trailing spaces on the line:</p>
<!-- foo -->
<!-- foo -->
<p>Code:</p>
<pre><code>&lt;hr /&gt;</code></pre>
<p>Hrs:</p>
<hr>
<hr />
<hr />
<hr>
<hr />
<hr />
<hr>
<hr />
<hr />
<hr class="foo" id="bar" />
<hr class="foo" id="bar" />
<hr class="foo" id="bar">
<hr />
<h1 id="inline-markup">Inline Markup</h1>
<p>This is <em>emphasized</em>, and so <em>is this</em>.</p>

View file

@ -1391,9 +1391,17 @@ These should not be escaped: \$ \\ \&gt; \[ \{</Content>
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;table&gt;
&lt;tr&gt;
&lt;td&gt;</Content>
<Content>&lt;table&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;tr&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;td&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="">
@ -1406,8 +1414,12 @@ These should not be escaped: \$ \\ \&gt; \[ \{</Content>
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;/td&gt;
&lt;td&gt;</Content>
<Content>&lt;/td&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;td&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="">
@ -1420,12 +1432,22 @@ These should not be escaped: \$ \\ \&gt; \[ \{</Content>
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;/td&gt;
&lt;/tr&gt;
&lt;/table&gt;
&lt;script type=&quot;text/javascript&quot;&gt;document.write('This *should not* be interpreted as markdown');&lt;/script&gt;
</Content>
<Content>&lt;/td&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;/tr&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;/table&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;script type=&quot;text/javascript&quot;&gt;document.write('This *should not* be interpreted as markdown');&lt;/script&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Paragraph">
@ -1477,8 +1499,7 @@ These should not be escaped: \$ \\ \&gt; \[ \{</Content>
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;!-- Comment --&gt;
</Content>
<Content>&lt;!-- Comment --&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Paragraph">
@ -1491,12 +1512,14 @@ These should not be escaped: \$ \\ \&gt; \[ \{</Content>
<Content>&lt;!--
Blah
Blah
--&gt;
&lt;!--
--&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;!--
This is another comment.
--&gt;
</Content>
--&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Paragraph">
@ -1516,8 +1539,7 @@ Blah
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;!-- foo --&gt;
</Content>
<Content>&lt;!-- foo --&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Paragraph">
@ -1537,24 +1559,47 @@ Blah
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;hr&gt;
&lt;hr /&gt;
&lt;hr /&gt;
&lt;hr&gt;
&lt;hr /&gt;
&lt;hr /&gt;
&lt;hr class=&quot;foo&quot; id=&quot;bar&quot; /&gt;
&lt;hr class=&quot;foo&quot; id=&quot;bar&quot; /&gt;
&lt;hr class=&quot;foo&quot; id=&quot;bar&quot;&gt;
</Content>
<Content>&lt;hr&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;hr /&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;hr /&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;hr&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;hr /&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;hr /&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;hr class=&quot;foo&quot; id=&quot;bar&quot; /&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;hr class=&quot;foo&quot; id=&quot;bar&quot; /&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Rawblock">
<CharacterStyleRange AppliedCharacterStyle="$ID/NormalCharacterStyle">
<Content>&lt;hr class=&quot;foo&quot; id=&quot;bar&quot;&gt;</Content>
</CharacterStyleRange><Br />
</ParagraphStyleRange>
<ParagraphStyleRange AppliedParagraphStyle="ParagraphStyle/Header1">

View file

@ -395,9 +395,7 @@ And this is **strong**
</td>
</tr>
</table>
<script type="text/javascript">document.write('This *should not* be interpreted as markdown');</script>
Heres a simple block:
<div>
@ -435,26 +433,22 @@ foo
This should just be an HTML comment:
<!-- Comment -->
Multiline:
<!--
Blah
Blah
-->
<!--
This is another comment.
-->
Code block:
<!-- Comment -->
Just plain comment, with trailing spaces on the line:
<!-- foo -->
<!-- foo -->
Code:
<hr />
@ -462,21 +456,13 @@ Code:
Hrs:
<hr>
<hr />
<hr />
<hr>
<hr />
<hr />
<hr>
<hr />
<hr />
<hr class="foo" id="bar" />
<hr class="foo" id="bar" />
<hr class="foo" id="bar">
* * * * *

View file

@ -347,9 +347,7 @@ And this is '''strong'''
</td>
</tr>
</table>
<script type="text/javascript">document.write('This *should not* be interpreted as markdown');</script>
Heres a simple block:
<div>
@ -383,49 +381,36 @@ foo
This should just be an HTML comment:
<!-- Comment -->
Multiline:
<!--
Blah
Blah
-->
<!--
This is another comment.
-->
Code block:
<pre>&lt;!-- Comment --&gt;</pre>
Just plain comment, with trailing spaces on the line:
<!-- foo -->
<!-- foo -->
Code:
<pre>&lt;hr /&gt;</pre>
Hrs:
<hr>
<hr />
<hr />
<hr>
<hr />
<hr />
<hr>
<hr />
<hr />
<hr class="foo" id="bar" />
<hr class="foo" id="bar" />
<hr class="foo" id="bar">
-----
= Inline Markup =

View file

@ -232,11 +232,17 @@ Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "John",Spa
,Para [Str "And",Space,Str "nested",Space,Str "without",Space,Str "indentation:"]
,Div ("",[],[]) [Div ("",[],[]) [Div ("",[],[]) [Plain [Str "foo"]]],Div ("",[],[]) [Plain [Str "bar"]]]
,Para [Str "Interpreted",Space,Str "markdown",Space,Str "in",Space,Str "a",Space,Str "table:"]
,RawBlock (Format "html") "<table>\n<tr>\n<td>"
,RawBlock (Format "html") "<table>"
,RawBlock (Format "html") "<tr>"
,RawBlock (Format "html") "<td>"
,Plain [Str "This",Space,Str "is",Space,Emph [Str "emphasized"]]
,RawBlock (Format "html") "</td>\n<td>"
,RawBlock (Format "html") "</td>"
,RawBlock (Format "html") "<td>"
,Plain [Str "And",Space,Str "this",Space,Str "is",Space,Strong [Str "strong"]]
,RawBlock (Format "html") "</td>\n</tr>\n</table>\n\n<script type=\"text/javascript\">document.write('This *should not* be interpreted as markdown');</script>\n"
,RawBlock (Format "html") "</td>"
,RawBlock (Format "html") "</tr>"
,RawBlock (Format "html") "</table>"
,RawBlock (Format "html") "<script type=\"text/javascript\">document.write('This *should not* be interpreted as markdown');</script>"
,Para [Str "Here\8217s",Space,Str "a",Space,Str "simple",Space,Str "block:"]
,Div ("",[],[]) [Plain [Str "foo"]]
,Para [Str "This",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "code",Space,Str "block,",Space,Str "though:"]
@ -246,17 +252,26 @@ Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "John",Spa
,Para [Str "Now,",Space,Str "nested:"]
,Div ("",[],[]) [Div ("",[],[]) [Div ("",[],[]) [Plain [Str "foo"]]]]
,Para [Str "This",Space,Str "should",Space,Str "just",Space,Str "be",Space,Str "an",Space,Str "HTML",Space,Str "comment:"]
,RawBlock (Format "html") "<!-- Comment -->\n"
,RawBlock (Format "html") "<!-- Comment -->"
,Para [Str "Multiline:"]
,RawBlock (Format "html") "<!--\nBlah\nBlah\n-->\n\n<!--\n This is another comment.\n-->\n"
,RawBlock (Format "html") "<!--\nBlah\nBlah\n-->"
,RawBlock (Format "html") "<!--\n This is another comment.\n-->"
,Para [Str "Code",Space,Str "block:"]
,CodeBlock ("",[],[]) "<!-- Comment -->"
,Para [Str "Just",Space,Str "plain",Space,Str "comment,",Space,Str "with",Space,Str "trailing",Space,Str "spaces",Space,Str "on",Space,Str "the",Space,Str "line:"]
,RawBlock (Format "html") "<!-- foo --> \n"
,RawBlock (Format "html") "<!-- foo -->"
,Para [Str "Code:"]
,CodeBlock ("",[],[]) "<hr />"
,Para [Str "Hr\8217s:"]
,RawBlock (Format "html") "<hr>\n\n<hr />\n\n<hr />\n\n<hr> \n\n<hr /> \n\n<hr /> \n\n<hr class=\"foo\" id=\"bar\" />\n\n<hr class=\"foo\" id=\"bar\" />\n\n<hr class=\"foo\" id=\"bar\">\n"
,RawBlock (Format "html") "<hr>"
,RawBlock (Format "html") "<hr />"
,RawBlock (Format "html") "<hr />"
,RawBlock (Format "html") "<hr>"
,RawBlock (Format "html") "<hr />"
,RawBlock (Format "html") "<hr />"
,RawBlock (Format "html") "<hr class=\"foo\" id=\"bar\" />"
,RawBlock (Format "html") "<hr class=\"foo\" id=\"bar\" />"
,RawBlock (Format "html") "<hr class=\"foo\" id=\"bar\">"
,HorizontalRule
,Header 1 ("inline-markup",[],[]) [Str "Inline",Space,Str "Markup"]
,Para [Str "This",Space,Str "is",Space,Emph [Str "emphasized"],Str ",",Space,Str "and",Space,Str "so",Space,Emph [Str "is",Space,Str "this"],Str "."]

View file

@ -44,7 +44,7 @@
</outline>
<outline text="Definition Lists" _note="Tight using spaces:&#10;&#10;apple&#10;: red fruit&#10;orange&#10;: orange fruit&#10;banana&#10;: yellow fruit&#10;&#10;Tight using tabs:&#10;&#10;apple&#10;: red fruit&#10;orange&#10;: orange fruit&#10;banana&#10;: yellow fruit&#10;&#10;Loose:&#10;&#10;apple&#10;: red fruit&#10;&#10;orange&#10;: orange fruit&#10;&#10;banana&#10;: yellow fruit&#10;&#10;Multiple blocks with italics:&#10;&#10;*apple*&#10;: red fruit&#10;&#10; contains seeds, crisp, pleasant to taste&#10;&#10;*orange*&#10;: orange fruit&#10;&#10; { orange code block }&#10;&#10; &gt; orange block quote&#10;&#10;Multiple definitions, tight:&#10;&#10;apple&#10;: red fruit&#10;: computer&#10;orange&#10;: orange fruit&#10;: bank&#10;&#10;Multiple definitions, loose:&#10;&#10;apple&#10;: red fruit&#10;&#10;: computer&#10;&#10;orange&#10;: orange fruit&#10;&#10;: bank&#10;&#10;Blank line after term, indented marker, alternate markers:&#10;&#10;apple&#10;: red fruit&#10;&#10;: computer&#10;&#10;orange&#10;: orange fruit&#10;&#10; 1. sublist&#10; 2. sublist&#10;&#10;">
</outline>
<outline text="HTML Blocks" _note="Simple block on one line:&#10;&#10;&lt;div&gt;&#10;&#10;foo&#10;&#10;&lt;/div&gt;&#10;&#10;And nested without indentation:&#10;&#10;&lt;div&gt;&#10;&#10;&lt;div&gt;&#10;&#10;&lt;div&gt;&#10;&#10;foo&#10;&#10;&lt;/div&gt;&#10;&#10;&lt;/div&gt;&#10;&#10;&lt;div&gt;&#10;&#10;bar&#10;&#10;&lt;/div&gt;&#10;&#10;&lt;/div&gt;&#10;&#10;Interpreted markdown in a table:&#10;&#10;&lt;table&gt;&#10;&lt;tr&gt;&#10;&lt;td&gt;&#10;This is *emphasized*&#10;&lt;/td&gt;&#10;&lt;td&gt;&#10;And this is **strong**&#10;&lt;/td&gt;&#10;&lt;/tr&gt;&#10;&lt;/table&gt;&#10;&#10;&lt;script type=&quot;text/javascript&quot;&gt;document.write('This *should not* be interpreted as markdown');&lt;/script&gt;&#10;&#10;Heres a simple block:&#10;&#10;&lt;div&gt;&#10;&#10;foo&#10;&#10;&lt;/div&gt;&#10;&#10;This should be a code block, though:&#10;&#10; &lt;div&gt;&#10; foo&#10; &lt;/div&gt;&#10;&#10;As should this:&#10;&#10; &lt;div&gt;foo&lt;/div&gt;&#10;&#10;Now, nested:&#10;&#10;&lt;div&gt;&#10;&#10;&lt;div&gt;&#10;&#10;&lt;div&gt;&#10;&#10;foo&#10;&#10;&lt;/div&gt;&#10;&#10;&lt;/div&gt;&#10;&#10;&lt;/div&gt;&#10;&#10;This should just be an HTML comment:&#10;&#10;&lt;!-- Comment --&gt;&#10;&#10;Multiline:&#10;&#10;&lt;!--&#10;Blah&#10;Blah&#10;--&gt;&#10;&#10;&lt;!--&#10; This is another comment.&#10;--&gt;&#10;&#10;Code block:&#10;&#10; &lt;!-- Comment --&gt;&#10;&#10;Just plain comment, with trailing spaces on the line:&#10;&#10;&lt;!-- foo --&gt; &#10;&#10;Code:&#10;&#10; &lt;hr /&gt;&#10;&#10;Hrs:&#10;&#10;&lt;hr&gt;&#10;&#10;&lt;hr /&gt;&#10;&#10;&lt;hr /&gt;&#10;&#10;&lt;hr&gt; &#10;&#10;&lt;hr /&gt; &#10;&#10;&lt;hr /&gt; &#10;&#10;&lt;hr class=&quot;foo&quot; id=&quot;bar&quot; /&gt;&#10;&#10;&lt;hr class=&quot;foo&quot; id=&quot;bar&quot; /&gt;&#10;&#10;&lt;hr class=&quot;foo&quot; id=&quot;bar&quot;&gt;&#10;&#10;* * * * *">
<outline text="HTML Blocks" _note="Simple block on one line:&#10;&#10;&lt;div&gt;&#10;&#10;foo&#10;&#10;&lt;/div&gt;&#10;&#10;And nested without indentation:&#10;&#10;&lt;div&gt;&#10;&#10;&lt;div&gt;&#10;&#10;&lt;div&gt;&#10;&#10;foo&#10;&#10;&lt;/div&gt;&#10;&#10;&lt;/div&gt;&#10;&#10;&lt;div&gt;&#10;&#10;bar&#10;&#10;&lt;/div&gt;&#10;&#10;&lt;/div&gt;&#10;&#10;Interpreted markdown in a table:&#10;&#10;&lt;table&gt;&#10;&lt;tr&gt;&#10;&lt;td&gt;&#10;This is *emphasized*&#10;&lt;/td&gt;&#10;&lt;td&gt;&#10;And this is **strong**&#10;&lt;/td&gt;&#10;&lt;/tr&gt;&#10;&lt;/table&gt;&#10;&lt;script type=&quot;text/javascript&quot;&gt;document.write('This *should not* be interpreted as markdown');&lt;/script&gt;&#10;Heres a simple block:&#10;&#10;&lt;div&gt;&#10;&#10;foo&#10;&#10;&lt;/div&gt;&#10;&#10;This should be a code block, though:&#10;&#10; &lt;div&gt;&#10; foo&#10; &lt;/div&gt;&#10;&#10;As should this:&#10;&#10; &lt;div&gt;foo&lt;/div&gt;&#10;&#10;Now, nested:&#10;&#10;&lt;div&gt;&#10;&#10;&lt;div&gt;&#10;&#10;&lt;div&gt;&#10;&#10;foo&#10;&#10;&lt;/div&gt;&#10;&#10;&lt;/div&gt;&#10;&#10;&lt;/div&gt;&#10;&#10;This should just be an HTML comment:&#10;&#10;&lt;!-- Comment --&gt;&#10;Multiline:&#10;&#10;&lt;!--&#10;Blah&#10;Blah&#10;--&gt;&#10;&lt;!--&#10; This is another comment.&#10;--&gt;&#10;Code block:&#10;&#10; &lt;!-- Comment --&gt;&#10;&#10;Just plain comment, with trailing spaces on the line:&#10;&#10;&lt;!-- foo --&gt;&#10;Code:&#10;&#10; &lt;hr /&gt;&#10;&#10;Hrs:&#10;&#10;&lt;hr&gt;&#10;&lt;hr /&gt;&#10;&lt;hr /&gt;&#10;&lt;hr&gt;&#10;&lt;hr /&gt;&#10;&lt;hr /&gt;&#10;&lt;hr class=&quot;foo&quot; id=&quot;bar&quot; /&gt;&#10;&lt;hr class=&quot;foo&quot; id=&quot;bar&quot; /&gt;&#10;&lt;hr class=&quot;foo&quot; id=&quot;bar&quot;&gt;&#10;&#10;* * * * *">
</outline>
<outline text="Inline Markup" _note="This is *emphasized*, and so *is this*.&#10;&#10;This is **strong**, and so **is this**.&#10;&#10;An *[emphasized link](/url)*.&#10;&#10;***This is strong and em.***&#10;&#10;So is ***this*** word.&#10;&#10;***This is strong and em.***&#10;&#10;So is ***this*** word.&#10;&#10;This is code: `&gt;`, `$`, `\`, `\$`, `&lt;html&gt;`.&#10;&#10;~~This is *strikeout*.~~&#10;&#10;Superscripts: a^bc^d a^*hello*^ a^hello there^.&#10;&#10;Subscripts: H~2~O, H~23~O, H~many of them~O.&#10;&#10;These should not be superscripts or subscripts, because of the unescaped&#10;spaces: a\^b c\^d, a\~b c\~d.&#10;&#10;* * * * *">
</outline>

View file

@ -397,7 +397,13 @@ Interpreted markdown in a table:
#+BEGIN_HTML
<table>
#+END_HTML
#+BEGIN_HTML
<tr>
#+END_HTML
#+BEGIN_HTML
<td>
#+END_HTML
@ -405,6 +411,9 @@ This is /emphasized/
#+BEGIN_HTML
</td>
#+END_HTML
#+BEGIN_HTML
<td>
#+END_HTML
@ -412,9 +421,17 @@ And this is *strong*
#+BEGIN_HTML
</td>
</tr>
</table>
#+END_HTML
#+BEGIN_HTML
</tr>
#+END_HTML
#+BEGIN_HTML
</table>
#+END_HTML
#+BEGIN_HTML
<script type="text/javascript">document.write('This *should not* be interpreted as markdown');</script>
#+END_HTML
@ -485,7 +502,9 @@ Multiline:
Blah
Blah
-->
#+END_HTML
#+BEGIN_HTML
<!--
This is another comment.
-->
@ -500,7 +519,7 @@ Code block:
Just plain comment, with trailing spaces on the line:
#+BEGIN_HTML
<!-- foo -->
<!-- foo -->
#+END_HTML
Code:
@ -513,21 +532,37 @@ Hr's:
#+BEGIN_HTML
<hr>
#+END_HTML
#+BEGIN_HTML
<hr />
#+END_HTML
#+BEGIN_HTML
<hr />
#+END_HTML
<hr>
#+BEGIN_HTML
<hr>
#+END_HTML
<hr />
#+BEGIN_HTML
<hr />
#+END_HTML
<hr />
#+BEGIN_HTML
<hr />
#+END_HTML
#+BEGIN_HTML
<hr class="foo" id="bar" />
#+END_HTML
#+BEGIN_HTML
<hr class="foo" id="bar" />
#+END_HTML
#+BEGIN_HTML
<hr class="foo" id="bar">
#+END_HTML

View file

@ -432,7 +432,13 @@ Interpreted markdown in a table:
.. raw:: html
<table>
.. raw:: html
<tr>
.. raw:: html
<td>
This is *emphasized*
@ -440,6 +446,9 @@ This is *emphasized*
.. raw:: html
</td>
.. raw:: html
<td>
And this is **strong**
@ -447,9 +456,17 @@ And this is **strong**
.. raw:: html
</td>
.. raw:: html
</tr>
.. raw:: html
</table>
.. raw:: html
<script type="text/javascript">document.write('This *should not* be interpreted as markdown');</script>
Heres a simple block:
@ -521,6 +538,8 @@ Multiline:
Blah
-->
.. raw:: html
<!--
This is another comment.
-->
@ -535,7 +554,7 @@ Just plain comment, with trailing spaces on the line:
.. raw:: html
<!-- foo -->
<!-- foo -->
Code:
@ -549,20 +568,36 @@ Hrs:
<hr>
<hr />
.. raw:: html
<hr />
<hr>
.. raw:: html
<hr />
<hr />
<hr />
.. raw:: html
<hr>
.. raw:: html
<hr />
.. raw:: html
<hr />
.. raw:: html
<hr class="foo" id="bar" />
.. raw:: html
<hr class="foo" id="bar" />
.. raw:: html
<hr class="foo" id="bar">
--------------

View file

@ -393,9 +393,7 @@ And this is *strong*
</td>
</tr>
</table>
<script type="text/javascript">document.write('This *should not* be interpreted as markdown');</script>
Here's a simple block:
<div>
@ -437,18 +435,15 @@ foo
This should just be an HTML comment:
<!-- Comment -->
Multiline:
<!--
Blah
Blah
-->
<!--
This is another comment.
-->
Code block:
bc. <!-- Comment -->
@ -456,8 +451,7 @@ bc. <!-- Comment -->
Just plain comment, with trailing spaces on the line:
<!-- foo -->
<!-- foo -->
Code:
bc. <hr />
@ -466,23 +460,14 @@ bc. <hr />
Hr's:
<hr>
<hr />
<hr />
<hr>
<hr />
<hr />
<hr>
<hr />
<hr />
<hr class="foo" id="bar" />
<hr class="foo" id="bar" />
<hr class="foo" id="bar">
<hr />
h1(#inline-markup). Inline Markup