Merged changes from 'quotes' branch since r431. Smart typography

is now handled in the Markdown and LaTeX readers, rather than in
the writers.  The HTML writer has been rewritten to use the
prettyprinting library.


git-svn-id: https://pandoc.googlecode.com/svn/trunk@436 788f1e2b-df1e-0410-8736-df70ead52e1b
This commit is contained in:
fiddlosopher 2007-01-06 09:54:58 +00:00
parent 06e6107f53
commit bb8478e4e2
31 changed files with 1250 additions and 1297 deletions

6
README
View file

@ -262,9 +262,11 @@ in the title as it appears at the beginning of the HTML body). (See
below on Titles.)
`-S` or `--smart` causes `pandoc` to produce typographically
correct HTML output, along the lines of John Gruber's [Smartypants].
correct output, along the lines of John Gruber's [Smartypants].
Straight quotes are converted to curly quotes, `---` to dashes, and
`...` to ellipses.
`...` to ellipses. (Note: This option is only significant when
the input format is `markdown`. It is selected automatically
when the output format is `latex`.)
[Smartypants]: http://daringfireball.net/projects/smartypants/

12
debian/changelog vendored
View file

@ -79,6 +79,8 @@ pandoc (0.3) unstable; urgency=low
of the next line.
+ Fixed bug in text-wrapping routine in Markdown and RST writers.
Now LineBreaks no longer cause wrapping problems.
+ Fixed bug with inline Code in Markdown writer. Now it's guaranteed
that enough `'s will be used, depending on the content.
* Made handling of code blocks more consistent. Previously, some
readers allowed trailing newlines, while others stripped them.
@ -108,9 +110,13 @@ pandoc (0.3) unstable; urgency=low
+ Process quotes before dashes. This way (foo -- 'bar') will turn into
(foo---`bar') instead of (foo---'bar').
* Improved handling of smart quotes in HTML and LaTeX writers, to
handle cases where latex commands or HTML entity references appear
after quotes.
* Moved handling of "smart typography" from the writers to the Markdown
and LaTeX readers. This allows great simplification of the writers
and more accurate smart quotes, dashes, and ellipses. DocBook can
now use '<quote>'. The '--smart' option now toggles an option in
the parser state rather than a writer option. Several new kinds
of inline elements have been added: Quoted, Ellipses, Apostrophe,
EmDash, EnDash.
* Changes in HTML writer:
+ Include title block in header even when title is null.

View file

@ -108,8 +108,10 @@ Use strict markdown syntax, with no extensions or variants.
Parse untranslatable HTML codes and LaTeX environments as raw HTML
or LaTeX, instead of ignoring them.
.TP
.B \-S, \-\-smartypants
Use smart quotes, dashes, and ellipses in HTML output.
.B \-S, \-\-smart
Use smart quotes, dashes, and ellipses. (This option is significant
only when the input format is \fBmarkdown\fR. It is selected automatically
when the output format is \fBlatex\fR.)
.TP
.B \-m, \-\-asciimathml
Use ASCIIMathML to display embedded LaTeX math in HTML output.

View file

@ -190,7 +190,7 @@ options =
, Option "S" ["smart"]
(NoArg
(\opt -> return opt { optSmart = True }))
"" -- "Use smart quotes, dashes, and ellipses in HTML output"
"" -- "Use smart quotes, dashes, and ellipses"
, Option "m" ["asciimathml"]
(NoArg
@ -423,6 +423,8 @@ main = do
defaultParserState { stateParseRaw = parseRaw,
stateTabStop = tabStop,
stateStandalone = standalone && (not strict),
stateSmart = (smart && (not strict)) ||
writerName' == "latex",
stateStrict = strict }
let csslink = if (css == "")
then ""
@ -437,8 +439,6 @@ main = do
(not strict),
writerHeader = header,
writerTitlePrefix = titlePrefix,
writerSmart = smart &&
(not strict),
writerTabStop = tabStop,
writerNotes = [],
writerS5 = (writerName=="s5"),

View file

@ -65,13 +65,21 @@ data Target
| Ref [Inline] -- ^ Label (list of inlines) for an indirect ref
deriving (Show, Eq, Read)
-- | Type of quotation marks to use in Quoted inline.
data QuoteType = SingleQuote | DoubleQuote deriving (Show, Eq, Read)
-- | Inline elements.
data Inline
= Str String -- ^ Text (string)
| Emph [Inline] -- ^ Emphasized text (list of inlines)
| Strong [Inline] -- ^ Strongly emphasized text (list of inlines)
| Quoted QuoteType [Inline] -- ^ Quoted text (list of inlines)
| Code String -- ^ Inline code (literal)
| Space -- ^ Inter-word space
| EmDash -- ^ Em dash
| EnDash -- ^ En dash
| Apostrophe -- ^ Apostrophe
| Ellipses -- ^ Ellipses
| LineBreak -- ^ Hard line break
| TeX String -- ^ LaTeX code (literal)
| HtmlInline String -- ^ HTML code (literal)

View file

@ -32,14 +32,19 @@ module Text.Pandoc.Entities (
entityToChar,
charToEntity,
decodeEntities,
encodeEntities
encodeEntities,
characterEntity
) where
import Data.Char ( chr, ord )
import Text.Regex ( mkRegex, matchRegexAll )
import Text.Regex ( mkRegex, matchRegexAll, Regex )
import Maybe ( fromMaybe )
-- regexs for entities
-- | Regular expression for decimal coded entity.
decimalCodedEntity :: Text.Regex.Regex
decimalCodedEntity = mkRegex "&#([0-9]+);"
-- | Regular expression for character entity.
characterEntity :: Text.Regex.Regex
characterEntity = mkRegex "&#[0-9]+;|&[A-Za-z0-9]+;"
-- | Return a string with all entity references decoded to unicode characters

View file

@ -50,23 +50,12 @@ readLaTeX = readWith parseLaTeX
testString = testStringWith parseLaTeX
-- characters with special meaning
specialChars = "\\$%&^&_~#{}\n \t|<>"
specialChars = "\\$%&^&_~#{}\n \t|<>'\"-"
--
-- utility functions
--
-- | Change quotation marks in a string back to "basic" quotes.
normalizeQuotes :: String -> String
normalizeQuotes = gsub "''" "\"" . gsub "`" "'"
-- | Change LaTeX En dashes between digits to hyphens.
normalizeDashes :: String -> String
normalizeDashes = gsub "([0-9])--([0-9])" "\\1-\\2"
normalizePunctuation :: String -> String
normalizePunctuation = normalizeDashes . normalizeQuotes
-- | Returns text between brackets and its matching pair.
bracketedText openB closeB = try (do
char openB
@ -132,10 +121,10 @@ anyEnvironment = try (do
--
-- | Process LaTeX preamble, extracting metadata.
processLaTeXPreamble = do
processLaTeXPreamble = try (do
manyTill (choice [bibliographic, comment, unknownCommand, nullBlock])
(try (string "\\begin{document}"))
spaces
spaces)
-- | Parse LaTeX and return 'Pandoc'.
parseLaTeX = do
@ -392,16 +381,13 @@ comment = try (do
-- inline
--
inline = choice [ strong, emph, ref, lab, code, linebreak, math, ldots,
inline = choice [ strong, emph, ref, lab, code, linebreak, math, ellipses,
emDash, enDash, hyphen, quoted, apostrophe,
accentedChar, specialChar, specialInline, escapedChar,
unescapedChar, str, endline, whitespace ] <?> "inline"
specialInline = choice [ link, image, footnote, rawLaTeXInline ] <?>
"link, raw TeX, note, or image"
ldots = try (do
string "\\ldots"
return (Str "..."))
specialInline = choice [ link, image, footnote, rawLaTeXInline ]
<?> "link, raw TeX, note, or image"
accentedChar = normalAccentedChar <|> specialAccentedChar
@ -526,6 +512,49 @@ emph = try (do
result <- manyTill inline (char '}')
return (Emph result))
apostrophe = do
char '\''
return Apostrophe
quoted = do
doubleQuoted <|> singleQuoted
singleQuoted = try (do
result <- enclosed singleQuoteStart singleQuoteEnd inline
return $ Quoted SingleQuote $ normalizeSpaces result)
doubleQuoted = try (do
result <- enclosed doubleQuoteStart doubleQuoteEnd inline
return $ Quoted DoubleQuote $ normalizeSpaces result)
singleQuoteStart = char '`'
singleQuoteEnd = try (do
char '\''
notFollowedBy alphaNum)
doubleQuoteStart = try (string "``")
doubleQuoteEnd = try (string "''")
ellipses = try (do
string "\\ldots"
option "" (string "{}")
return Ellipses)
enDash = try (do
string "--"
notFollowedBy (char '-')
return EnDash)
emDash = try (do
string "---"
return EmDash)
hyphen = do
char '-'
return (Str "-")
lab = try (do
string "\\label{"
result <- manyTill anyChar (char '}')
@ -552,7 +581,7 @@ linebreak = try (do
str = do
result <- many1 (noneOf specialChars)
return (Str (normalizePunctuation result))
return (Str result)
-- endline internal to paragraph
endline = try (do
@ -624,3 +653,4 @@ rawLaTeXInline = try (do
then fail "not an inline command"
else string ""
return (TeX ("\\" ++ name ++ star ++ argStr)))

View file

@ -86,12 +86,13 @@ titleOpeners = "\"'("
setextHChars = ['=','-']
blockQuoteChar = '>'
hyphenChar = '-'
ellipsesChar = '.'
-- treat these as potentially non-text when parsing inline:
specialChars = [escapeChar, labelStart, labelEnd, emphStart, emphEnd,
emphStartAlt, emphEndAlt, codeStart, codeEnd, autoLinkEnd,
autoLinkStart, mathStart, mathEnd, imageStart, noteStart,
hyphenChar]
hyphenChar, ellipsesChar] ++ quoteChars
--
-- auxiliary functions
@ -120,6 +121,11 @@ failUnlessBeginningOfLine = do
pos <- getPosition
if sourceColumn pos == 1 then return () else fail "not beginning of line"
-- | Fail unless we're in "smart typography" mode.
failUnlessSmart = do
state <- getState
if stateSmart state then return () else fail "Smart typography feature"
--
-- document structure
--
@ -519,11 +525,11 @@ rawLaTeXEnvironment' = do
-- inline
--
text = choice [ math, strong, emph, code, str, linebreak, tabchar,
whitespace, endline ] <?> "text"
text = choice [ escapedChar, math, strong, emph, smartPunctuation,
code, ltSign, symbol,
str, linebreak, tabchar, whitespace, endline ] <?> "text"
inline = choice [ rawLaTeXInline', escapedChar, special, hyphens, text,
ltSign, symbol ] <?> "inline"
inline = choice [ rawLaTeXInline', escapedChar, special, text ] <?> "inline"
special = choice [ noteRef, inlineNote, link, referenceLink, rawHtmlInline',
autoLink, image ] <?> "link, inline html, note, or image"
@ -531,6 +537,7 @@ special = choice [ noteRef, inlineNote, link, referenceLink, rawHtmlInline',
escapedChar = escaped anyChar
ltSign = try (do
notFollowedBy (noneOf "<") -- continue only if it's a <
notFollowedBy' rawHtmlBlocks -- don't return < if it starts html
char '<'
return (Str ['<']))
@ -541,13 +548,6 @@ symbol = do
result <- oneOf specialCharsMinusLt
return (Str [result])
hyphens = try (do
result <- many1 (char '-')
if (length result) == 1
then skipEndline -- don't want to treat endline after hyphen as a space
else do{ string ""; return Space }
return (Str result))
-- parses inline code, between n codeStarts and n codeEnds
code = try (do
starts <- many1 (char codeStart)
@ -583,6 +583,56 @@ strong = do
(count 2 (char emphEndAlt)) inline) ]
return (Strong (normalizeSpaces result))
smartPunctuation = do
failUnlessSmart
choice [ quoted, apostrophe, dash, ellipses ]
apostrophe = do
char '\'' <|> char '\8217'
return Apostrophe
quoted = do
doubleQuoted <|> singleQuoted
singleQuoted = try (do
result <- enclosed singleQuoteStart singleQuoteEnd
(do{notFollowedBy' singleQuoted; inline} <|> apostrophe)
return $ Quoted SingleQuote $ normalizeSpaces result)
doubleQuoted = try (do
result <- enclosed doubleQuoteStart doubleQuoteEnd inline
return $ Quoted DoubleQuote $ normalizeSpaces result)
singleQuoteStart = try (do
char '\'' <|> char '\8216'
notFollowedBy' whitespace)
singleQuoteEnd = try (do
oneOfStrings ["'", "\8217"]
notFollowedBy alphaNum)
doubleQuoteStart = char '"' <|> char '\8220'
doubleQuoteEnd = char '"' <|> char '\8221'
ellipses = try (do
oneOfStrings ["...", " . . . ", ". . .", " . . ."]
return Ellipses)
dash = enDash <|> emDash
enDash = try (do
char '-'
followedBy' (many1 digit)
return EnDash)
emDash = try (do
skipSpaces
oneOfStrings ["---", "--"]
skipSpaces
option ' ' newline
return EmDash)
whitespace = do
many1 (oneOf spaceChars) <?> "whitespace"
return Space

View file

@ -52,7 +52,6 @@ module Text.Pandoc.Shared (
-- * Native format prettyprinting
prettyPandoc,
-- * Pandoc block list processing
consolidateList,
isNoteBlock,
normalizeSpaces,
compactify,
@ -74,7 +73,7 @@ module Text.Pandoc.Shared (
) where
import Text.Pandoc.Definition
import Text.ParserCombinators.Parsec
import Text.Pandoc.Entities ( decodeEntities, encodeEntities )
import Text.Pandoc.Entities ( decodeEntities, encodeEntities, characterEntity )
import Text.Regex ( matchRegexAll, mkRegex, subRegex, Regex )
import Text.PrettyPrint.HughesPJ as PP ( text, char, (<>), ($$), nest, Doc,
isEmpty )
@ -125,6 +124,7 @@ data ParserState = ParserState
stateAuthors :: [String], -- ^ Authors of document
stateDate :: String, -- ^ Date of document
stateStrict :: Bool, -- ^ Use strict markdown syntax
stateSmart :: Bool, -- ^ Use smart typography
stateHeaderTable :: [HeaderType] -- ^ List of header types used,
-- in what order (rst only)
}
@ -144,19 +144,9 @@ defaultParserState =
stateAuthors = [],
stateDate = [],
stateStrict = False,
stateSmart = False,
stateHeaderTable = [] }
-- | Consolidate @Str@s and @Space@s in an inline list into one big @Str@.
-- Collapse adjacent @Space@s.
consolidateList :: [Inline] -> [Inline]
consolidateList ((Str a):(Str b):rest) = consolidateList ((Str (a ++ b)):rest)
consolidateList ((Str a):Space:Space:rest) = consolidateList ((Str a):Space:rest)
consolidateList ((Str a):Space:rest) = consolidateList ((Str (a ++ " ")):rest)
consolidateList (Space:(Str a):rest) = consolidateList ((Str (" " ++ a)):rest)
consolidateList (Space:Space:rest) = consolidateList ((Str " "):rest)
consolidateList (inline:rest) = inline:(consolidateList rest)
consolidateList [] = []
-- | Indent string as a block.
indentBy :: Int -- ^ Number of spaces to indent the block
-> Int -- ^ Number of spaces (rel to block) to indent first line
@ -341,7 +331,6 @@ data WriterOptions = WriterOptions
, writerHeader :: String -- ^ Header for the document
, writerIncludeBefore :: String -- ^ String to include before the body
, writerIncludeAfter :: String -- ^ String to include after the body
, writerSmart :: Bool -- ^ Use smart typography
, writerS5 :: Bool -- ^ We're writing S5
, writerIncremental :: Bool -- ^ Incremental S5 lists
, writerNumberSections :: Bool -- ^ Number sections in LaTeX
@ -463,6 +452,8 @@ refsMatch ((Emph x):restx) ((Emph y):resty) =
refsMatch x y && refsMatch restx resty
refsMatch ((Strong x):restx) ((Strong y):resty) =
refsMatch x y && refsMatch restx resty
refsMatch ((Quoted t x):restx) ((Quoted u y):resty) =
t == u && refsMatch x y && refsMatch restx resty
refsMatch (x:restx) (y:resty) = (x == y) && refsMatch restx resty
refsMatch [] x = null x
refsMatch x [] = null x
@ -517,48 +508,14 @@ replaceRefLinksInline keytable (Emph lst) =
Emph (map (replaceRefLinksInline keytable) lst)
replaceRefLinksInline keytable (Strong lst) =
Strong (map (replaceRefLinksInline keytable) lst)
replaceRefLinksInline keytable (Quoted t lst) =
Quoted t (map (replaceRefLinksInline keytable) lst)
replaceRefLinksInline keytable other = other
-- | Escape string, preserving character entities and quote, and adding
-- smart typography if specified.
stringToSGML :: WriterOptions -> String -> String
stringToSGML options =
let escapeDoubleQuotes =
gsub "(\"|&quot;)" "&rdquo;" . -- rest are right quotes
gsub "(\"|&quot;)(&r[sd]quo;)" "&rdquo;\\2" .
-- never left quo before right quo
gsub "(&l[sd]quo;)(\"|&quot;)" "\\2&ldquo;" .
-- never right quo after left quo
gsub "([ \t])(\"|&quot;)" "\\1&ldquo;" .
-- never right quo after space
gsub "(\"|&quot;)([^,.;:!?^) \t-])" "&ldquo;\\2" . -- "word left
gsub "(\"|&quot;)('|`|&lsquo;)" "&rdquo;&rsquo;" .
-- right if it got through last filter
gsub "(\"|&quot;)('|`|&lsquo;)([^,.;:!?^) \t-])" "&ldquo;&lsquo;\\3" .
-- "'word left
gsub "``" "&ldquo;" .
gsub "''" "&rdquo;"
escapeSingleQuotes =
gsub "'" "&rsquo;" . -- otherwise right
gsub "'(&r[sd]quo;)" "&rsquo;\\1" . -- never left quo before right quo
gsub "(&l[sd]quo;)'" "\\1&lsquo;" . -- never right quo after left quo
gsub "([ \t])'" "\\1&lsquo;" . -- never right quo after space
gsub "`" "&lsquo;" . -- ` is left
gsub "([^,.;:!?^) \t-])'" "\\1&rsquo;" . -- word' right
gsub "^('|`)([^,.;:!?^) \t-])" "&lsquo;\\2" . -- 'word left
gsub "('|`)(\"|&quot;|&ldquo;|``)" "&lsquo;&ldquo;" . -- '"word left
gsub "([^,.;:!?^) \t-])'(s|S)" "\\1&rsquo;\\2" . -- possessive
gsub "([[:space:]])'([^,.;:!?^) \t-])" "\\1&lsquo;\\2" . -- 'word left
gsub "'([0-9][0-9](s|S))" "&rsquo;\\1" -- '80s - decade abbrevs.
escapeDashes =
gsub " ?-- ?" "&mdash;" .
gsub " ?--- ?" "&mdash;" .
gsub "([0-9])--?([0-9])" "\\1&ndash;\\2"
escapeEllipses = gsub "\\.\\.\\.|\\. \\. \\." "&hellip;"
smartFilter = escapeSingleQuotes . escapeDoubleQuotes . escapeDashes .
escapeEllipses in
encodeEntities . (if (writerSmart options) then smartFilter else id) .
(escapePreservingRegex escapeSGML (mkRegex "&[[:alnum:]]*;"))
-- | Escape string, preserving character entities.
stringToSGML :: String -> String
stringToSGML =
encodeEntities . (escapePreservingRegex escapeSGML characterEntity)
-- | Escape string as needed for HTML. Entity references are not preserved.
escapeSGML :: String -> String
@ -571,16 +528,15 @@ escapeSGML (x:xs) = case x of
_ -> x:(escapeSGML xs)
-- | Return a text object with a string of formatted SGML attributes.
attributeList :: WriterOptions -> [(String, String)] -> Doc
attributeList options =
text . concatMap (\(a, b) -> " " ++ stringToSGML options a ++ "=\"" ++
stringToSGML options b ++ "\"")
attributeList :: [(String, String)] -> Doc
attributeList = text . concatMap
(\(a, b) -> " " ++ stringToSGML a ++ "=\"" ++ stringToSGML b ++ "\"")
-- | Put the supplied contents between start and end tags of tagType,
-- with specified attributes and (if specified) indentation.
inTags:: Bool -> WriterOptions -> String -> [(String, String)] -> Doc -> Doc
inTags isIndented options tagType attribs contents =
let openTag = PP.char '<' <> text tagType <> attributeList options attribs <>
inTags:: Bool -> String -> [(String, String)] -> Doc -> Doc
inTags isIndented tagType attribs contents =
let openTag = PP.char '<' <> text tagType <> attributeList attribs <>
PP.char '>'
closeTag = text "</" <> text tagType <> PP.char '>' in
if isIndented
@ -588,15 +544,15 @@ inTags isIndented options tagType attribs contents =
else openTag <> contents <> closeTag
-- | Return a self-closing tag of tagType with specified attributes
selfClosingTag :: WriterOptions -> String -> [(String, String)] -> Doc
selfClosingTag options tagType attribs =
PP.char '<' <> text tagType <> attributeList options attribs <> text " />"
selfClosingTag :: String -> [(String, String)] -> Doc
selfClosingTag tagType attribs =
PP.char '<' <> text tagType <> attributeList attribs <> text " />"
-- | Put the supplied contents between start and end tags of tagType.
inTagsSimple :: WriterOptions -> String -> Doc -> Doc
inTagsSimple options tagType = inTags False options tagType []
inTagsSimple :: String -> Doc -> Doc
inTagsSimple tagType = inTags False tagType []
-- | Put the supplied contents in indented block btw start and end tags.
inTagsIndented :: WriterOptions -> String -> Doc -> Doc
inTagsIndented options tagType = inTags True options tagType []
inTagsIndented :: String -> Doc -> Doc
inTagsIndented tagType = inTags True tagType []

View file

@ -59,14 +59,14 @@ hierarchicalize (block:rest) =
x -> (Blk x):(hierarchicalize rest)
-- | Convert list of authors to a docbook <author> section
authorToDocbook :: WriterOptions -> [Char] -> Doc
authorToDocbook opts name = inTagsIndented opts "author" $
authorToDocbook :: [Char] -> Doc
authorToDocbook name = inTagsIndented "author" $
if ',' `elem` name
then -- last name first
let (lastname, rest) = break (==',') name
firstname = removeLeadingSpace rest in
inTagsSimple opts "firstname" (text $ stringToSGML opts firstname) <>
inTagsSimple opts "surname" (text $ stringToSGML opts lastname)
inTagsSimple "firstname" (text $ stringToSGML firstname) <>
inTagsSimple "surname" (text $ stringToSGML lastname)
else -- last name last
let namewords = words name
lengthname = length namewords
@ -74,8 +74,8 @@ authorToDocbook opts name = inTagsIndented opts "author" $
0 -> ("","")
1 -> ("", name)
n -> (joinWithSep " " (take (n-1) namewords), last namewords) in
inTagsSimple opts "firstname" (text $ stringToSGML opts firstname) $$
inTagsSimple opts "surname" (text $ stringToSGML opts lastname)
inTagsSimple "firstname" (text $ stringToSGML firstname) $$
inTagsSimple "surname" (text $ stringToSGML lastname)
-- | Convert Pandoc document to string in Docbook format.
writeDocbook :: WriterOptions -> Pandoc -> String
@ -84,22 +84,24 @@ writeDocbook opts (Pandoc (Meta title authors date) blocks) =
then text (writerHeader opts)
else empty
meta = if (writerStandalone opts)
then inTagsIndented opts "articleinfo" $
(inTagsSimple opts "title" (inlinesToDocbook opts title)) $$
(vcat (map (authorToDocbook opts) authors)) $$
(inTagsSimple opts "date" (text $ stringToSGML opts date))
then inTagsIndented "articleinfo" $
(inTagsSimple "title" (wrap opts title)) $$
(vcat (map authorToDocbook authors)) $$
(inTagsSimple "date" (text $ stringToSGML date))
else empty
blocks' = replaceReferenceLinks blocks
(noteBlocks, blocks'') = partition isNoteBlock blocks'
opts' = opts {writerNotes = noteBlocks}
elements = hierarchicalize blocks''
body = text (writerIncludeBefore opts') <>
before = writerIncludeBefore opts'
after = writerIncludeAfter opts'
body = (if null before then empty else text before) $$
vcat (map (elementToDocbook opts') elements) $$
text (writerIncludeAfter opts')
(if null after then empty else text after)
body' = if writerStandalone opts'
then inTagsIndented opts "article" (meta $$ body)
then inTagsIndented "article" (meta $$ body)
else body in
render $ head $$ body' <> text "\n"
render $ head $$ body' $$ text ""
-- | Convert an Element to Docbook.
elementToDocbook :: WriterOptions -> Element -> Doc
@ -109,8 +111,8 @@ elementToDocbook opts (Sec title elements) =
let elements' = if null elements
then [Blk (Para [])]
else elements in
inTagsIndented opts "section" $
inTagsSimple opts "title" (wrap opts title) $$
inTagsIndented "section" $
inTagsSimple "title" (wrap opts title) $$
vcat (map (elementToDocbook opts) elements')
-- | Convert a list of Pandoc blocks to Docbook.
@ -128,7 +130,7 @@ listItemToDocbook opts item =
let plainToPara (Plain x) = Para x
plainToPara y = y in
let item' = map plainToPara item in
inTagsIndented opts "listitem" (blocksToDocbook opts item')
inTagsIndented "listitem" (blocksToDocbook opts item')
-- | Convert a Pandoc block element to Docbook.
blockToDocbook :: WriterOptions -> Block -> Doc
@ -136,20 +138,20 @@ blockToDocbook opts Blank = text ""
blockToDocbook opts Null = empty
blockToDocbook opts (Plain lst) = wrap opts lst
blockToDocbook opts (Para lst) =
inTagsIndented opts "para" (wrap opts lst)
inTagsIndented "para" (wrap opts lst)
blockToDocbook opts (BlockQuote blocks) =
inTagsIndented opts "blockquote" (blocksToDocbook opts blocks)
inTagsIndented "blockquote" (blocksToDocbook opts blocks)
blockToDocbook opts (CodeBlock str) =
text "<screen>\n" <> text (escapeSGML str) <> text "\n</screen>"
blockToDocbook opts (BulletList lst) =
inTagsIndented opts "itemizedlist" $ listItemsToDocbook opts lst
inTagsIndented "itemizedlist" $ listItemsToDocbook opts lst
blockToDocbook opts (OrderedList lst) =
inTagsIndented opts "orderedlist" $ listItemsToDocbook opts lst
inTagsIndented "orderedlist" $ listItemsToDocbook opts lst
blockToDocbook opts (RawHtml str) = text str -- raw XML block
blockToDocbook opts HorizontalRule = empty -- not semantic
blockToDocbook opts (Note _ _) = empty -- shouldn't occur
blockToDocbook opts (Key _ _) = empty -- shouldn't occur
blockToDocbook opts _ = inTagsIndented opts "para" (text "Unknown block type")
blockToDocbook opts _ = inTagsIndented "para" (text "Unknown block type")
-- | Put string in CDATA section
cdata :: String -> Doc
@ -165,14 +167,20 @@ inlinesToDocbook opts lst = hcat (map (inlineToDocbook opts) lst)
-- | Convert an inline element to Docbook.
inlineToDocbook :: WriterOptions -> Inline -> Doc
inlineToDocbook opts (Str str) = text $ stringToSGML opts str
inlineToDocbook opts (Str str) = text $ stringToSGML str
inlineToDocbook opts (Emph lst) =
inTagsSimple opts "emphasis" (inlinesToDocbook opts lst)
inTagsSimple "emphasis" (inlinesToDocbook opts lst)
inlineToDocbook opts (Strong lst) =
inTags False opts "emphasis" [("role", "strong")]
inTags False "emphasis" [("role", "strong")]
(inlinesToDocbook opts lst)
inlineToDocbook opts (Quoted _ lst) =
inTagsSimple "quote" (inlinesToDocbook opts lst)
inlineToDocbook opts Apostrophe = text "&apos;"
inlineToDocbook opts Ellipses = text "&hellip;"
inlineToDocbook opts EmDash = text "&mdash;"
inlineToDocbook opts EnDash = text "&ndash;"
inlineToDocbook opts (Code str) =
inTagsSimple opts "literal" $ text (escapeSGML str)
inTagsSimple "literal" $ text (escapeSGML str)
inlineToDocbook opts (TeX str) = inlineToDocbook opts (Code str)
inlineToDocbook opts (HtmlInline str) = empty
inlineToDocbook opts LineBreak =
@ -180,19 +188,19 @@ inlineToDocbook opts LineBreak =
inlineToDocbook opts Space = char ' '
inlineToDocbook opts (Link txt (Src src tit)) =
case (matchRegex (mkRegex "mailto:(.*)") src) of
Just [addr] -> inTagsSimple opts "email" $ text (escapeSGML addr)
Nothing -> inTags False opts "ulink" [("url", src)] $
Just [addr] -> inTagsSimple "email" $ text (escapeSGML addr)
Nothing -> inTags False "ulink" [("url", src)] $
inlinesToDocbook opts txt
inlineToDocbook opts (Link text (Ref ref)) = empty -- shouldn't occur
inlineToDocbook opts (Image alt (Src src tit)) =
let titleDoc = if null tit
then empty
else inTagsIndented opts "objectinfo" $
inTagsIndented opts "title"
(text $ stringToSGML opts tit) in
inTagsIndented opts "inlinemediaobject" $
inTagsIndented opts "imageobject" $
titleDoc $$ selfClosingTag opts "imagedata" [("fileref", src)]
else inTagsIndented "objectinfo" $
inTagsIndented "title"
(text $ stringToSGML tit) in
inTagsIndented "inlinemediaobject" $
inTagsIndented "imageobject" $
titleDoc $$ selfClosingTag "imagedata" [("fileref", src)]
inlineToDocbook opts (Image alternate (Ref ref)) = empty --shouldn't occur
inlineToDocbook opts (NoteRef ref) =
let notes = writerNotes opts
@ -200,4 +208,4 @@ inlineToDocbook opts (NoteRef ref) =
if null hits
then empty
else let (Note _ contents) = head hits in
inTagsIndented opts "footnote" $ blocksToDocbook opts contents
inTagsIndented "footnote" $ blocksToDocbook opts contents

View file

@ -37,48 +37,53 @@ import Text.Regex ( mkRegex, matchRegex )
import Numeric ( showHex )
import Data.Char ( ord, toLower )
import Data.List ( isPrefixOf, partition )
import Text.PrettyPrint.HughesPJ hiding ( Str )
-- | Convert Pandoc document to string in HTML format.
writeHtml :: WriterOptions -> Pandoc -> String
writeHtml options (Pandoc (Meta title authors date) blocks) =
let titlePrefix = writerTitlePrefix options in
writeHtml opts (Pandoc (Meta title authors date) blocks) =
let titlePrefix = writerTitlePrefix opts in
let topTitle = if not (null titlePrefix)
then [Str titlePrefix] ++ (if not (null title)
then [Str " - "] ++ title
else [])
else title in
let head = if (writerStandalone options)
then htmlHeader options (Meta topTitle authors date)
else ""
titleBlocks = if (writerStandalone options) && (not (null title)) &&
(not (writerS5 options))
let head = if (writerStandalone opts)
then htmlHeader opts (Meta topTitle authors date)
else empty
titleBlocks = if (writerStandalone opts) && (not (null title)) &&
(not (writerS5 opts))
then [RawHtml "<h1 class=\"title\">", Plain title,
RawHtml "</h1>\n"]
RawHtml "</h1>"]
else []
foot = if (writerStandalone options) then "</body>\n</html>\n" else ""
foot = if (writerStandalone opts)
then text "</body>\n</html>"
else empty
blocks' = replaceReferenceLinks (titleBlocks ++ blocks)
(noteBlocks, blocks'') = partition isNoteBlock blocks'
body = (writerIncludeBefore options) ++
concatMap (blockToHtml options) blocks'' ++
footnoteSection options noteBlocks ++
(writerIncludeAfter options) in
head ++ body ++ foot
before = writerIncludeBefore opts
after = writerIncludeAfter opts
body = (if null before then empty else text before) $$
vcat (map (blockToHtml opts) blocks'') $$
footnoteSection opts noteBlocks $$
(if null after then empty else text after) in
render $ head $$ body $$ foot $$ text ""
-- | Convert list of Note blocks to a footnote <div>.
-- Assumes notes are sorted.
footnoteSection :: WriterOptions -> [Block] -> String
footnoteSection options notes =
footnoteSection :: WriterOptions -> [Block] -> Doc
footnoteSection opts notes =
if null notes
then ""
else "<div class=\"footnotes\">\n<hr />\n<ol>\n" ++
concatMap (blockToHtml options) notes ++
"</ol>\n</div>\n"
then empty
else inTags True "div" [("class","footnotes")] $
selfClosingTag "hr" [] $$ (inTagsIndented "ol"
(vcat $ map (blockToHtml opts) notes))
-- | Obfuscate a "mailto:" link using Javascript.
obfuscateLink :: WriterOptions -> [Inline] -> String -> String
obfuscateLink options text src =
obfuscateLink :: WriterOptions -> [Inline] -> String -> Doc
obfuscateLink opts txt src =
let emailRegex = mkRegex "mailto:*([^@]*)@(.*)"
text' = inlineListToHtml options text
text' = render $ inlineListToHtml opts txt
src' = map toLower src in
case (matchRegex emailRegex src') of
(Just [name, domain]) ->
@ -91,16 +96,17 @@ obfuscateLink options text src =
then name ++ " at " ++ domain'
else text' ++ " (" ++ name ++ " at " ++
domain' ++ ")" in
if writerStrictMarkdown options
then "<a href=\"" ++ obfuscateString src' ++ "\">" ++
obfuscateString text' ++ "</a>"
else "<script type=\"text/javascript\">\n<!--\nh='" ++
if writerStrictMarkdown opts
then inTags False "a" [("href", obfuscateString src')] $
text $ obfuscateString text'
else inTags False "script" [("type", "text/javascript")]
(text ("\n<!--\nh='" ++
obfuscateString domain ++ "';a='" ++ at' ++ "';n='" ++
obfuscateString name ++ "';e=n+a+h;\n" ++
"document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\">'+" ++
linkText ++ "+'<\\/'+'a'+'>');\n// -->\n</script><noscript>" ++
obfuscateString altText ++ "</noscript>"
_ -> "<a href=\"" ++ src ++ "\">" ++ text' ++ "</a>" -- malformed email
linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) <>
inTagsSimple "noscript" (text (obfuscateString altText))
_ -> inTags False "a" [("href", src)] (text text') -- malformed email
-- | Obfuscate character as entity.
obfuscateChar :: Char -> String
@ -113,117 +119,123 @@ obfuscateChar char =
obfuscateString :: String -> String
obfuscateString = concatMap obfuscateChar
-- | Returns an HTML header with appropriate bibliographic information.
htmlHeader :: WriterOptions -> Meta -> String
htmlHeader options (Meta title authors date) =
let titletext = "<title>" ++ (inlineListToHtml options title) ++
"</title>\n"
-- | Return an HTML header with appropriate bibliographic information.
htmlHeader :: WriterOptions -> Meta -> Doc
htmlHeader opts (Meta title authors date) =
let titletext = inTagsSimple "title" (wrap opts title)
authortext = if (null authors)
then ""
else "<meta name=\"author\" content=\"" ++
(joinWithSep ", " (map (stringToSGML options) authors)) ++
"\" />\n"
then empty
else selfClosingTag "meta" [("name", "author"),
("content",
joinWithSep ", " (map stringToSGML authors))]
datetext = if (date == "")
then ""
else "<meta name=\"date\" content=\"" ++
(stringToSGML options date) ++ "\" />\n" in
(writerHeader options) ++ authortext ++ datetext ++ titletext ++
"</head>\n<body>\n"
then empty
else selfClosingTag "meta" [("name", "date"),
("content", stringToSGML date)] in
text (writerHeader opts) $$ authortext $$ datetext $$ titletext $$
text "</head>\n<body>"
-- | Take list of inline elements and return wrapped doc.
wrap :: WriterOptions -> [Inline] -> Doc
wrap opts lst = fsep $ map (inlineListToHtml opts) (splitBy Space lst)
-- | Convert Pandoc block element to HTML.
blockToHtml :: WriterOptions -> Block -> String
blockToHtml options Blank = "\n"
blockToHtml options Null = ""
blockToHtml options (Plain lst) = inlineListToHtml options lst
blockToHtml options (Para lst) = "<p>" ++ (inlineListToHtml options lst) ++ "</p>\n"
blockToHtml options (BlockQuote blocks) =
if (writerS5 options)
blockToHtml :: WriterOptions -> Block -> Doc
blockToHtml opts Blank = text ""
blockToHtml opts Null = empty
blockToHtml opts (Plain lst) = wrap opts lst
blockToHtml opts (Para lst) = inTagsIndented "p" $ wrap opts lst
blockToHtml opts (BlockQuote blocks) =
if (writerS5 opts)
then -- in S5, treat list in blockquote specially
-- if default is incremental, make it nonincremental;
-- otherwise incremental
let inc = not (writerIncremental options) in
let inc = not (writerIncremental opts) in
case blocks of
[BulletList lst] -> blockToHtml (options {writerIncremental =
[BulletList lst] -> blockToHtml (opts {writerIncremental =
inc}) (BulletList lst)
[OrderedList lst] -> blockToHtml (options {writerIncremental =
[OrderedList lst] -> blockToHtml (opts {writerIncremental =
inc}) (OrderedList lst)
otherwise -> "<blockquote>\n" ++
(concatMap (blockToHtml options) blocks) ++
"</blockquote>\n"
else "<blockquote>\n" ++ (concatMap (blockToHtml options) blocks) ++
"</blockquote>\n"
blockToHtml options (Note ref lst) =
let contents = (concatMap (blockToHtml options) lst) in
"<li id=\"fn" ++ ref ++ "\">" ++ contents ++ " <a href=\"#fnref" ++ ref ++
"\" class=\"footnoteBacklink\" title=\"Jump back to footnote " ++ ref ++
"\">&#8617;</a></li>\n"
blockToHtml options (Key _ _) = ""
blockToHtml options (CodeBlock str) =
"<pre><code>" ++ (escapeSGML str) ++ "\n</code></pre>\n"
blockToHtml options (RawHtml str) = str
blockToHtml options (BulletList lst) =
let attribs = if (writerIncremental options)
then " class=\"incremental\""
else "" in
"<ul" ++ attribs ++ ">\n" ++ (concatMap (listItemToHtml options) lst) ++
"</ul>\n"
blockToHtml options (OrderedList lst) =
let attribs = if (writerIncremental options)
then " class=\"incremental\""
else "" in
"<ol" ++ attribs ++ ">\n" ++ (concatMap (listItemToHtml options) lst) ++
"</ol>\n"
blockToHtml options HorizontalRule = "<hr />\n"
blockToHtml options (Header level lst) =
let contents = inlineListToHtml options lst in
otherwise -> inTagsIndented "blockquote" $
vcat $ map (blockToHtml opts) blocks
else inTagsIndented "blockquote" $ vcat $ map (blockToHtml opts) blocks
blockToHtml opts (Note ref lst) =
let contents = (vcat $ map (blockToHtml opts) lst) in
inTags True "li" [("id", "fn" ++ ref)] $
contents <> inTags False "a" [("href", "#fnref" ++ ref),
("class", "footnoteBacklink"),
("title", "Jump back to footnote " ++ ref)]
(text "&#8617;")
blockToHtml opts (Key _ _) = empty
blockToHtml opts (CodeBlock str) =
text "<pre><code>" <> text (escapeSGML str) <> text "\n</code></pre>"
blockToHtml opts (RawHtml str) = text str
blockToHtml opts (BulletList lst) =
let attribs = if (writerIncremental opts)
then [("class","incremental")]
else [] in
inTags True "ul" attribs $ vcat $ map (listItemToHtml opts) lst
blockToHtml opts (OrderedList lst) =
let attribs = if (writerIncremental opts)
then [("class","incremental")]
else [] in
inTags True "ol" attribs $ vcat $ map (listItemToHtml opts) lst
blockToHtml opts HorizontalRule = selfClosingTag "hr" []
blockToHtml opts (Header level lst) =
let contents = wrap opts lst in
if ((level > 0) && (level <= 6))
then "<h" ++ (show level) ++ ">" ++ contents ++
"</h" ++ (show level) ++ ">\n"
else "<p>" ++ contents ++ "</p>\n"
listItemToHtml options list =
"<li>" ++ (concatMap (blockToHtml options) list) ++ "</li>\n"
then inTagsSimple ("h" ++ show level) contents
else inTagsSimple "p" contents
listItemToHtml :: WriterOptions -> [Block] -> Doc
listItemToHtml opts list =
inTagsSimple "li" $ vcat $ map (blockToHtml opts) list
-- | Convert list of Pandoc inline elements to HTML.
inlineListToHtml :: WriterOptions -> [Inline] -> String
inlineListToHtml options lst =
-- consolidate adjacent Str and Space elements for more intelligent
-- smart typography filtering
let lst' = consolidateList lst in
concatMap (inlineToHtml options) lst'
inlineListToHtml :: WriterOptions -> [Inline] -> Doc
inlineListToHtml opts lst = hcat (map (inlineToHtml opts) lst)
-- | Convert Pandoc inline element to HTML.
inlineToHtml :: WriterOptions -> Inline -> String
inlineToHtml options (Emph lst) =
"<em>" ++ (inlineListToHtml options lst) ++ "</em>"
inlineToHtml options (Strong lst) =
"<strong>" ++ (inlineListToHtml options lst) ++ "</strong>"
inlineToHtml options (Code str) =
"<code>" ++ (escapeSGML str) ++ "</code>"
inlineToHtml options (Str str) = stringToSGML options str
inlineToHtml options (TeX str) = (escapeSGML str)
inlineToHtml options (HtmlInline str) = str
inlineToHtml options (LineBreak) = "<br />\n"
inlineToHtml options Space = " "
inlineToHtml options (Link text (Src src tit)) =
let title = stringToSGML options tit in
inlineToHtml :: WriterOptions -> Inline -> Doc
inlineToHtml opts (Emph lst) =
inTagsSimple "em" (inlineListToHtml opts lst)
inlineToHtml opts (Strong lst) =
inTagsSimple "strong" (inlineListToHtml opts lst)
inlineToHtml opts (Code str) =
inTagsSimple "code" $ text (escapeSGML str)
inlineToHtml opts (Quoted SingleQuote lst) =
text "&lsquo;" <> (inlineListToHtml opts lst) <> text "&rsquo;"
inlineToHtml opts (Quoted DoubleQuote lst) =
text "&ldquo;" <> (inlineListToHtml opts lst) <> text "&rdquo;"
inlineToHtml opts EmDash = text "&mdash;"
inlineToHtml opts EnDash = text "&ndash;"
inlineToHtml opts Ellipses = text "&hellip;"
inlineToHtml opts Apostrophe = text "&rsquo;"
inlineToHtml opts (Str str) = text $ stringToSGML str
inlineToHtml opts (TeX str) = text $ escapeSGML str
inlineToHtml opts (HtmlInline str) = text str
inlineToHtml opts (LineBreak) = selfClosingTag "br" []
inlineToHtml opts Space = space
inlineToHtml opts (Link txt (Src src tit)) =
let title = stringToSGML tit in
if (isPrefixOf "mailto:" src)
then obfuscateLink options text src
else "<a href=\"" ++ (escapeSGML src) ++ "\"" ++
(if tit /= "" then " title=\"" ++ title ++ "\">" else ">") ++
(inlineListToHtml options text) ++ "</a>"
inlineToHtml options (Link text (Ref ref)) =
"[" ++ (inlineListToHtml options text) ++ "][" ++
(inlineListToHtml options ref) ++ "]"
then obfuscateLink opts txt src
else inTags False "a" ([("href", escapeSGML src)] ++
if null tit then [] else [("title", title)])
(inlineListToHtml opts txt)
inlineToHtml opts (Link txt (Ref ref)) =
char '[' <> (inlineListToHtml opts txt) <> text "][" <>
(inlineListToHtml opts ref) <> char ']'
-- this is what markdown does, for better or worse
inlineToHtml options (Image alt (Src source tit)) =
let title = stringToSGML options tit
alternate = inlineListToHtml options alt in
"<img src=\"" ++ source ++ "\"" ++
(if tit /= "" then " title=\"" ++ title ++ "\"" else "") ++
(if alternate /= "" then " alt=\"" ++ alternate ++ "\"" else "") ++ ">"
inlineToHtml options (Image alternate (Ref ref)) =
"![" ++ (inlineListToHtml options alternate) ++ "][" ++
(inlineListToHtml options ref) ++ "]"
inlineToHtml options (NoteRef ref) =
"<sup class=\"footnoteRef\" id=\"fnref" ++ ref ++ "\"><a href=\"#fn" ++
ref ++ "\">" ++ ref ++ "</a></sup>"
inlineToHtml opts (Image alt (Src source tit)) =
let title = stringToSGML tit
alternate = render $ inlineListToHtml opts alt in
selfClosingTag "img" $ [("src", source)] ++
(if null tit then [] else [("title", title)]) ++
(if null alternate then [] else [("alt", alternate)])
inlineToHtml opts (Image alternate (Ref ref)) =
text "![" <> (inlineListToHtml opts alternate) <> text "][" <>
(inlineListToHtml opts ref) <> char ']'
inlineToHtml opts (NoteRef ref) =
inTags False "sup" [("class", "footnoteRef"), ("id", "fnref" ++ ref)]
(inTags False "a" [("href", "#fn" ++ ref)] $ text ref)

View file

@ -84,36 +84,9 @@ escapeBar = gsub "\\|" "\\\\textbar{}"
escapeLt = gsub "<" "\\\\textless{}"
escapeGt = gsub ">" "\\\\textgreater{}"
escapeDoubleQuotes =
gsub "\"" "''" . -- rest are right quotes .
gsub "``\\\\footnote" "''\\\\footnote" . -- except \footnote
gsub "\"\\\\" "``\\\\" . -- left quote before latex command
gsub "([[:space:]])\"" "\\1``" . -- never right quote after space
gsub "\"('|`)([^[:punct:][:space:]])" "``{}`\\2" . -- "'word left
gsub "\"([^[:punct:][:space:]])" "``\\1" -- "word left
escapeSingleQuotes =
gsub "`\\\\footnote" "'\\\\footnote" . -- except \footnote
gsub "'\\\\" "`\\\\" . -- left quote before latex command
gsub "('|`)(\"|``)" "`{}``" . -- '"word left
gsub "([^[:punct:][:space:]])`(s|S)" "\\1'\\2" . -- catch possessives
gsub "^'([^[:punct:][:space:]])" "`\\1" . -- 'word left
gsub "([[:space:]])'" "\\1`" . -- never right quote after space
gsub "([[:space:]])'([^[:punct:][:space:]])" "\\1`\\2"
-- 'word left (leave possessives)
escapeEllipses = gsub "\\.\\.\\.|\\. \\. \\." "\\ldots{}"
escapeDashes = gsub "([0-9])-([0-9])" "\\1--\\2" .
gsub " *--- *" "---" .
gsub "([^-])--([^-])" "\\1---\\2"
escapeSmart = escapeDashes . escapeSingleQuotes . escapeDoubleQuotes .
escapeEllipses
-- | Escape string for LaTeX (including smart quotes, dashes, ellipses)
-- | Escape string for LaTeX
stringToLaTeX :: String -> String
stringToLaTeX = escapeSmart . escapeGt . escapeLt . escapeBar . escapeHat .
stringToLaTeX = escapeGt . escapeLt . escapeBar . escapeHat .
escapeSpecial . fixBackslash . escapeBrackets .
escapeBackslash
@ -158,9 +131,7 @@ inlineListToLaTeX :: [Block] -- ^ List of note blocks to use in resolving note
-> [Inline] -- ^ Inlines to convert
-> String
inlineListToLaTeX notes lst =
-- first, consolidate Str and Space for more effective smartquotes:
let lst' = consolidateList lst in
concatMap (inlineToLaTeX notes) lst'
concatMap (inlineToLaTeX notes) lst
-- | Convert inline element to LaTeX
inlineToLaTeX :: [Block] -- ^ List of note blocks to use in resolving note refs
@ -173,6 +144,14 @@ inlineToLaTeX notes (Strong lst) = "\\textbf{" ++
inlineToLaTeX notes (Code str) = "\\verb" ++ [chr] ++ stuffing ++ [chr]
where stuffing = str
chr = ((enumFromTo '!' '~') \\ stuffing) !! 0
inlineToLaTeX notes (Quoted SingleQuote lst) =
"`" ++ inlineListToLaTeX notes lst ++ "'"
inlineToLaTeX notes (Quoted DoubleQuote lst) =
"``" ++ inlineListToLaTeX notes lst ++ "''"
inlineToLaTeX notes Apostrophe = "'"
inlineToLaTeX notes EmDash = "---"
inlineToLaTeX notes EnDash = "--"
inlineToLaTeX notes Ellipses = "\\ldots{}"
inlineToLaTeX notes (Str str) = stringToLaTeX str
inlineToLaTeX notes (TeX str) = str
inlineToLaTeX notes (HtmlInline str) = ""

View file

@ -35,6 +35,7 @@ module Text.Pandoc.Writers.Markdown (
import Text.Regex ( matchRegex, mkRegex )
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Data.List ( group )
import Text.PrettyPrint.HughesPJ hiding ( Str )
-- | Convert Pandoc to Markdown.
@ -154,12 +155,22 @@ inlineToMarkdown (Emph lst) = text "*" <>
(inlineListToMarkdown lst) <> text "*"
inlineToMarkdown (Strong lst) = text "**" <>
(inlineListToMarkdown lst) <> text "**"
inlineToMarkdown (Code str) =
case (matchRegex (mkRegex "``") str) of
Just match -> text ("` " ++ str ++ " `")
Nothing -> case (matchRegex (mkRegex "`") str) of
Just match -> text ("`` " ++ str ++ " ``")
Nothing -> text ("`" ++ str ++ "`")
inlineToMarkdown (Quoted SingleQuote lst) = char '\'' <>
(inlineListToMarkdown lst) <> char '\''
inlineToMarkdown (Quoted DoubleQuote lst) = char '"' <>
(inlineListToMarkdown lst) <> char '"'
inlineToMarkdown EmDash = text "--"
inlineToMarkdown EnDash = char '-'
inlineToMarkdown Apostrophe = char '\''
inlineToMarkdown Ellipses = text "..."
inlineToMarkdown (Code str) =
let tickGroups = filter (\s -> '`' `elem` s) $ group str
longest = if null tickGroups
then 0
else maximum $ map length tickGroups
marker = replicate (longest + 1) '`'
spacer = if (longest == 0) then "" else " " in
text (marker ++ spacer ++ str ++ spacer ++ marker)
inlineToMarkdown (Str str) = text $ escapeString str
inlineToMarkdown (TeX str) = text str
inlineToMarkdown (HtmlInline str) = text str

View file

@ -182,6 +182,14 @@ inlineToRST (Emph lst) = let (main, refs) = inlineListToRST lst in
(text "*" <> main <> text "*", refs)
inlineToRST (Strong lst) = let (main, refs) = inlineListToRST lst in
(text "**" <> main <> text "**", refs)
inlineToRST (Quoted SingleQuote lst) = let (main, refs) = inlineListToRST lst in
(char '\'' <> main <> char '\'', refs)
inlineToRST (Quoted DoubleQuote lst) = let (main, refs) = inlineListToRST lst in
(char '"' <> main <> char '"', refs)
inlineToRST EmDash = (text "--", empty)
inlineToRST EnDash = (char '-', empty)
inlineToRST Apostrophe = (char '\'', empty)
inlineToRST Ellipses = (text "...", empty)
inlineToRST (Code str) = (text $ "``" ++ str ++ "``", empty)
inlineToRST (Str str) = (text $ escapeString str, empty)
inlineToRST (TeX str) = (text str, empty)

View file

@ -211,6 +211,14 @@ inlineToRTF :: [Block] -- ^ list of note blocks
inlineToRTF notes (Emph lst) = "{\\i " ++ (inlineListToRTF notes lst) ++ "} "
inlineToRTF notes (Strong lst) =
"{\\b " ++ (inlineListToRTF notes lst) ++ "} "
inlineToRTF notes (Quoted SingleQuote lst) =
"\\u8216'" ++ (inlineListToRTF notes lst) ++ "\\u8217'"
inlineToRTF notes (Quoted DoubleQuote lst) =
"\\u8220\"" ++ (inlineListToRTF notes lst) ++ "\\u8221\""
inlineToRTF notes Apostrophe = "\\u8217'"
inlineToRTF notes Ellipses = "\\u8230?"
inlineToRTF notes EmDash = "\\u8212-"
inlineToRTF notes EnDash = "\\u8211-"
inlineToRTF notes (Code str) = "{\\f1 " ++ (codeStringToRTF str) ++ "} "
inlineToRTF notes (Str str) = stringToRTF str
inlineToRTF notes (TeX str) = latexToRTF str

View file

@ -4,7 +4,6 @@
../pandoc -r native -s -w markdown testsuite.native > writer.markdown
../pandoc -r native -s -w rst testsuite.native > writer.rst
../pandoc -r native -s -w html testsuite.native > writer.html
../pandoc -r native -s -w html -S testsuite.native > writer.smart.html
../pandoc -r native -s -w latex testsuite.native > writer.latex
../pandoc -r native -s -w rtf testsuite.native > writer.rtf
sed -e '/^, Header 1 \[Str "HTML",Space,Str "Blocks"\]/,/^, HorizontalRule/d' testsuite.native | ../pandoc -r native -w docbook -s > writer.docbook

View file

@ -14,7 +14,7 @@ unless (-x $script) { die "$script is not executable.\n"; }
print "Writer tests:\n";
my @writeformats = ("html", "smart.html", "latex", "rst", "rtf", "markdown", "native"); # s5 separately
my @writeformats = ("html", "latex", "rst", "rtf", "markdown", "native"); # s5 separately
my @readformats = ("latex", "native"); # handle html,markdown & rst separately
my $source = "testsuite.native";
@ -62,7 +62,7 @@ print "Testing s5 writer (basic)...";
test_results("s5 writer (basic)", "tmp.html", "s5.basic.html");
print "Testing s5 writer (fancy)...";
`$script -r native -w s5 -s -S -m -i s5.native > tmp.html`;
`$script -r native -w s5 -s -m -i s5.native > tmp.html`;
test_results("s5 writer (fancy)", "tmp.html", "s5.fancy.html");
print "Testing html fragment...";
@ -76,7 +76,7 @@ test_results("-B, -A, -H, -c options", "tmp.html", "s5.inserts.html");
print "\nReader tests:\n";
print "Testing markdown reader...";
`$script -r markdown -w native -s testsuite.txt > tmp.native`;
`$script -r markdown -w native -s -S testsuite.txt > tmp.native`;
test_results("markdown reader", "tmp.native", "testsuite.native");
print "Testing rst reader...";

View file

@ -737,6 +737,7 @@ function startup() {
window.onload = startup;
window.onresize = function(){setTimeout('fontScale()', 50);}</script>
<meta name="author" content="Sam Smith, Jen Jones" />
<meta name="date" content="July 15, 2006" />
<title>My S5 Document</title>
@ -747,38 +748,40 @@ window.onresize = function(){setTimeout('fontScale()', 50);}</script>
<div id="currentSlide"></div>
<div id="header"></div>
<div id="footer">
<h1>July 15, 2006</h1>
<h2>My S5 Document</h2>
</div>
</div>
<div class="presentation">
<div class="slide">
<h1>My S5 Document</h1>
<h3>Sam Smith, Jen Jones</h3>
<h4>July 15, 2006</h4>
</div>
<div class="slide">
<h1>First slide</h1>
<ul>
<li>first bullet</li>
<li>second bullet</li>
</ul>
</div>
<div class="slide">
<h1>Smarty</h1>
<ul class="incremental">
<li>&quot;Hello there&quot;</li>
<li>Here's a -- dash</li>
<li>And 'ellipses'...</li>
<li>first bullet</li>
<li>second bullet</li>
</ul>
</div>
<div class="slide">
<h1>Math</h1>
<ul>
<li>$\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$</li>
<li>$\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$</li>
</ul>
</div>
</div>
</body>
</html>

View file

@ -1649,6 +1649,7 @@ else
}
}
</script>
<meta name="author" content="Sam Smith, Jen Jones" />
<meta name="date" content="July 15, 2006" />
<title>My S5 Document</title>
@ -1659,38 +1660,40 @@ else
<div id="currentSlide"></div>
<div id="header"></div>
<div id="footer">
<h1>July 15, 2006</h1>
<h2>My S5 Document</h2>
</div>
</div>
<div class="presentation">
<div class="slide">
<h1>My S5 Document</h1>
<h3>Sam Smith, Jen Jones</h3>
<h4>July 15, 2006</h4>
</div>
<div class="slide">
<h1>First slide</h1>
<ul class="incremental">
<li>first bullet</li>
<li>second bullet</li>
</ul>
</div>
<div class="slide">
<h1>Smarty</h1>
<ul>
<li>&ldquo;Hello there&rdquo;</li>
<li>Here&rsquo;s a&mdash;dash</li>
<li>And &lsquo;ellipses&rsquo;&hellip;</li>
<li>first bullet</li>
<li>second bullet</li>
</ul>
</div>
<div class="slide">
<h1>Math</h1>
<ul class="incremental">
<li>$\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$</li>
<li>$\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$</li>
</ul>
</div>
</div>
</body>
</html>

View file

@ -1,17 +1,9 @@
<h1>First slide</h1>
<ul>
<li>first bullet</li>
<li>second bullet</li>
<li>first bullet</li>
<li>second bullet</li>
</ul>
<h1>Smarty</h1>
<blockquote>
<ul>
<li>&quot;Hello there&quot;</li>
<li>Here's a -- dash</li>
<li>And 'ellipses'...</li>
</ul>
</blockquote>
<h1>Math</h1>
<ul>
<li>$\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$</li>
<li>$\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$</li>
</ul>

View file

@ -6,30 +6,27 @@
<meta name="generator" content="pandoc" />
<link rel="stylesheet" href="main.css" type="text/css" media="all" />
STUFF INSERTED
<meta name="author" content="Sam Smith, Jen Jones" />
<meta name="date" content="July 15, 2006" />
<title>My S5 Document</title>
</head>
<body>
STUFF INSERTED
<h1 class="title">My S5 Document</h1>
<h1 class="title">
My S5 Document
</h1>
<h1>First slide</h1>
<ul>
<li>first bullet</li>
<li>second bullet</li>
<li>first bullet</li>
<li>second bullet</li>
</ul>
<h1>Smarty</h1>
<blockquote>
<ul>
<li>&quot;Hello there&quot;</li>
<li>Here's a -- dash</li>
<li>And 'ellipses'...</li>
</ul>
</blockquote>
<h1>Math</h1>
<ul>
<li>$\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$</li>
<li>$\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$</li>
</ul>
STUFF INSERTED
</body>
</html>

View file

@ -3,12 +3,6 @@ Pandoc (Meta [Str "My",Space,Str "S5",Space,Str "Document"] ["Sam Smith","Jen Jo
, BulletList
[ [ Plain [Str "first",Space,Str "bullet"] ]
, [ Plain [Str "second",Space,Str "bullet"] ] ]
, Header 1 [Str "Smarty"]
, BlockQuote
[ BulletList
[ [ Plain [Str "\"Hello",Space,Str "there\""] ]
, [ Plain [Str "Here's",Space,Str "a",Space,Str "--",Space,Str "dash"] ]
, [ Plain [Str "And",Space,Str "'ellipses'..."] ] ] ]
, Header 1 [Str "Math"]
, BulletList
[ [ Plain [TeX "$\\frac{d}{dx}f(x)=\\lim_{h\\to 0}\\frac{f(x+h)-f(x)}{h}$"] ]

View file

@ -1,5 +1,5 @@
Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane","Anonymous"] "July 17, 2006")
[ Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "set",Space,Str "of",Space,Str "tests",Space,Str "for",Space,Str "pandoc.",Space,Str "Most",Space,Str "of",Space,Str "them",Space,Str "are",Space,Str "adapted",Space,Str "from",Space,Str "John",Space,Str "Gruber's",Space,Str "markdown",Space,Str "test",Space,Str "suite."]
[ Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "set",Space,Str "of",Space,Str "tests",Space,Str "for",Space,Str "pandoc",Str ".",Space,Str "Most",Space,Str "of",Space,Str "them",Space,Str "are",Space,Str "adapted",Space,Str "from",Space,Str "John",Space,Str "Gruber",Apostrophe,Str "s",Space,Str "markdown",Space,Str "test",Space,Str "suite",Str "."]
, HorizontalRule
, Header 1 [Str "Headers"]
, Header 2 [Str "Level",Space,Str "2",Space,Str "with",Space,Str "an",Space,Link [Str "embedded",Space,Str "link"] (Src "/url" "")]
@ -14,15 +14,15 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, Para [Str "with",Space,Str "no",Space,Str "blank",Space,Str "line"]
, HorizontalRule
, Header 1 [Str "Paragraphs"]
, Para [Str "Here's",Space,Str "a",Space,Str "regular",Space,Str "paragraph."]
, Para [Str "In",Space,Str "Markdown",Space,Str "1.0.0",Space,Str "and",Space,Str "earlier.",Space,Str "Version",Space,Str "8.",Space,Str "This",Space,Str "line",Space,Str "turns",Space,Str "into",Space,Str "a",Space,Str "list",Space,Str "item.",Space,Str "Because",Space,Str "a",Space,Str "hard",Str "-",Str "wrapped",Space,Str "line",Space,Str "in",Space,Str "the",Space,Str "middle",Space,Str "of",Space,Str "a",Space,Str "paragraph",Space,Str "looked",Space,Str "like",Space,Str "a",Space,Str "list",Space,Str "item."]
, Para [Str "Here's",Space,Str "one",Space,Str "with",Space,Str "a",Space,Str "bullet.",Space,Str "*",Space,Str "criminey."]
, Para [Str "There",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "hard",Space,Str "line",Space,Str "break",LineBreak,Str "here."]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "regular",Space,Str "paragraph",Str "."]
, Para [Str "In",Space,Str "Markdown",Space,Str "1",Str ".",Str "0",Str ".",Str "0",Space,Str "and",Space,Str "earlier",Str ".",Space,Str "Version",Space,Str "8",Str ".",Space,Str "This",Space,Str "line",Space,Str "turns",Space,Str "into",Space,Str "a",Space,Str "list",Space,Str "item",Str ".",Space,Str "Because",Space,Str "a",Space,Str "hard",Str "-",Str "wrapped",Space,Str "line",Space,Str "in",Space,Str "the",Space,Str "middle",Space,Str "of",Space,Str "a",Space,Str "paragraph",Space,Str "looked",Space,Str "like",Space,Str "a",Space,Str "list",Space,Str "item",Str "."]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "one",Space,Str "with",Space,Str "a",Space,Str "bullet",Str ".",Space,Str "*",Space,Str "criminey",Str "."]
, Para [Str "There",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "hard",Space,Str "line",Space,Str "break",LineBreak,Str "here",Str "."]
, HorizontalRule
, Header 1 [Str "Block",Space,Str "Quotes"]
, Para [Str "E",Str "-",Str "mail",Space,Str "style:"]
, BlockQuote
[ Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "block",Space,Str "quote.",Space,Str "It",Space,Str "is",Space,Str "pretty",Space,Str "short."] ]
[ Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "block",Space,Str "quote",Str ".",Space,Str "It",Space,Str "is",Space,Str "pretty",Space,Str "short",Str "."] ]
, BlockQuote
[ Para [Str "Code",Space,Str "in",Space,Str "a",Space,Str "block",Space,Str "quote:"]
@ -38,7 +38,7 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, BlockQuote
[ Para [Str "nested"] ]
]
, Para [Str "This",Space,Str "should",Space,Str "not",Space,Str "be",Space,Str "a",Space,Str "block",Space,Str "quote:",Space,Str "2",Space,Str ">",Space,Str "1."]
, Para [Str "This",Space,Str "should",Space,Str "not",Space,Str "be",Space,Str "a",Space,Str "block",Space,Str "quote:",Space,Str "2",Space,Str ">",Space,Str "1",Str "."]
, Para [Str "Box",Str "-",Str "style:"]
, BlockQuote
[ Para [Str "Example:"]
@ -47,13 +47,13 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
[ OrderedList
[ [ Plain [Str "do",Space,Str "laundry"] ]
, [ Plain [Str "take",Space,Str "out",Space,Str "the",Space,Str "trash"] ] ] ]
, Para [Str "Here's",Space,Str "a",Space,Str "nested",Space,Str "one:"]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "nested",Space,Str "one:"]
, BlockQuote
[ Para [Str "Joe",Space,Str "said:"]
, BlockQuote
[ Para [Str "Don't",Space,Str "quote",Space,Str "me."] ]
[ Para [Str "Don",Apostrophe,Str "t",Space,Str "quote",Space,Str "me",Str "."] ]
]
, Para [Str "And",Space,Str "a",Space,Str "following",Space,Str "paragraph."]
, Para [Str "And",Space,Str "a",Space,Str "following",Space,Str "paragraph",Str "."]
, HorizontalRule
, Header 1 [Str "Code",Space,Str "Blocks"]
, Para [Str "Code:"]
@ -116,9 +116,9 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, [ Para [Str "Three"] ] ]
, Para [Str "Multiple",Space,Str "paragraphs:"]
, OrderedList
[ [ Para [Str "Item",Space,Str "1,",Space,Str "graf",Space,Str "one."]
, Para [Str "Item",Space,Str "1.",Space,Str "graf",Space,Str "two.",Space,Str "The",Space,Str "quick",Space,Str "brown",Space,Str "fox",Space,Str "jumped",Space,Str "over",Space,Str "the",Space,Str "lazy",Space,Str "dog's",Space,Str "back."] ], [ Para [Str "Item",Space,Str "2."] ]
, [ Para [Str "Item",Space,Str "3."] ] ]
[ [ Para [Str "Item",Space,Str "1,",Space,Str "graf",Space,Str "one",Str "."]
, Para [Str "Item",Space,Str "1",Str ".",Space,Str "graf",Space,Str "two",Str ".",Space,Str "The",Space,Str "quick",Space,Str "brown",Space,Str "fox",Space,Str "jumped",Space,Str "over",Space,Str "the",Space,Str "lazy",Space,Str "dog",Apostrophe,Str "s",Space,Str "back",Str "."] ], [ Para [Str "Item",Space,Str "2",Str "."] ]
, [ Para [Str "Item",Space,Str "3",Str "."] ] ]
, Header 2 [Str "Nested"]
, BulletList
[ [ Plain [Str "Tab"]
@ -127,7 +127,7 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, BulletList
[ [ Plain [Str "Tab"] ]
] ] ] ] ]
, Para [Str "Here's",Space,Str "another:"]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "another:"]
, OrderedList
[ [ Plain [Str "First"] ]
, [ Plain [Str "Second:"]
@ -168,7 +168,7 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, RawHtml "</td>\n<td>"
, Plain [Str "And",Space,Str "this",Space,Str "is",Space,Strong [Str "strong"]]
, RawHtml "</td>\n</tr>\n</table>\n\n<script type=\"text/javascript\">document.write('This *should not* be interpreted as markdown');</script>\n"
, Para [Str "Here's",Space,Str "a",Space,Str "simple",Space,Str "block:"]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "simple",Space,Str "block:"]
, RawHtml "<div>\n "
, Plain [Str "foo"]
, RawHtml "</div>\n"
@ -190,28 +190,28 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, RawHtml "<!-- foo --> \n"
, Para [Str "Code:"]
, CodeBlock "<hr />"
, Para [Str "Hr's:"]
, Para [Str "Hr",Apostrophe,Str "s:"]
, RawHtml "<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"
, HorizontalRule
, Header 1 [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 "."]
, Para [Str "This",Space,Str "is",Space,Strong [Str "strong"],Str ",",Space,Str "and",Space,Str "so",Space,Strong [Str "is",Space,Str "this"],Str "."]
, Para [Str "An",Space,Emph [Link [Str "emphasized",Space,Str "link"] (Src "/url" "")],Str "."]
, Para [Strong [Emph [Str "This",Space,Str "is",Space,Str "strong",Space,Str "and",Space,Str "em."]]]
, Para [Str "So",Space,Str "is",Space,Strong [Emph [Str "this"]],Space,Str "word."]
, Para [Strong [Emph [Str "This",Space,Str "is",Space,Str "strong",Space,Str "and",Space,Str "em."]]]
, Para [Str "So",Space,Str "is",Space,Strong [Emph [Str "this"]],Space,Str "word."]
, Para [Strong [Emph [Str "This",Space,Str "is",Space,Str "strong",Space,Str "and",Space,Str "em",Str "."]]]
, Para [Str "So",Space,Str "is",Space,Strong [Emph [Str "this"]],Space,Str "word",Str "."]
, Para [Strong [Emph [Str "This",Space,Str "is",Space,Str "strong",Space,Str "and",Space,Str "em",Str "."]]]
, Para [Str "So",Space,Str "is",Space,Strong [Emph [Str "this"]],Space,Str "word",Str "."]
, Para [Str "This",Space,Str "is",Space,Str "code:",Space,Code ">",Str ",",Space,Code "$",Str ",",Space,Code "\\",Str ",",Space,Code "\\$",Str ",",Space,Code "<html>",Str "."]
, HorizontalRule
, Header 1 [Str "Smart",Space,Str "quotes,",Space,Str "ellipses,",Space,Str "dashes"]
, Para [Str "\"Hello,\"",Space,Str "said",Space,Str "the",Space,Str "spider.",Space,Str "\"'Shelob'",Space,Str "is",Space,Str "my",Space,Str "name.\""]
, Para [Str "'A',",Space,Str "'B',",Space,Str "and",Space,Str "'C'",Space,Str "are",Space,Str "letters."]
, Para [Str "'Oak,'",Space,Str "'elm,'",Space,Str "and",Space,Str "'beech'",Space,Str "are",Space,Str "names",Space,Str "of",Space,Str "trees.",Space,Str "So",Space,Str "is",Space,Str "'pine.'"]
, Para [Str "'He",Space,Str "said,",Space,Str "\"I",Space,Str "want",Space,Str "to",Space,Str "go.\"'",Space,Str "Were",Space,Str "you",Space,Str "alive",Space,Str "in",Space,Str "the",Space,Str "70's?"]
, Para [Str "Here",Space,Str "is",Space,Str "some",Space,Str "quoted",Space,Str "'",Code "code",Str "'",Space,Str "and",Space,Str "a",Space,Str "\"",Link [Str "quoted",Space,Str "link"] (Ref [Str "1"]),Str "\"."]
, Para [Str "Some",Space,Str "dashes:",Space,Str "one",Str "---",Str "two",Space,Str "---",Space,Str "three",Str "--",Str "four",Space,Str "--",Space,Str "five."]
, Para [Str "Dashes",Space,Str "between",Space,Str "numbers:",Space,Str "5",Str "-",Str "7,",Space,Str "255",Str "-",Str "66,",Space,Str "1987",Str "-",Str "1999."]
, Para [Str "Ellipses...and.",Space,Str ".",Space,Str ".and",Space,Str ".",Space,Str ".",Space,Str ".",Space,Str "."]
, Para [Quoted DoubleQuote [Str "Hello,"],Space,Str "said",Space,Str "the",Space,Str "spider",Str ".",Space,Quoted DoubleQuote [Quoted SingleQuote [Str "Shelob"],Space,Str "is",Space,Str "my",Space,Str "name",Str "."]]
, Para [Quoted SingleQuote [Str "A"],Str ",",Space,Quoted SingleQuote [Str "B"],Str ",",Space,Str "and",Space,Quoted SingleQuote [Str "C"],Space,Str "are",Space,Str "letters",Str "."]
, Para [Quoted SingleQuote [Str "Oak,"],Space,Quoted SingleQuote [Str "elm,"],Space,Str "and",Space,Quoted SingleQuote [Str "beech"],Space,Str "are",Space,Str "names",Space,Str "of",Space,Str "trees",Str ".",Space,Str "So",Space,Str "is",Space,Quoted SingleQuote [Str "pine",Str "."]]
, Para [Quoted SingleQuote [Str "He",Space,Str "said,",Space,Quoted DoubleQuote [Str "I",Space,Str "want",Space,Str "to",Space,Str "go",Str "."]],Space,Str "Were",Space,Str "you",Space,Str "alive",Space,Str "in",Space,Str "the",Space,Str "70",Apostrophe,Str "s?"]
, Para [Str "Here",Space,Str "is",Space,Str "some",Space,Str "quoted",Space,Quoted SingleQuote [Code "code"],Space,Str "and",Space,Str "a",Space,Quoted DoubleQuote [Link [Str "quoted",Space,Str "link"] (Ref [Str "1"])],Str "."]
, Para [Str "Some",Space,Str "dashes:",Space,Str "one",EmDash,Str "two",EmDash,Str "three",EmDash,Str "four",EmDash,Str "five",Str "."]
, Para [Str "Dashes",Space,Str "between",Space,Str "numbers:",Space,Str "5",EnDash,Str "7,",Space,Str "255",EnDash,Str "66,",Space,Str "1987",EnDash,Str "1999",Str "."]
, Para [Str "Ellipses",Ellipses,Str "and",Ellipses,Str "and",Ellipses,Str "."]
, HorizontalRule
, Header 1 [Str "LaTeX"]
, BulletList
@ -223,13 +223,13 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, [ Plain [TeX "$223$"] ]
, [ Plain [TeX "$p$",Str "-",Str "Tree"] ]
, [ Plain [TeX "$\\frac{d}{dx}f(x)=\\lim_{h\\to 0}\\frac{f(x+h)-f(x)}{h}$"] ]
, [ Plain [Str "Here's",Space,Str "one",Space,Str "that",Space,Str "has",Space,Str "a",Space,Str "line",Space,Str "break",Space,Str "in",Space,Str "it:",Space,TeX "$\\alpha + \\omega \\times x^2$",Str "."] ] ]
, Para [Str "These",Space,Str "shouldn't",Space,Str "be",Space,Str "math:"]
, [ Plain [Str "Here",Apostrophe,Str "s",Space,Str "one",Space,Str "that",Space,Str "has",Space,Str "a",Space,Str "line",Space,Str "break",Space,Str "in",Space,Str "it:",Space,TeX "$\\alpha + \\omega \\times x^2$",Str "."] ] ]
, Para [Str "These",Space,Str "shouldn",Apostrophe,Str "t",Space,Str "be",Space,Str "math:"]
, BulletList
[ [ Plain [Str "To",Space,Str "get",Space,Str "the",Space,Str "famous",Space,Str "equation,",Space,Str "write",Space,Code "$e = mc^2$",Str "."] ]
, [ Plain [Str "$",Str "22,000",Space,Str "is",Space,Str "a",Space,Emph [Str "lot"],Space,Str "of",Space,Str "money.",Space,Str "So",Space,Str "is",Space,Str "$",Str "34,000.",Space,Str "(It",Space,Str "worked",Space,Str "if",Space,Str "\"lot\"",Space,Str "is",Space,Str "emphasized.)"] ]
, [ Plain [Str "$",Str "22,000",Space,Str "is",Space,Str "a",Space,Emph [Str "lot"],Space,Str "of",Space,Str "money",Str ".",Space,Str "So",Space,Str "is",Space,Str "$",Str "34,000",Str ".",Space,Str "(It",Space,Str "worked",Space,Str "if",Space,Quoted DoubleQuote [Str "lot"],Space,Str "is",Space,Str "emphasized",Str ".",Str ")"] ]
, [ Plain [Str "Escaped",Space,Code "$",Str ":",Space,Str "$",Str "73",Space,Emph [Str "this",Space,Str "should",Space,Str "be",Space,Str "emphasized"],Space,Str "23",Str "$",Str "."] ] ]
, Para [Str "Here's",Space,Str "a",Space,Str "LaTeX",Space,Str "table:"]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "LaTeX",Space,Str "table:"]
, Para [TeX "\\begin{tabular}{|l|l|}\\hline\nAnimal & Number \\\\ \\hline\nDog & 2 \\\\\nCat & 1 \\\\ \\hline\n\\end{tabular}"]
, HorizontalRule
, Header 1 [Str "Special",Space,Str "Characters"]
@ -240,11 +240,11 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, [ Plain [Str "section:",Space,Str "\167"] ]
, [ Plain [Str "set",Space,Str "membership:",Space,Str "\8712"] ]
, [ Plain [Str "copyright:",Space,Str "\169"] ] ]
, Para [Str "AT&T",Space,Str "has",Space,Str "an",Space,Str "ampersand",Space,Str "in",Space,Str "their",Space,Str "name."]
, Para [Str "AT&T",Space,Str "is",Space,Str "another",Space,Str "way",Space,Str "to",Space,Str "write",Space,Str "it."]
, Para [Str "This",Space,Str "&",Space,Str "that."]
, Para [Str "4",Space,Str "<",Space,Str "5."]
, Para [Str "6",Space,Str ">",Space,Str "5."]
, Para [Str "AT&T",Space,Str "has",Space,Str "an",Space,Str "ampersand",Space,Str "in",Space,Str "their",Space,Str "name",Str "."]
, Para [Str "AT&T",Space,Str "is",Space,Str "another",Space,Str "way",Space,Str "to",Space,Str "write",Space,Str "it",Str "."]
, Para [Str "This",Space,Str "&",Space,Str "that",Str "."]
, Para [Str "4",Space,Str "<",Space,Str "5",Str "."]
, Para [Str "6",Space,Str ">",Space,Str "5",Str "."]
, Para [Str "Backslash:",Space,Str "\\"]
, Para [Str "Backtick:",Space,Str "`"]
, Para [Str "Asterisk:",Space,Str "*"]
@ -278,11 +278,11 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, Para [Str "Foo",Space,Link [Str "bar"] (Ref [Str "a"]),Str "."]
, Key [Str "a"] (Src "/url/" "")
, Para [Str "With",Space,Link [Str "embedded",Space,Str "[",Str "brackets",Str "]"] (Ref [Str "b"]),Str "."]
, Para [Link [Str "b"] (Ref [Str "b"]),Space,Str "by",Space,Str "itself",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "link."]
, Para [Link [Str "b"] (Ref [Str "b"]),Space,Str "by",Space,Str "itself",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "link",Str "."]
, Para [Str "Indented",Space,Link [Str "once"] (Ref [Str "once"]),Str "."]
, Para [Str "Indented",Space,Link [Str "twice"] (Ref [Str "twice"]),Str "."]
, Para [Str "Indented",Space,Link [Str "thrice"] (Ref [Str "thrice"]),Str "."]
, Para [Str "This",Space,Str "should",Space,Str "[",Str "not",Str "]",Str "[",Str "]",Space,Str "be",Space,Str "a",Space,Str "link."]
, Para [Str "This",Space,Str "should",Space,Str "[",Str "not",Str "]",Str "[",Str "]",Space,Str "be",Space,Str "a",Space,Str "link",Str "."]
, Key [Str "once"] (Src "/url" "")
, Key [Str "twice"] (Src "/url" "")
, Key [Str "thrice"] (Src "/url" "")
@ -292,10 +292,10 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, Para [Str "Foo",Space,Link [Str "biz"] (Src "/url/" "Title with &quot;quote&quot; inside"),Str "."]
, Key [Str "bar"] (Src "/url/" "Title with &quot;quotes&quot; inside")
, Header 2 [Str "With",Space,Str "ampersands"]
, Para [Str "Here's",Space,Str "a",Space,Link [Str "link",Space,Str "with",Space,Str "an",Space,Str "ampersand",Space,Str "in",Space,Str "the",Space,Str "URL"] (Ref [Str "1"]),Str "."]
, Para [Str "Here's",Space,Str "a",Space,Str "link",Space,Str "with",Space,Str "an",Space,Str "amersand",Space,Str "in",Space,Str "the",Space,Str "link",Space,Str "text:",Space,Link [Str "AT&T"] (Ref [Str "2"]),Str "."]
, Para [Str "Here's",Space,Str "an",Space,Link [Str "inline",Space,Str "link"] (Src "/script?foo=1&bar=2" ""),Str "."]
, Para [Str "Here's",Space,Str "an",Space,Link [Str "inline",Space,Str "link",Space,Str "in",Space,Str "pointy",Space,Str "braces"] (Src "/script?foo=1&bar=2" ""),Str "."]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Link [Str "link",Space,Str "with",Space,Str "an",Space,Str "ampersand",Space,Str "in",Space,Str "the",Space,Str "URL"] (Ref [Str "1"]),Str "."]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "link",Space,Str "with",Space,Str "an",Space,Str "amersand",Space,Str "in",Space,Str "the",Space,Str "link",Space,Str "text:",Space,Link [Str "AT&T"] (Ref [Str "2"]),Str "."]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "an",Space,Link [Str "inline",Space,Str "link"] (Src "/script?foo=1&bar=2" ""),Str "."]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "an",Space,Link [Str "inline",Space,Str "link",Space,Str "in",Space,Str "pointy",Space,Str "braces"] (Src "/script?foo=1&bar=2" ""),Str "."]
, Key [Str "1"] (Src "http://example.com/?foo=1&bar=2" "")
, Key [Str "2"] (Src "http://att.com/" "AT&T")
, Header 2 [Str "Autolinks"]
@ -303,7 +303,7 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, BulletList
[ [ Plain [Str "In",Space,Str "a",Space,Str "list?"] ]
, [ Plain [Link [Str "http://example.com/"] (Src "http://example.com/" "")] ]
, [ Plain [Str "It",Space,Str "should."] ] ]
, [ Plain [Str "It",Space,Str "should",Str "."] ] ]
, Para [Str "An",Space,Str "e",Str "-",Str "mail",Space,Str "address:",Space,Link [Str "nobody@nowhere.net"] (Src "mailto:nobody@nowhere.net" "")]
, BlockQuote
[ Para [Str "Blockquoted:",Space,Link [Str "http://example.com/"] (Src "http://example.com/" "")] ]
@ -312,34 +312,34 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, CodeBlock "or here: <http://example.com/>"
, HorizontalRule
, Header 1 [Str "Images"]
, Para [Str "From",Space,Str "\"Voyage",Space,Str "dans",Space,Str "la",Space,Str "Lune\"",Space,Str "by",Space,Str "Georges",Space,Str "Melies",Space,Str "(1902):"]
, Para [Str "From",Space,Quoted DoubleQuote [Str "Voyage",Space,Str "dans",Space,Str "la",Space,Str "Lune"],Space,Str "by",Space,Str "Georges",Space,Str "Melies",Space,Str "(1902):"]
, Para [Image [Str "lalune"] (Ref [Str "lalune"])]
, Key [Str "lalune"] (Src "lalune.jpg" "Voyage dans la Lune")
, Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "movie",Space,Image [Str "movie"] (Src "movie.jpg" ""),Space,Str "icon."]
, Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "movie",Space,Image [Str "movie"] (Src "movie.jpg" ""),Space,Str "icon",Str "."]
, HorizontalRule
, Header 1 [Str "Footnotes"]
, Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "footnote",Space,Str "reference,",NoteRef "1",Space,Str "and",Space,Str "another.",NoteRef "2",Space,Str "This",Space,Str "should",Space,Emph [Str "not"],Space,Str "be",Space,Str "a",Space,Str "footnote",Space,Str "reference,",Space,Str "because",Space,Str "it",Space,Str "contains",Space,Str "a",Space,Str "space.",Str "[",Str "^",Str "my",Space,Str "note",Str "]",Space,Str "Here",Space,Str "is",Space,Str "an",Space,Str "inline",Space,Str "note.",NoteRef "3"]
, Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "footnote",Space,Str "reference,",NoteRef "1",Space,Str "and",Space,Str "another",Str ".",NoteRef "2",Space,Str "This",Space,Str "should",Space,Emph [Str "not"],Space,Str "be",Space,Str "a",Space,Str "footnote",Space,Str "reference,",Space,Str "because",Space,Str "it",Space,Str "contains",Space,Str "a",Space,Str "space",Str ".",Str "[",Str "^",Str "my",Space,Str "note",Str "]",Space,Str "Here",Space,Str "is",Space,Str "an",Space,Str "inline",Space,Str "note",Str ".",NoteRef "3"]
, BlockQuote
[ Para [Str "Notes",Space,Str "can",Space,Str "go",Space,Str "in",Space,Str "quotes.",NoteRef "4"] ]
[ Para [Str "Notes",Space,Str "can",Space,Str "go",Space,Str "in",Space,Str "quotes",Str ".",NoteRef "4"] ]
, OrderedList
[ [ Plain [Str "And",Space,Str "in",Space,Str "list",Space,Str "items.",NoteRef "5"] ]
[ [ Plain [Str "And",Space,Str "in",Space,Str "list",Space,Str "items",Str ".",NoteRef "5"] ]
]
, Para [Str "This",Space,Str "paragraph",Space,Str "should",Space,Str "not",Space,Str "be",Space,Str "part",Space,Str "of",Space,Str "the",Space,Str "note,",Space,Str "as",Space,Str "it",Space,Str "is",Space,Str "not",Space,Str "indented."]
, Para [Str "This",Space,Str "paragraph",Space,Str "should",Space,Str "not",Space,Str "be",Space,Str "part",Space,Str "of",Space,Str "the",Space,Str "note,",Space,Str "as",Space,Str "it",Space,Str "is",Space,Str "not",Space,Str "indented",Str "."]
, Note "1"
[ Para [Str "Here",Space,Str "is",Space,Str "the",Space,Str "footnote.",Space,Str "It",Space,Str "can",Space,Str "go",Space,Str "anywhere",Space,Str "after",Space,Str "the",Space,Str "footnote",Space,Str "reference.",Space,Str "It",Space,Str "need",Space,Str "not",Space,Str "be",Space,Str "placed",Space,Str "at",Space,Str "the",Space,Str "end",Space,Str "of",Space,Str "the",Space,Str "document."] ]
[ Para [Str "Here",Space,Str "is",Space,Str "the",Space,Str "footnote",Str ".",Space,Str "It",Space,Str "can",Space,Str "go",Space,Str "anywhere",Space,Str "after",Space,Str "the",Space,Str "footnote",Space,Str "reference",Str ".",Space,Str "It",Space,Str "need",Space,Str "not",Space,Str "be",Space,Str "placed",Space,Str "at",Space,Str "the",Space,Str "end",Space,Str "of",Space,Str "the",Space,Str "document",Str "."] ]
, Note "2"
[ Para [Str "Here's",Space,Str "the",Space,Str "long",Space,Str "note.",Space,Str "This",Space,Str "one",Space,Str "contains",Space,Str "multiple",Space,Str "blocks."]
, Para [Str "Subsequent",Space,Str "blocks",Space,Str "are",Space,Str "indented",Space,Str "to",Space,Str "show",Space,Str "that",Space,Str "they",Space,Str "belong",Space,Str "to",Space,Str "the",Space,Str "footnote",Space,Str "(as",Space,Str "with",Space,Str "list",Space,Str "items)."]
[ Para [Str "Here",Apostrophe,Str "s",Space,Str "the",Space,Str "long",Space,Str "note",Str ".",Space,Str "This",Space,Str "one",Space,Str "contains",Space,Str "multiple",Space,Str "blocks",Str "."]
, Para [Str "Subsequent",Space,Str "blocks",Space,Str "are",Space,Str "indented",Space,Str "to",Space,Str "show",Space,Str "that",Space,Str "they",Space,Str "belong",Space,Str "to",Space,Str "the",Space,Str "footnote",Space,Str "(as",Space,Str "with",Space,Str "list",Space,Str "items)",Str "."]
, CodeBlock " { <code> }"
, Para [Str "If",Space,Str "you",Space,Str "want,",Space,Str "you",Space,Str "can",Space,Str "indent",Space,Str "every",Space,Str "line,",Space,Str "but",Space,Str "you",Space,Str "can",Space,Str "also",Space,Str "be",Space,Str "lazy",Space,Str "and",Space,Str "just",Space,Str "indent",Space,Str "the",Space,Str "first",Space,Str "line",Space,Str "of",Space,Str "each",Space,Str "block."] ]
, Para [Str "If",Space,Str "you",Space,Str "want,",Space,Str "you",Space,Str "can",Space,Str "indent",Space,Str "every",Space,Str "line,",Space,Str "but",Space,Str "you",Space,Str "can",Space,Str "also",Space,Str "be",Space,Str "lazy",Space,Str "and",Space,Str "just",Space,Str "indent",Space,Str "the",Space,Str "first",Space,Str "line",Space,Str "of",Space,Str "each",Space,Str "block",Str "."] ]
, Note "3"
[ Para [Str "This",Space,Str "is",Space,Emph [Str "easier"],Space,Str "to",Space,Str "type.",Space,Str "Inline",Space,Str "notes",Space,Str "may",Space,Str "contain",Space,Link [Str "links"] (Src "http://google.com" ""),Space,Str "and",Space,Code "]",Space,Str "verbatim",Space,Str "characters."] ]
[ Para [Str "This",Space,Str "is",Space,Emph [Str "easier"],Space,Str "to",Space,Str "type",Str ".",Space,Str "Inline",Space,Str "notes",Space,Str "may",Space,Str "contain",Space,Link [Str "links"] (Src "http://google.com" ""),Space,Str "and",Space,Code "]",Space,Str "verbatim",Space,Str "characters",Str "."] ]
, Note "4"
[ Para [Str "In",Space,Str "quote."] ]
[ Para [Str "In",Space,Str "quote",Str "."] ]
, Note "5"
[ Para [Str "In",Space,Str "list."] ]
[ Para [Str "In",Space,Str "list",Str "."] ]
]

View file

@ -17,7 +17,7 @@
</articleinfo>
<para>
This is a set of tests for pandoc. Most of them are adapted from
John Gruber's markdown test suite.
John Gruber&apos;s markdown test suite.
</para>
<section>
<title>Headers</title>
@ -58,7 +58,7 @@
<section>
<title>Paragraphs</title>
<para>
Here's a regular paragraph.
Here&apos;s a regular paragraph.
</para>
<para>
In Markdown 1.0.0 and earlier. Version 8. This line turns into a
@ -66,7 +66,7 @@
looked like a list item.
</para>
<para>
Here's one with a bullet. * criminey.
Here&apos;s one with a bullet. * criminey.
</para>
<para>
There should be a hard line
@ -152,7 +152,7 @@ sub status {
</orderedlist>
</blockquote>
<para>
Here's a nested one:
Here&apos;s a nested one:
</para>
<blockquote>
<para>
@ -160,7 +160,7 @@ sub status {
</para>
<blockquote>
<para>
Don't quote me.
Don&apos;t quote me.
</para>
</blockquote>
</blockquote>
@ -407,8 +407,8 @@ These should not be escaped: \$ \\ \&gt; \[ \{
Item 1, graf one.
</para>
<para>
Item 1. graf two. The quick brown fox jumped over the lazy dog's
back.
Item 1. graf two. The quick brown fox jumped over the lazy
dog&apos;s back.
</para>
</listitem>
<listitem>
@ -447,7 +447,7 @@ These should not be escaped: \$ \\ \&gt; \[ \{
</listitem>
</itemizedlist>
<para>
Here's another:
Here&apos;s another:
</para>
<orderedlist>
<listitem>
@ -585,30 +585,33 @@ These should not be escaped: \$ \\ \&gt; \[ \{
<section>
<title>Smart quotes, ellipses, dashes</title>
<para>
&quot;Hello,&quot; said the spider. &quot;'Shelob' is my
name.&quot;
<quote>Hello,</quote> said the spider.
<quote><quote>Shelob</quote> is my name.</quote>
</para>
<para>
'A', 'B', and 'C' are letters.
<quote>A</quote>, <quote>B</quote>, and <quote>C</quote> are
letters.
</para>
<para>
'Oak,' 'elm,' and 'beech' are names of trees. So is 'pine.'
<quote>Oak,</quote> <quote>elm,</quote> and <quote>beech</quote>
are names of trees. So is <quote>pine.</quote>
</para>
<para>
'He said, &quot;I want to go.&quot;' Were you alive in the 70's?
<quote>He said, <quote>I want to go.</quote></quote> Were you alive
in the 70&apos;s?
</para>
<para>
Here is some quoted '<literal>code</literal>' and a
&quot;<ulink url="http://example.com/?foo=1&amp;bar=2">quoted link</ulink>&quot;.
Here is some quoted <quote><literal>code</literal></quote> and a
<quote><ulink url="http://example.com/?foo=1&amp;bar=2">quoted link</ulink></quote>.
</para>
<para>
Some dashes: one---two --- three--four -- five.
Some dashes: one&mdash;two&mdash;three&mdash;four&mdash;five.
</para>
<para>
Dashes between numbers: 5-7, 255-66, 1987-1999.
Dashes between numbers: 5&ndash;7, 255&ndash;66, 1987&ndash;1999.
</para>
<para>
Ellipses...and. . .and . . . .
Ellipses&hellip;and&hellip;and&hellip;.
</para>
</section>
<section>
@ -656,13 +659,13 @@ These should not be escaped: \$ \\ \&gt; \[ \{
</listitem>
<listitem>
<para>
Here's one that has a line break in it:
Here&apos;s one that has a line break in it:
<literal>$\alpha + \omega \times x^2$</literal>.
</para>
</listitem>
</itemizedlist>
<para>
These shouldn't be math:
These shouldn&apos;t be math:
</para>
<itemizedlist>
<listitem>
@ -673,7 +676,7 @@ These should not be escaped: \$ \\ \&gt; \[ \{
<listitem>
<para>
$22,000 is a <emphasis>lot</emphasis> of money. So is $34,000. (It
worked if &quot;lot&quot; is emphasized.)
worked if <quote>lot</quote> is emphasized.)
</para>
</listitem>
<listitem>
@ -684,7 +687,7 @@ These should not be escaped: \$ \\ \&gt; \[ \{
</listitem>
</itemizedlist>
<para>
Here's a LaTeX table:
Here&apos;s a LaTeX table:
</para>
<para>
<literal>\begin{tabular}{|l|l|}\hline
@ -861,18 +864,19 @@ Cat &amp; 1 \\ \hline
<section>
<title>With ampersands</title>
<para>
Here's a
Here&apos;s a
<ulink url="http://example.com/?foo=1&amp;bar=2">link with an ampersand in the URL</ulink>.
</para>
<para>
Here's a link with an amersand in the link text:
Here&apos;s a link with an amersand in the link text:
<ulink url="http://att.com/">AT&amp;T</ulink>.
</para>
<para>
Here's an <ulink url="/script?foo=1&amp;bar=2">inline link</ulink>.
Here&apos;s an
<ulink url="/script?foo=1&amp;bar=2">inline link</ulink>.
</para>
<para>
Here's an
Here&apos;s an
<ulink url="/script?foo=1&amp;bar=2">inline link in pointy braces</ulink>.
</para>
</section>
@ -920,7 +924,7 @@ or here: &lt;http://example.com/&gt;
<section>
<title>Images</title>
<para>
From &quot;Voyage dans la Lune&quot; by Georges Melies (1902):
From <quote>Voyage dans la Lune</quote> by Georges Melies (1902):
</para>
<para>
<inlinemediaobject>
@ -957,7 +961,7 @@ or here: &lt;http://example.com/&gt;
and
another.<footnote>
<para>
Here's the long note. This one contains multiple blocks.
Here&apos;s the long note. This one contains multiple blocks.
</para>
<para>
Subsequent blocks are indented to show that they belong to the
@ -1008,5 +1012,4 @@ or here: &lt;http://example.com/&gt;
indented.
</para>
</section>
</article>

File diff suppressed because it is too large Load diff

View file

@ -373,7 +373,7 @@ This is code: \verb!>!, \verb!$!, \verb!\!, \verb!\$!, \verb!<html>!.
\section{Smart quotes, ellipses, dashes}
``Hello,'' said the spider. ``{}`Shelob' is my name.''
``Hello,'' said the spider. ```Shelob' is my name.''
`A', `B', and `C' are letters.
@ -387,7 +387,7 @@ Some dashes: one---two---three---four---five.
Dashes between numbers: 5--7, 255--66, 1987--1999.
Ellipses\ldots{}and\ldots{}and \ldots{} .
Ellipses\ldots{}and\ldots{}and\ldots{}.
\begin{center}\rule{3in}{0.4pt}\end{center}

View file

@ -403,11 +403,11 @@ This is code: `>`, `$`, `\`, `\$`, `<html>`.
Here is some quoted '`code`' and a "[quoted link][1]".
Some dashes: one---two --- three--four -- five.
Some dashes: one--two--three--four--five.
Dashes between numbers: 5-7, 255-66, 1987-1999.
Ellipses...and. . .and . . . .
Ellipses...and...and....
* * * * *

View file

@ -1,5 +1,5 @@
Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane","Anonymous"] "July 17, 2006")
[ Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "set",Space,Str "of",Space,Str "tests",Space,Str "for",Space,Str "pandoc.",Space,Str "Most",Space,Str "of",Space,Str "them",Space,Str "are",Space,Str "adapted",Space,Str "from",Space,Str "John",Space,Str "Gruber's",Space,Str "markdown",Space,Str "test",Space,Str "suite."]
[ Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "set",Space,Str "of",Space,Str "tests",Space,Str "for",Space,Str "pandoc",Str ".",Space,Str "Most",Space,Str "of",Space,Str "them",Space,Str "are",Space,Str "adapted",Space,Str "from",Space,Str "John",Space,Str "Gruber",Apostrophe,Str "s",Space,Str "markdown",Space,Str "test",Space,Str "suite",Str "."]
, HorizontalRule
, Header 1 [Str "Headers"]
, Header 2 [Str "Level",Space,Str "2",Space,Str "with",Space,Str "an",Space,Link [Str "embedded",Space,Str "link"] (Src "/url" "")]
@ -14,15 +14,15 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, Para [Str "with",Space,Str "no",Space,Str "blank",Space,Str "line"]
, HorizontalRule
, Header 1 [Str "Paragraphs"]
, Para [Str "Here's",Space,Str "a",Space,Str "regular",Space,Str "paragraph."]
, Para [Str "In",Space,Str "Markdown",Space,Str "1.0.0",Space,Str "and",Space,Str "earlier.",Space,Str "Version",Space,Str "8.",Space,Str "This",Space,Str "line",Space,Str "turns",Space,Str "into",Space,Str "a",Space,Str "list",Space,Str "item.",Space,Str "Because",Space,Str "a",Space,Str "hard",Str "-",Str "wrapped",Space,Str "line",Space,Str "in",Space,Str "the",Space,Str "middle",Space,Str "of",Space,Str "a",Space,Str "paragraph",Space,Str "looked",Space,Str "like",Space,Str "a",Space,Str "list",Space,Str "item."]
, Para [Str "Here's",Space,Str "one",Space,Str "with",Space,Str "a",Space,Str "bullet.",Space,Str "*",Space,Str "criminey."]
, Para [Str "There",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "hard",Space,Str "line",Space,Str "break",LineBreak,Str "here."]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "regular",Space,Str "paragraph",Str "."]
, Para [Str "In",Space,Str "Markdown",Space,Str "1",Str ".",Str "0",Str ".",Str "0",Space,Str "and",Space,Str "earlier",Str ".",Space,Str "Version",Space,Str "8",Str ".",Space,Str "This",Space,Str "line",Space,Str "turns",Space,Str "into",Space,Str "a",Space,Str "list",Space,Str "item",Str ".",Space,Str "Because",Space,Str "a",Space,Str "hard",Str "-",Str "wrapped",Space,Str "line",Space,Str "in",Space,Str "the",Space,Str "middle",Space,Str "of",Space,Str "a",Space,Str "paragraph",Space,Str "looked",Space,Str "like",Space,Str "a",Space,Str "list",Space,Str "item",Str "."]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "one",Space,Str "with",Space,Str "a",Space,Str "bullet",Str ".",Space,Str "*",Space,Str "criminey",Str "."]
, Para [Str "There",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "hard",Space,Str "line",Space,Str "break",LineBreak,Str "here",Str "."]
, HorizontalRule
, Header 1 [Str "Block",Space,Str "Quotes"]
, Para [Str "E",Str "-",Str "mail",Space,Str "style:"]
, BlockQuote
[ Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "block",Space,Str "quote.",Space,Str "It",Space,Str "is",Space,Str "pretty",Space,Str "short."] ]
[ Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "block",Space,Str "quote",Str ".",Space,Str "It",Space,Str "is",Space,Str "pretty",Space,Str "short",Str "."] ]
, BlockQuote
[ Para [Str "Code",Space,Str "in",Space,Str "a",Space,Str "block",Space,Str "quote:"]
@ -38,7 +38,7 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, BlockQuote
[ Para [Str "nested"] ]
]
, Para [Str "This",Space,Str "should",Space,Str "not",Space,Str "be",Space,Str "a",Space,Str "block",Space,Str "quote:",Space,Str "2",Space,Str ">",Space,Str "1."]
, Para [Str "This",Space,Str "should",Space,Str "not",Space,Str "be",Space,Str "a",Space,Str "block",Space,Str "quote:",Space,Str "2",Space,Str ">",Space,Str "1",Str "."]
, Para [Str "Box",Str "-",Str "style:"]
, BlockQuote
[ Para [Str "Example:"]
@ -47,13 +47,13 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
[ OrderedList
[ [ Plain [Str "do",Space,Str "laundry"] ]
, [ Plain [Str "take",Space,Str "out",Space,Str "the",Space,Str "trash"] ] ] ]
, Para [Str "Here's",Space,Str "a",Space,Str "nested",Space,Str "one:"]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "nested",Space,Str "one:"]
, BlockQuote
[ Para [Str "Joe",Space,Str "said:"]
, BlockQuote
[ Para [Str "Don't",Space,Str "quote",Space,Str "me."] ]
[ Para [Str "Don",Apostrophe,Str "t",Space,Str "quote",Space,Str "me",Str "."] ]
]
, Para [Str "And",Space,Str "a",Space,Str "following",Space,Str "paragraph."]
, Para [Str "And",Space,Str "a",Space,Str "following",Space,Str "paragraph",Str "."]
, HorizontalRule
, Header 1 [Str "Code",Space,Str "Blocks"]
, Para [Str "Code:"]
@ -116,9 +116,9 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, [ Para [Str "Three"] ] ]
, Para [Str "Multiple",Space,Str "paragraphs:"]
, OrderedList
[ [ Para [Str "Item",Space,Str "1,",Space,Str "graf",Space,Str "one."]
, Para [Str "Item",Space,Str "1.",Space,Str "graf",Space,Str "two.",Space,Str "The",Space,Str "quick",Space,Str "brown",Space,Str "fox",Space,Str "jumped",Space,Str "over",Space,Str "the",Space,Str "lazy",Space,Str "dog's",Space,Str "back."] ], [ Para [Str "Item",Space,Str "2."] ]
, [ Para [Str "Item",Space,Str "3."] ] ]
[ [ Para [Str "Item",Space,Str "1,",Space,Str "graf",Space,Str "one",Str "."]
, Para [Str "Item",Space,Str "1",Str ".",Space,Str "graf",Space,Str "two",Str ".",Space,Str "The",Space,Str "quick",Space,Str "brown",Space,Str "fox",Space,Str "jumped",Space,Str "over",Space,Str "the",Space,Str "lazy",Space,Str "dog",Apostrophe,Str "s",Space,Str "back",Str "."] ], [ Para [Str "Item",Space,Str "2",Str "."] ]
, [ Para [Str "Item",Space,Str "3",Str "."] ] ]
, Header 2 [Str "Nested"]
, BulletList
[ [ Plain [Str "Tab"]
@ -127,7 +127,7 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, BulletList
[ [ Plain [Str "Tab"] ]
] ] ] ] ]
, Para [Str "Here's",Space,Str "another:"]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "another:"]
, OrderedList
[ [ Plain [Str "First"] ]
, [ Plain [Str "Second:"]
@ -168,7 +168,7 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, RawHtml "</td>\n<td>"
, Plain [Str "And",Space,Str "this",Space,Str "is",Space,Strong [Str "strong"]]
, RawHtml "</td>\n</tr>\n</table>\n\n<script type=\"text/javascript\">document.write('This *should not* be interpreted as markdown');</script>\n"
, Para [Str "Here's",Space,Str "a",Space,Str "simple",Space,Str "block:"]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "simple",Space,Str "block:"]
, RawHtml "<div>\n "
, Plain [Str "foo"]
, RawHtml "</div>\n"
@ -190,28 +190,28 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, RawHtml "<!-- foo --> \n"
, Para [Str "Code:"]
, CodeBlock "<hr />"
, Para [Str "Hr's:"]
, Para [Str "Hr",Apostrophe,Str "s:"]
, RawHtml "<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"
, HorizontalRule
, Header 1 [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 "."]
, Para [Str "This",Space,Str "is",Space,Strong [Str "strong"],Str ",",Space,Str "and",Space,Str "so",Space,Strong [Str "is",Space,Str "this"],Str "."]
, Para [Str "An",Space,Emph [Link [Str "emphasized",Space,Str "link"] (Src "/url" "")],Str "."]
, Para [Strong [Emph [Str "This",Space,Str "is",Space,Str "strong",Space,Str "and",Space,Str "em."]]]
, Para [Str "So",Space,Str "is",Space,Strong [Emph [Str "this"]],Space,Str "word."]
, Para [Strong [Emph [Str "This",Space,Str "is",Space,Str "strong",Space,Str "and",Space,Str "em."]]]
, Para [Str "So",Space,Str "is",Space,Strong [Emph [Str "this"]],Space,Str "word."]
, Para [Strong [Emph [Str "This",Space,Str "is",Space,Str "strong",Space,Str "and",Space,Str "em",Str "."]]]
, Para [Str "So",Space,Str "is",Space,Strong [Emph [Str "this"]],Space,Str "word",Str "."]
, Para [Strong [Emph [Str "This",Space,Str "is",Space,Str "strong",Space,Str "and",Space,Str "em",Str "."]]]
, Para [Str "So",Space,Str "is",Space,Strong [Emph [Str "this"]],Space,Str "word",Str "."]
, Para [Str "This",Space,Str "is",Space,Str "code:",Space,Code ">",Str ",",Space,Code "$",Str ",",Space,Code "\\",Str ",",Space,Code "\\$",Str ",",Space,Code "<html>",Str "."]
, HorizontalRule
, Header 1 [Str "Smart",Space,Str "quotes,",Space,Str "ellipses,",Space,Str "dashes"]
, Para [Str "\"Hello,\"",Space,Str "said",Space,Str "the",Space,Str "spider.",Space,Str "\"'Shelob'",Space,Str "is",Space,Str "my",Space,Str "name.\""]
, Para [Str "'A',",Space,Str "'B',",Space,Str "and",Space,Str "'C'",Space,Str "are",Space,Str "letters."]
, Para [Str "'Oak,'",Space,Str "'elm,'",Space,Str "and",Space,Str "'beech'",Space,Str "are",Space,Str "names",Space,Str "of",Space,Str "trees.",Space,Str "So",Space,Str "is",Space,Str "'pine.'"]
, Para [Str "'He",Space,Str "said,",Space,Str "\"I",Space,Str "want",Space,Str "to",Space,Str "go.\"'",Space,Str "Were",Space,Str "you",Space,Str "alive",Space,Str "in",Space,Str "the",Space,Str "70's?"]
, Para [Str "Here",Space,Str "is",Space,Str "some",Space,Str "quoted",Space,Str "'",Code "code",Str "'",Space,Str "and",Space,Str "a",Space,Str "\"",Link [Str "quoted",Space,Str "link"] (Ref [Str "1"]),Str "\"."]
, Para [Str "Some",Space,Str "dashes:",Space,Str "one",Str "---",Str "two",Space,Str "---",Space,Str "three",Str "--",Str "four",Space,Str "--",Space,Str "five."]
, Para [Str "Dashes",Space,Str "between",Space,Str "numbers:",Space,Str "5",Str "-",Str "7,",Space,Str "255",Str "-",Str "66,",Space,Str "1987",Str "-",Str "1999."]
, Para [Str "Ellipses...and.",Space,Str ".",Space,Str ".and",Space,Str ".",Space,Str ".",Space,Str ".",Space,Str "."]
, Para [Quoted DoubleQuote [Str "Hello,"],Space,Str "said",Space,Str "the",Space,Str "spider",Str ".",Space,Quoted DoubleQuote [Quoted SingleQuote [Str "Shelob"],Space,Str "is",Space,Str "my",Space,Str "name",Str "."]]
, Para [Quoted SingleQuote [Str "A"],Str ",",Space,Quoted SingleQuote [Str "B"],Str ",",Space,Str "and",Space,Quoted SingleQuote [Str "C"],Space,Str "are",Space,Str "letters",Str "."]
, Para [Quoted SingleQuote [Str "Oak,"],Space,Quoted SingleQuote [Str "elm,"],Space,Str "and",Space,Quoted SingleQuote [Str "beech"],Space,Str "are",Space,Str "names",Space,Str "of",Space,Str "trees",Str ".",Space,Str "So",Space,Str "is",Space,Quoted SingleQuote [Str "pine",Str "."]]
, Para [Quoted SingleQuote [Str "He",Space,Str "said,",Space,Quoted DoubleQuote [Str "I",Space,Str "want",Space,Str "to",Space,Str "go",Str "."]],Space,Str "Were",Space,Str "you",Space,Str "alive",Space,Str "in",Space,Str "the",Space,Str "70",Apostrophe,Str "s?"]
, Para [Str "Here",Space,Str "is",Space,Str "some",Space,Str "quoted",Space,Quoted SingleQuote [Code "code"],Space,Str "and",Space,Str "a",Space,Quoted DoubleQuote [Link [Str "quoted",Space,Str "link"] (Ref [Str "1"])],Str "."]
, Para [Str "Some",Space,Str "dashes:",Space,Str "one",EmDash,Str "two",EmDash,Str "three",EmDash,Str "four",EmDash,Str "five",Str "."]
, Para [Str "Dashes",Space,Str "between",Space,Str "numbers:",Space,Str "5",EnDash,Str "7,",Space,Str "255",EnDash,Str "66,",Space,Str "1987",EnDash,Str "1999",Str "."]
, Para [Str "Ellipses",Ellipses,Str "and",Ellipses,Str "and",Ellipses,Str "."]
, HorizontalRule
, Header 1 [Str "LaTeX"]
, BulletList
@ -223,13 +223,13 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, [ Plain [TeX "$223$"] ]
, [ Plain [TeX "$p$",Str "-",Str "Tree"] ]
, [ Plain [TeX "$\\frac{d}{dx}f(x)=\\lim_{h\\to 0}\\frac{f(x+h)-f(x)}{h}$"] ]
, [ Plain [Str "Here's",Space,Str "one",Space,Str "that",Space,Str "has",Space,Str "a",Space,Str "line",Space,Str "break",Space,Str "in",Space,Str "it:",Space,TeX "$\\alpha + \\omega \\times x^2$",Str "."] ] ]
, Para [Str "These",Space,Str "shouldn't",Space,Str "be",Space,Str "math:"]
, [ Plain [Str "Here",Apostrophe,Str "s",Space,Str "one",Space,Str "that",Space,Str "has",Space,Str "a",Space,Str "line",Space,Str "break",Space,Str "in",Space,Str "it:",Space,TeX "$\\alpha + \\omega \\times x^2$",Str "."] ] ]
, Para [Str "These",Space,Str "shouldn",Apostrophe,Str "t",Space,Str "be",Space,Str "math:"]
, BulletList
[ [ Plain [Str "To",Space,Str "get",Space,Str "the",Space,Str "famous",Space,Str "equation,",Space,Str "write",Space,Code "$e = mc^2$",Str "."] ]
, [ Plain [Str "$",Str "22,000",Space,Str "is",Space,Str "a",Space,Emph [Str "lot"],Space,Str "of",Space,Str "money.",Space,Str "So",Space,Str "is",Space,Str "$",Str "34,000.",Space,Str "(It",Space,Str "worked",Space,Str "if",Space,Str "\"lot\"",Space,Str "is",Space,Str "emphasized.)"] ]
, [ Plain [Str "$",Str "22,000",Space,Str "is",Space,Str "a",Space,Emph [Str "lot"],Space,Str "of",Space,Str "money",Str ".",Space,Str "So",Space,Str "is",Space,Str "$",Str "34,000",Str ".",Space,Str "(It",Space,Str "worked",Space,Str "if",Space,Quoted DoubleQuote [Str "lot"],Space,Str "is",Space,Str "emphasized",Str ".",Str ")"] ]
, [ Plain [Str "Escaped",Space,Code "$",Str ":",Space,Str "$",Str "73",Space,Emph [Str "this",Space,Str "should",Space,Str "be",Space,Str "emphasized"],Space,Str "23",Str "$",Str "."] ] ]
, Para [Str "Here's",Space,Str "a",Space,Str "LaTeX",Space,Str "table:"]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "LaTeX",Space,Str "table:"]
, Para [TeX "\\begin{tabular}{|l|l|}\\hline\nAnimal & Number \\\\ \\hline\nDog & 2 \\\\\nCat & 1 \\\\ \\hline\n\\end{tabular}"]
, HorizontalRule
, Header 1 [Str "Special",Space,Str "Characters"]
@ -240,11 +240,11 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, [ Plain [Str "section:",Space,Str "\167"] ]
, [ Plain [Str "set",Space,Str "membership:",Space,Str "\8712"] ]
, [ Plain [Str "copyright:",Space,Str "\169"] ] ]
, Para [Str "AT&T",Space,Str "has",Space,Str "an",Space,Str "ampersand",Space,Str "in",Space,Str "their",Space,Str "name."]
, Para [Str "AT&T",Space,Str "is",Space,Str "another",Space,Str "way",Space,Str "to",Space,Str "write",Space,Str "it."]
, Para [Str "This",Space,Str "&",Space,Str "that."]
, Para [Str "4",Space,Str "<",Space,Str "5."]
, Para [Str "6",Space,Str ">",Space,Str "5."]
, Para [Str "AT&T",Space,Str "has",Space,Str "an",Space,Str "ampersand",Space,Str "in",Space,Str "their",Space,Str "name",Str "."]
, Para [Str "AT&T",Space,Str "is",Space,Str "another",Space,Str "way",Space,Str "to",Space,Str "write",Space,Str "it",Str "."]
, Para [Str "This",Space,Str "&",Space,Str "that",Str "."]
, Para [Str "4",Space,Str "<",Space,Str "5",Str "."]
, Para [Str "6",Space,Str ">",Space,Str "5",Str "."]
, Para [Str "Backslash:",Space,Str "\\"]
, Para [Str "Backtick:",Space,Str "`"]
, Para [Str "Asterisk:",Space,Str "*"]
@ -278,11 +278,11 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, Para [Str "Foo",Space,Link [Str "bar"] (Ref [Str "a"]),Str "."]
, Key [Str "a"] (Src "/url/" "")
, Para [Str "With",Space,Link [Str "embedded",Space,Str "[",Str "brackets",Str "]"] (Ref [Str "b"]),Str "."]
, Para [Link [Str "b"] (Ref [Str "b"]),Space,Str "by",Space,Str "itself",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "link."]
, Para [Link [Str "b"] (Ref [Str "b"]),Space,Str "by",Space,Str "itself",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "link",Str "."]
, Para [Str "Indented",Space,Link [Str "once"] (Ref [Str "once"]),Str "."]
, Para [Str "Indented",Space,Link [Str "twice"] (Ref [Str "twice"]),Str "."]
, Para [Str "Indented",Space,Link [Str "thrice"] (Ref [Str "thrice"]),Str "."]
, Para [Str "This",Space,Str "should",Space,Str "[",Str "not",Str "]",Str "[",Str "]",Space,Str "be",Space,Str "a",Space,Str "link."]
, Para [Str "This",Space,Str "should",Space,Str "[",Str "not",Str "]",Str "[",Str "]",Space,Str "be",Space,Str "a",Space,Str "link",Str "."]
, Key [Str "once"] (Src "/url" "")
, Key [Str "twice"] (Src "/url" "")
, Key [Str "thrice"] (Src "/url" "")
@ -292,10 +292,10 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, Para [Str "Foo",Space,Link [Str "biz"] (Src "/url/" "Title with &quot;quote&quot; inside"),Str "."]
, Key [Str "bar"] (Src "/url/" "Title with &quot;quotes&quot; inside")
, Header 2 [Str "With",Space,Str "ampersands"]
, Para [Str "Here's",Space,Str "a",Space,Link [Str "link",Space,Str "with",Space,Str "an",Space,Str "ampersand",Space,Str "in",Space,Str "the",Space,Str "URL"] (Ref [Str "1"]),Str "."]
, Para [Str "Here's",Space,Str "a",Space,Str "link",Space,Str "with",Space,Str "an",Space,Str "amersand",Space,Str "in",Space,Str "the",Space,Str "link",Space,Str "text:",Space,Link [Str "AT&T"] (Ref [Str "2"]),Str "."]
, Para [Str "Here's",Space,Str "an",Space,Link [Str "inline",Space,Str "link"] (Src "/script?foo=1&bar=2" ""),Str "."]
, Para [Str "Here's",Space,Str "an",Space,Link [Str "inline",Space,Str "link",Space,Str "in",Space,Str "pointy",Space,Str "braces"] (Src "/script?foo=1&bar=2" ""),Str "."]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Link [Str "link",Space,Str "with",Space,Str "an",Space,Str "ampersand",Space,Str "in",Space,Str "the",Space,Str "URL"] (Ref [Str "1"]),Str "."]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "link",Space,Str "with",Space,Str "an",Space,Str "amersand",Space,Str "in",Space,Str "the",Space,Str "link",Space,Str "text:",Space,Link [Str "AT&T"] (Ref [Str "2"]),Str "."]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "an",Space,Link [Str "inline",Space,Str "link"] (Src "/script?foo=1&bar=2" ""),Str "."]
, Para [Str "Here",Apostrophe,Str "s",Space,Str "an",Space,Link [Str "inline",Space,Str "link",Space,Str "in",Space,Str "pointy",Space,Str "braces"] (Src "/script?foo=1&bar=2" ""),Str "."]
, Key [Str "1"] (Src "http://example.com/?foo=1&bar=2" "")
, Key [Str "2"] (Src "http://att.com/" "AT&T")
, Header 2 [Str "Autolinks"]
@ -303,7 +303,7 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, BulletList
[ [ Plain [Str "In",Space,Str "a",Space,Str "list?"] ]
, [ Plain [Link [Str "http://example.com/"] (Src "http://example.com/" "")] ]
, [ Plain [Str "It",Space,Str "should."] ] ]
, [ Plain [Str "It",Space,Str "should",Str "."] ] ]
, Para [Str "An",Space,Str "e",Str "-",Str "mail",Space,Str "address:",Space,Link [Str "nobody@nowhere.net"] (Src "mailto:nobody@nowhere.net" "")]
, BlockQuote
[ Para [Str "Blockquoted:",Space,Link [Str "http://example.com/"] (Src "http://example.com/" "")] ]
@ -312,34 +312,34 @@ Pandoc (Meta [Str "Pandoc",Space,Str "Test",Space,Str "Suite"] ["John MacFarlane
, CodeBlock "or here: <http://example.com/>"
, HorizontalRule
, Header 1 [Str "Images"]
, Para [Str "From",Space,Str "\"Voyage",Space,Str "dans",Space,Str "la",Space,Str "Lune\"",Space,Str "by",Space,Str "Georges",Space,Str "Melies",Space,Str "(1902):"]
, Para [Str "From",Space,Quoted DoubleQuote [Str "Voyage",Space,Str "dans",Space,Str "la",Space,Str "Lune"],Space,Str "by",Space,Str "Georges",Space,Str "Melies",Space,Str "(1902):"]
, Para [Image [Str "lalune"] (Ref [Str "lalune"])]
, Key [Str "lalune"] (Src "lalune.jpg" "Voyage dans la Lune")
, Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "movie",Space,Image [Str "movie"] (Src "movie.jpg" ""),Space,Str "icon."]
, Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "movie",Space,Image [Str "movie"] (Src "movie.jpg" ""),Space,Str "icon",Str "."]
, HorizontalRule
, Header 1 [Str "Footnotes"]
, Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "footnote",Space,Str "reference,",NoteRef "1",Space,Str "and",Space,Str "another.",NoteRef "2",Space,Str "This",Space,Str "should",Space,Emph [Str "not"],Space,Str "be",Space,Str "a",Space,Str "footnote",Space,Str "reference,",Space,Str "because",Space,Str "it",Space,Str "contains",Space,Str "a",Space,Str "space.",Str "[",Str "^",Str "my",Space,Str "note",Str "]",Space,Str "Here",Space,Str "is",Space,Str "an",Space,Str "inline",Space,Str "note.",NoteRef "3"]
, Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "footnote",Space,Str "reference,",NoteRef "1",Space,Str "and",Space,Str "another",Str ".",NoteRef "2",Space,Str "This",Space,Str "should",Space,Emph [Str "not"],Space,Str "be",Space,Str "a",Space,Str "footnote",Space,Str "reference,",Space,Str "because",Space,Str "it",Space,Str "contains",Space,Str "a",Space,Str "space",Str ".",Str "[",Str "^",Str "my",Space,Str "note",Str "]",Space,Str "Here",Space,Str "is",Space,Str "an",Space,Str "inline",Space,Str "note",Str ".",NoteRef "3"]
, BlockQuote
[ Para [Str "Notes",Space,Str "can",Space,Str "go",Space,Str "in",Space,Str "quotes.",NoteRef "4"] ]
[ Para [Str "Notes",Space,Str "can",Space,Str "go",Space,Str "in",Space,Str "quotes",Str ".",NoteRef "4"] ]
, OrderedList
[ [ Plain [Str "And",Space,Str "in",Space,Str "list",Space,Str "items.",NoteRef "5"] ]
[ [ Plain [Str "And",Space,Str "in",Space,Str "list",Space,Str "items",Str ".",NoteRef "5"] ]
]
, Para [Str "This",Space,Str "paragraph",Space,Str "should",Space,Str "not",Space,Str "be",Space,Str "part",Space,Str "of",Space,Str "the",Space,Str "note,",Space,Str "as",Space,Str "it",Space,Str "is",Space,Str "not",Space,Str "indented."]
, Para [Str "This",Space,Str "paragraph",Space,Str "should",Space,Str "not",Space,Str "be",Space,Str "part",Space,Str "of",Space,Str "the",Space,Str "note,",Space,Str "as",Space,Str "it",Space,Str "is",Space,Str "not",Space,Str "indented",Str "."]
, Note "1"
[ Para [Str "Here",Space,Str "is",Space,Str "the",Space,Str "footnote.",Space,Str "It",Space,Str "can",Space,Str "go",Space,Str "anywhere",Space,Str "after",Space,Str "the",Space,Str "footnote",Space,Str "reference.",Space,Str "It",Space,Str "need",Space,Str "not",Space,Str "be",Space,Str "placed",Space,Str "at",Space,Str "the",Space,Str "end",Space,Str "of",Space,Str "the",Space,Str "document."] ]
[ Para [Str "Here",Space,Str "is",Space,Str "the",Space,Str "footnote",Str ".",Space,Str "It",Space,Str "can",Space,Str "go",Space,Str "anywhere",Space,Str "after",Space,Str "the",Space,Str "footnote",Space,Str "reference",Str ".",Space,Str "It",Space,Str "need",Space,Str "not",Space,Str "be",Space,Str "placed",Space,Str "at",Space,Str "the",Space,Str "end",Space,Str "of",Space,Str "the",Space,Str "document",Str "."] ]
, Note "2"
[ Para [Str "Here's",Space,Str "the",Space,Str "long",Space,Str "note.",Space,Str "This",Space,Str "one",Space,Str "contains",Space,Str "multiple",Space,Str "blocks."]
, Para [Str "Subsequent",Space,Str "blocks",Space,Str "are",Space,Str "indented",Space,Str "to",Space,Str "show",Space,Str "that",Space,Str "they",Space,Str "belong",Space,Str "to",Space,Str "the",Space,Str "footnote",Space,Str "(as",Space,Str "with",Space,Str "list",Space,Str "items)."]
[ Para [Str "Here",Apostrophe,Str "s",Space,Str "the",Space,Str "long",Space,Str "note",Str ".",Space,Str "This",Space,Str "one",Space,Str "contains",Space,Str "multiple",Space,Str "blocks",Str "."]
, Para [Str "Subsequent",Space,Str "blocks",Space,Str "are",Space,Str "indented",Space,Str "to",Space,Str "show",Space,Str "that",Space,Str "they",Space,Str "belong",Space,Str "to",Space,Str "the",Space,Str "footnote",Space,Str "(as",Space,Str "with",Space,Str "list",Space,Str "items)",Str "."]
, CodeBlock " { <code> }"
, Para [Str "If",Space,Str "you",Space,Str "want,",Space,Str "you",Space,Str "can",Space,Str "indent",Space,Str "every",Space,Str "line,",Space,Str "but",Space,Str "you",Space,Str "can",Space,Str "also",Space,Str "be",Space,Str "lazy",Space,Str "and",Space,Str "just",Space,Str "indent",Space,Str "the",Space,Str "first",Space,Str "line",Space,Str "of",Space,Str "each",Space,Str "block."] ]
, Para [Str "If",Space,Str "you",Space,Str "want,",Space,Str "you",Space,Str "can",Space,Str "indent",Space,Str "every",Space,Str "line,",Space,Str "but",Space,Str "you",Space,Str "can",Space,Str "also",Space,Str "be",Space,Str "lazy",Space,Str "and",Space,Str "just",Space,Str "indent",Space,Str "the",Space,Str "first",Space,Str "line",Space,Str "of",Space,Str "each",Space,Str "block",Str "."] ]
, Note "3"
[ Para [Str "This",Space,Str "is",Space,Emph [Str "easier"],Space,Str "to",Space,Str "type.",Space,Str "Inline",Space,Str "notes",Space,Str "may",Space,Str "contain",Space,Link [Str "links"] (Src "http://google.com" ""),Space,Str "and",Space,Code "]",Space,Str "verbatim",Space,Str "characters."] ]
[ Para [Str "This",Space,Str "is",Space,Emph [Str "easier"],Space,Str "to",Space,Str "type",Str ".",Space,Str "Inline",Space,Str "notes",Space,Str "may",Space,Str "contain",Space,Link [Str "links"] (Src "http://google.com" ""),Space,Str "and",Space,Code "]",Space,Str "verbatim",Space,Str "characters",Str "."] ]
, Note "4"
[ Para [Str "In",Space,Str "quote."] ]
[ Para [Str "In",Space,Str "quote",Str "."] ]
, Note "5"
[ Para [Str "In",Space,Str "list."] ]
[ Para [Str "In",Space,Str "list",Str "."] ]
]

View file

@ -501,11 +501,11 @@ Smart quotes, ellipses, dashes
Here is some quoted '``code``' and a "`quoted link`_".
Some dashes: one---two --- three--four -- five.
Some dashes: one--two--three--four--five.
Dashes between numbers: 5-7, 255-66, 1987-1999.
Ellipses...and. . .and . . . .
Ellipses...and...and....
--------------

View file

@ -6,7 +6,7 @@
{\pard \f0 \sa180 \li0 \fi0 \qc John MacFarlane\Anonymous\par}
{\pard \f0 \sa180 \li0 \fi0 \qc July 17, 2006\par}
{\pard \f0 \sa180 \li0 \fi0 \par}
{\pard \f0 \sa180 \li0 \fi0 This is a set of tests for pandoc. Most of them are adapted from John Gruber's markdown test suite.\par}
{\pard \f0 \sa180 \li0 \fi0 This is a set of tests for pandoc. Most of them are adapted from John Gruber\u8217's markdown test suite.\par}
{\pard \f0 \sa180 \li0 \fi0 \qc \emdash\emdash\emdash\emdash\emdash\par}
{\pard \f0 \sa180 \li0 \fi0 \b \fs36 Headers\par}
{\pard \f0 \sa180 \li0 \fi0 \b \fs32 Level 2 with an {\field{\*\fldinst{HYPERLINK "/url"}}{\fldrslt{\ul
@ -24,9 +24,9 @@ embedded link
{\pard \f0 \sa180 \li0 \fi0 with no blank line\par}
{\pard \f0 \sa180 \li0 \fi0 \qc \emdash\emdash\emdash\emdash\emdash\par}
{\pard \f0 \sa180 \li0 \fi0 \b \fs36 Paragraphs\par}
{\pard \f0 \sa180 \li0 \fi0 Here's a regular paragraph.\par}
{\pard \f0 \sa180 \li0 \fi0 Here\u8217's a regular paragraph.\par}
{\pard \f0 \sa180 \li0 \fi0 In Markdown 1.0.0 and earlier. Version 8. This line turns into a list item. Because a hard-wrapped line in the middle of a paragraph looked like a list item.\par}
{\pard \f0 \sa180 \li0 \fi0 Here's one with a bullet. * criminey.\par}
{\pard \f0 \sa180 \li0 \fi0 Here\u8217's one with a bullet. * criminey.\par}
{\pard \f0 \sa180 \li0 \fi0 There should be a hard line break\line here.\par}
{\pard \f0 \sa180 \li0 \fi0 \qc \emdash\emdash\emdash\emdash\emdash\par}
{\pard \f0 \sa180 \li0 \fi0 \b \fs36 Block Quotes\par}
@ -50,9 +50,9 @@ embedded link
\}\par}
{\pard \f0 \sa0 \li1080 \fi-360 1.\tx360\tab do laundry\par}
{\pard \f0 \sa0 \li1080 \fi-360 2.\tx360\tab take out the trash\sa180\par}
{\pard \f0 \sa180 \li0 \fi0 Here's a nested one:\par}
{\pard \f0 \sa180 \li0 \fi0 Here\u8217's a nested one:\par}
{\pard \f0 \sa180 \li720 \fi0 Joe said:\par}
{\pard \f0 \sa180 \li1440 \fi0 Don't quote me.\par}
{\pard \f0 \sa180 \li1440 \fi0 Don\u8217't quote me.\par}
{\pard \f0 \sa180 \li0 \fi0 And a following paragraph.\par}
{\pard \f0 \sa180 \li0 \fi0 \qc \emdash\emdash\emdash\emdash\emdash\par}
{\pard \f0 \sa180 \li0 \fi0 \b \fs36 Code Blocks\par}
@ -114,14 +114,14 @@ These should not be escaped: \\$ \\\\ \\> \\[ \\\{\par}
{\pard \f0 \sa180 \li360 \fi-360 3.\tx360\tab Three\sa180\par}
{\pard \f0 \sa180 \li0 \fi0 Multiple paragraphs:\par}
{\pard \f0 \sa180 \li360 \fi-360 1.\tx360\tab Item 1, graf one.\par}
{\pard \f0 \sa180 \li360 \fi0 Item 1. graf two. The quick brown fox jumped over the lazy dog's back.\par}
{\pard \f0 \sa180 \li360 \fi0 Item 1. graf two. The quick brown fox jumped over the lazy dog\u8217's back.\par}
{\pard \f0 \sa180 \li360 \fi-360 2.\tx360\tab Item 2.\par}
{\pard \f0 \sa180 \li360 \fi-360 3.\tx360\tab Item 3.\sa180\par}
{\pard \f0 \sa180 \li0 \fi0 \b \fs32 Nested\par}
{\pard \f0 \sa0 \li360 \fi-360 \bullet \tx360\tab Tab\par}
{\pard \f0 \sa0 \li720 \fi-360 \endash \tx360\tab Tab\par}
{\pard \f0 \sa0 \li1080 \fi-360 \bullet \tx360\tab Tab\sa180\sa180\sa180\par}
{\pard \f0 \sa180 \li0 \fi0 Here's another:\par}
{\pard \f0 \sa180 \li0 \fi0 Here\u8217's another:\par}
{\pard \f0 \sa0 \li360 \fi-360 1.\tx360\tab First\par}
{\pard \f0 \sa0 \li360 \fi-360 2.\tx360\tab Second:\par}
{\pard \f0 \sa0 \li720 \fi-360 \endash \tx360\tab Fee\par}
@ -150,7 +150,7 @@ These should not be escaped: \\$ \\\\ \\> \\[ \\\{\par}
{\pard \f0 \sa180 \li0 \fi0 Interpreted markdown in a table:\par}
{\pard \f0 \sa0 \li0 \fi0 This is {\i emphasized} \par}
{\pard \f0 \sa0 \li0 \fi0 And this is {\b strong} \par}
{\pard \f0 \sa180 \li0 \fi0 Here's a simple block:\par}
{\pard \f0 \sa180 \li0 \fi0 Here\u8217's a simple block:\par}
{\pard \f0 \sa0 \li0 \fi0 foo\par}
{\pard \f0 \sa180 \li0 \fi0 This should be a code block, though:\par}
{\pard \f0 \sa180 \li0 \fi0 \f1 <div>\line
@ -167,7 +167,7 @@ These should not be escaped: \\$ \\\\ \\> \\[ \\\{\par}
{\pard \f0 \sa180 \li0 \fi0 Just plain comment, with trailing spaces on the line:\par}
{\pard \f0 \sa180 \li0 \fi0 Code:\par}
{\pard \f0 \sa180 \li0 \fi0 \f1 <hr />\par}
{\pard \f0 \sa180 \li0 \fi0 Hr's:\par}
{\pard \f0 \sa180 \li0 \fi0 Hr\u8217's:\par}
{\pard \f0 \sa180 \li0 \fi0 \qc \emdash\emdash\emdash\emdash\emdash\par}
{\pard \f0 \sa180 \li0 \fi0 \b \fs36 Inline Markup\par}
{\pard \f0 \sa180 \li0 \fi0 This is {\i emphasized} , and so {\i is this} .\par}
@ -183,17 +183,17 @@ emphasized link
{\pard \f0 \sa180 \li0 \fi0 This is code: {\f1 >} , {\f1 $} , {\f1 \\} , {\f1 \\$} , {\f1 <html>} .\par}
{\pard \f0 \sa180 \li0 \fi0 \qc \emdash\emdash\emdash\emdash\emdash\par}
{\pard \f0 \sa180 \li0 \fi0 \b \fs36 Smart quotes, ellipses, dashes\par}
{\pard \f0 \sa180 \li0 \fi0 "Hello," said the spider. "'Shelob' is my name."\par}
{\pard \f0 \sa180 \li0 \fi0 'A', 'B', and 'C' are letters.\par}
{\pard \f0 \sa180 \li0 \fi0 'Oak,' 'elm,' and 'beech' are names of trees. So is 'pine.'\par}
{\pard \f0 \sa180 \li0 \fi0 'He said, "I want to go."' Were you alive in the 70's?\par}
{\pard \f0 \sa180 \li0 \fi0 Here is some quoted '{\f1 code} ' and a "{\field{\*\fldinst{HYPERLINK "http://example.com/?foo=1&bar=2"}}{\fldrslt{\ul
{\pard \f0 \sa180 \li0 \fi0 \u8220"Hello,\u8221" said the spider. \u8220"\u8216'Shelob\u8217' is my name.\u8221"\par}
{\pard \f0 \sa180 \li0 \fi0 \u8216'A\u8217', \u8216'B\u8217', and \u8216'C\u8217' are letters.\par}
{\pard \f0 \sa180 \li0 \fi0 \u8216'Oak,\u8217' \u8216'elm,\u8217' and \u8216'beech\u8217' are names of trees. So is \u8216'pine.\u8217'\par}
{\pard \f0 \sa180 \li0 \fi0 \u8216'He said, \u8220"I want to go.\u8221"\u8217' Were you alive in the 70\u8217's?\par}
{\pard \f0 \sa180 \li0 \fi0 Here is some quoted \u8216'{\f1 code} \u8217' and a \u8220"{\field{\*\fldinst{HYPERLINK "http://example.com/?foo=1&bar=2"}}{\fldrslt{\ul
quoted link
}}}
".\par}
{\pard \f0 \sa180 \li0 \fi0 Some dashes: one---two --- three--four -- five.\par}
{\pard \f0 \sa180 \li0 \fi0 Dashes between numbers: 5-7, 255-66, 1987-1999.\par}
{\pard \f0 \sa180 \li0 \fi0 Ellipses...and. . .and . . . .\par}
\u8221".\par}
{\pard \f0 \sa180 \li0 \fi0 Some dashes: one\u8212-two\u8212-three\u8212-four\u8212-five.\par}
{\pard \f0 \sa180 \li0 \fi0 Dashes between numbers: 5\u8211-7, 255\u8211-66, 1987\u8211-1999.\par}
{\pard \f0 \sa180 \li0 \fi0 Ellipses\u8230?and\u8230?and\u8230?.\par}
{\pard \f0 \sa180 \li0 \fi0 \qc \emdash\emdash\emdash\emdash\emdash\par}
{\pard \f0 \sa180 \li0 \fi0 \b \fs36 LaTeX\par}
{\pard \f0 \sa0 \li360 \fi-360 \bullet \tx360\tab {\cf1 \\cite[22-23]\{smith.1899\}\cf0 } \par}
@ -204,12 +204,12 @@ quoted link
{\pard \f0 \sa0 \li360 \fi-360 \bullet \tx360\tab {\cf1 $223$\cf0 } \par}
{\pard \f0 \sa0 \li360 \fi-360 \bullet \tx360\tab {\cf1 $p$\cf0 } -Tree\par}
{\pard \f0 \sa0 \li360 \fi-360 \bullet \tx360\tab {\cf1 $\\frac\{d\}\{dx\}f(x)=\\lim_\{h\\to 0\}\\frac\{f(x+h)-f(x)\}\{h\}$\cf0 } \par}
{\pard \f0 \sa0 \li360 \fi-360 \bullet \tx360\tab Here's one that has a line break in it: {\cf1 $\\alpha + \\omega \\times x^2$\cf0 } .\sa180\par}
{\pard \f0 \sa180 \li0 \fi0 These shouldn't be math:\par}
{\pard \f0 \sa0 \li360 \fi-360 \bullet \tx360\tab Here\u8217's one that has a line break in it: {\cf1 $\\alpha + \\omega \\times x^2$\cf0 } .\sa180\par}
{\pard \f0 \sa180 \li0 \fi0 These shouldn\u8217't be math:\par}
{\pard \f0 \sa0 \li360 \fi-360 \bullet \tx360\tab To get the famous equation, write {\f1 $e = mc^2$} .\par}
{\pard \f0 \sa0 \li360 \fi-360 \bullet \tx360\tab $22,000 is a {\i lot} of money. So is $34,000. (It worked if "lot" is emphasized.)\par}
{\pard \f0 \sa0 \li360 \fi-360 \bullet \tx360\tab $22,000 is a {\i lot} of money. So is $34,000. (It worked if \u8220"lot\u8221" is emphasized.)\par}
{\pard \f0 \sa0 \li360 \fi-360 \bullet \tx360\tab Escaped {\f1 $} : $73 {\i this should be emphasized} 23$.\sa180\par}
{\pard \f0 \sa180 \li0 \fi0 Here's a LaTeX table:\par}
{\pard \f0 \sa180 \li0 \fi0 Here\u8217's a LaTeX table:\par}
{\pard \f0 \sa180 \li0 \fi0 {\cf1 \\begin\{tabular\}\{|l|l|\}\\hline
Animal & Number \\\\ \\hline
Dog & 2 \\\\
@ -323,19 +323,19 @@ biz
}}}
.\par}
{\pard \f0 \sa180 \li0 \fi0 \b \fs32 With ampersands\par}
{\pard \f0 \sa180 \li0 \fi0 Here's a {\field{\*\fldinst{HYPERLINK "http://example.com/?foo=1&bar=2"}}{\fldrslt{\ul
{\pard \f0 \sa180 \li0 \fi0 Here\u8217's a {\field{\*\fldinst{HYPERLINK "http://example.com/?foo=1&bar=2"}}{\fldrslt{\ul
link with an ampersand in the URL
}}}
.\par}
{\pard \f0 \sa180 \li0 \fi0 Here's a link with an amersand in the link text: {\field{\*\fldinst{HYPERLINK "http://att.com/"}}{\fldrslt{\ul
{\pard \f0 \sa180 \li0 \fi0 Here\u8217's a link with an amersand in the link text: {\field{\*\fldinst{HYPERLINK "http://att.com/"}}{\fldrslt{\ul
AT&T
}}}
.\par}
{\pard \f0 \sa180 \li0 \fi0 Here's an {\field{\*\fldinst{HYPERLINK "/script?foo=1&bar=2"}}{\fldrslt{\ul
{\pard \f0 \sa180 \li0 \fi0 Here\u8217's an {\field{\*\fldinst{HYPERLINK "/script?foo=1&bar=2"}}{\fldrslt{\ul
inline link
}}}
.\par}
{\pard \f0 \sa180 \li0 \fi0 Here's an {\field{\*\fldinst{HYPERLINK "/script?foo=1&bar=2"}}{\fldrslt{\ul
{\pard \f0 \sa180 \li0 \fi0 Here\u8217's an {\field{\*\fldinst{HYPERLINK "/script?foo=1&bar=2"}}{\fldrslt{\ul
inline link in pointy braces
}}}
.\par}
@ -362,13 +362,13 @@ http://example.com/
{\pard \f0 \sa180 \li0 \fi0 \f1 or here: <http://example.com/>\par}
{\pard \f0 \sa180 \li0 \fi0 \qc \emdash\emdash\emdash\emdash\emdash\par}
{\pard \f0 \sa180 \li0 \fi0 \b \fs36 Images\par}
{\pard \f0 \sa180 \li0 \fi0 From "Voyage dans la Lune" by Georges Melies (1902):\par}
{\pard \f0 \sa180 \li0 \fi0 From \u8220"Voyage dans la Lune\u8221" by Georges Melies (1902):\par}
{\pard \f0 \sa180 \li0 \fi0 {\cf1 [image: lalune.jpg]\cf0}\par}
{\pard \f0 \sa180 \li0 \fi0 Here is a movie {\cf1 [image: movie.jpg]\cf0} icon.\par}
{\pard \f0 \sa180 \li0 \fi0 \qc \emdash\emdash\emdash\emdash\emdash\par}
{\pard \f0 \sa180 \li0 \fi0 \b \fs36 Footnotes\par}
{\pard \f0 \sa180 \li0 \fi0 Here is a footnote reference,{\super\chftn}{\*\footnote\chftn\~\plain\pard {\pard \f0 \sa180 \li0 \fi0 Here is the footnote. It can go anywhere after the footnote reference. It need not be placed at the end of the document.\par}
} and another.{\super\chftn}{\*\footnote\chftn\~\plain\pard {\pard \f0 \sa180 \li0 \fi0 Here's the long note. This one contains multiple blocks.\par}
} and another.{\super\chftn}{\*\footnote\chftn\~\plain\pard {\pard \f0 \sa180 \li0 \fi0 Here\u8217's the long note. This one contains multiple blocks.\par}
{\pard \f0 \sa180 \li0 \fi0 Subsequent blocks are indented to show that they belong to the footnote (as with list items).\par}
{\pard \f0 \sa180 \li0 \fi0 \f1 \{ <code> \}\par}
{\pard \f0 \sa180 \li0 \fi0 If you want, you can indent every line, but you can also be lazy and just indent the first line of each block.\par}

View file

@ -1,474 +0,0 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
"http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
<meta name="generator" content="pandoc" />
<meta name="author" content="John MacFarlane, Anonymous" />
<meta name="date" content="July 17, 2006" />
<title>Pandoc Test Suite</title>
</head>
<body>
<h1 class="title">Pandoc Test Suite</h1>
<p>This is a set of tests for pandoc. Most of them are adapted from John Gruber&rsquo;s markdown test suite.</p>
<hr />
<h1>Headers</h1>
<h2>Level 2 with an <a href="/url">embedded link</a></h2>
<h3>Level 3 with <em>emphasis</em></h3>
<h4>Level 4</h4>
<h5>Level 5</h5>
<h1>Level 1</h1>
<h2>Level 2 with <em>emphasis</em></h2>
<h3>Level 3</h3>
<p>with no blank line</p>
<h2>Level 2</h2>
<p>with no blank line</p>
<hr />
<h1>Paragraphs</h1>
<p>Here&rsquo;s a regular paragraph.</p>
<p>In Markdown 1.0.0 and earlier. Version 8. This line turns into a list item. Because a hard-wrapped line in the middle of a paragraph looked like a list item.</p>
<p>Here&rsquo;s one with a bullet. * criminey.</p>
<p>There should be a hard line break<br />
here.</p>
<hr />
<h1>Block Quotes</h1>
<p>E-mail style:</p>
<blockquote>
<p>This is a block quote. It is pretty short.</p>
</blockquote>
<blockquote>
<p>Code in a block quote:</p>
<pre><code>sub status {
print &quot;working&quot;;
}
</code></pre>
<p>A list:</p>
<ol>
<li>item one</li>
<li>item two</li>
</ol>
<p>Nested block quotes:</p>
<blockquote>
<p>nested</p>
</blockquote>
<blockquote>
<p>nested</p>
</blockquote>
</blockquote>
<p>This should not be a block quote: 2 &gt; 1.</p>
<p>Box-style:</p>
<blockquote>
<p>Example:</p>
<pre><code>sub status {
print &quot;working&quot;;
}
</code></pre>
</blockquote>
<blockquote>
<ol>
<li>do laundry</li>
<li>take out the trash</li>
</ol>
</blockquote>
<p>Here&rsquo;s a nested one:</p>
<blockquote>
<p>Joe said:</p>
<blockquote>
<p>Don&rsquo;t quote me.</p>
</blockquote>
</blockquote>
<p>And a following paragraph.</p>
<hr />
<h1>Code Blocks</h1>
<p>Code:</p>
<pre><code>---- (should be four hyphens)
sub status {
print &quot;working&quot;;
}
this code block is indented by one tab
</code></pre>
<p>And:</p>
<pre><code> this code block is indented by two tabs
These should not be escaped: \$ \\ \&gt; \[ \{
</code></pre>
<hr />
<h1>Lists</h1>
<h2>Unordered</h2>
<p>Asterisks tight:</p>
<ul>
<li>asterisk 1</li>
<li>asterisk 2</li>
<li>asterisk 3</li>
</ul>
<p>Asterisks loose:</p>
<ul>
<li><p>asterisk 1</p>
</li>
<li><p>asterisk 2</p>
</li>
<li><p>asterisk 3</p>
</li>
</ul>
<p>Pluses tight:</p>
<ul>
<li>Plus 1</li>
<li>Plus 2</li>
<li>Plus 3</li>
</ul>
<p>Pluses loose:</p>
<ul>
<li><p>Plus 1</p>
</li>
<li><p>Plus 2</p>
</li>
<li><p>Plus 3</p>
</li>
</ul>
<p>Minuses tight:</p>
<ul>
<li>Minus 1</li>
<li>Minus 2</li>
<li>Minus 3</li>
</ul>
<p>Minuses loose:</p>
<ul>
<li><p>Minus 1</p>
</li>
<li><p>Minus 2</p>
</li>
<li><p>Minus 3</p>
</li>
</ul>
<h2>Ordered</h2>
<p>Tight:</p>
<ol>
<li>First</li>
<li>Second</li>
<li>Third</li>
</ol>
<p>and:</p>
<ol>
<li>One</li>
<li>Two</li>
<li>Three</li>
</ol>
<p>Loose using tabs:</p>
<ol>
<li><p>First</p>
</li>
<li><p>Second</p>
</li>
<li><p>Third</p>
</li>
</ol>
<p>and using spaces:</p>
<ol>
<li><p>One</p>
</li>
<li><p>Two</p>
</li>
<li><p>Three</p>
</li>
</ol>
<p>Multiple paragraphs:</p>
<ol>
<li><p>Item 1, graf one.</p>
<p>Item 1. graf two. The quick brown fox jumped over the lazy dog&rsquo;s back.</p>
</li>
<li><p>Item 2.</p>
</li>
<li><p>Item 3.</p>
</li>
</ol>
<h2>Nested</h2>
<ul>
<li>Tab<ul>
<li>Tab<ul>
<li>Tab</li>
</ul>
</li>
</ul>
</li>
</ul>
<p>Here&rsquo;s another:</p>
<ol>
<li>First</li>
<li>Second:<ul>
<li>Fee</li>
<li>Fie</li>
<li>Foe</li>
</ul>
</li>
<li>Third</li>
</ol>
<p>Same thing but with paragraphs:</p>
<ol>
<li><p>First</p>
</li>
<li><p>Second:</p>
<ul>
<li>Fee</li>
<li>Fie</li>
<li>Foe</li>
</ul>
</li>
<li><p>Third</p>
</li>
</ol>
<h2>Tabs and spaces</h2>
<ul>
<li><p>this is a list item indented with tabs</p>
</li>
<li><p>this is a list item indented with spaces</p>
<ul>
<li><p>this is an example list item indented with tabs</p>
</li>
<li><p>this is an example list item indented with spaces</p>
</li>
</ul>
</li>
</ul>
<hr />
<h1>HTML Blocks</h1>
<p>Simple block on one line:</p>
<div>foo</div>
<p>And nested without indentation:</p>
<div>
<div>
<div>foo</div>
</div>
<div>bar</div>
</div>
<p>Interpreted markdown in a table:</p>
<table>
<tr>
<td>This is <em>emphasized</em></td>
<td>And this is <strong>strong</strong></td>
</tr>
</table>
<script type="text/javascript">document.write('This *should not* be interpreted as markdown');</script>
<p>Here&rsquo;s a simple block:</p>
<div>
foo</div>
<p>This should be a code block, though:</p>
<pre><code>&lt;div&gt;
foo
&lt;/div&gt;
</code></pre>
<p>As should this:</p>
<pre><code>&lt;div&gt;foo&lt;/div&gt;
</code></pre>
<p>Now, nested:</p>
<div>
<div>
<div>
foo</div>
</div>
</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 -->
<p>Code:</p>
<pre><code>&lt;hr /&gt;
</code></pre>
<p>Hr&rsquo;s:</p>
<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</h1>
<p>This is <em>emphasized</em>, and so <em>is this</em>.</p>
<p>This is <strong>strong</strong>, and so <strong>is this</strong>.</p>
<p>An <em><a href="/url">emphasized link</a></em>.</p>
<p><strong><em>This is strong and em.</em></strong></p>
<p>So is <strong><em>this</em></strong> word.</p>
<p><strong><em>This is strong and em.</em></strong></p>
<p>So is <strong><em>this</em></strong> word.</p>
<p>This is code: <code>&gt;</code>, <code>$</code>, <code>\</code>, <code>\$</code>, <code>&lt;html&gt;</code>.</p>
<hr />
<h1>Smart quotes, ellipses, dashes</h1>
<p>&ldquo;Hello,&rdquo; said the spider. &ldquo;&lsquo;Shelob&rsquo; is my name.&rdquo;</p>
<p>&lsquo;A&rsquo;, &lsquo;B&rsquo;, and &lsquo;C&rsquo; are letters.</p>
<p>&lsquo;Oak,&rsquo; &lsquo;elm,&rsquo; and &lsquo;beech&rsquo; are names of trees. So is &lsquo;pine.&rsquo;</p>
<p>&lsquo;He said, &ldquo;I want to go.&rdquo;&rsquo; Were you alive in the 70&rsquo;s?</p>
<p>Here is some quoted &lsquo;<code>code</code>&rsquo; and a &ldquo;<a href="http://example.com/?foo=1&amp;bar=2">quoted link</a>&rdquo;.</p>
<p>Some dashes: one&mdash;two&mdash;three&mdash;four&mdash;five.</p>
<p>Dashes between numbers: 5&ndash;7, 255&ndash;66, 1987&ndash;1999.</p>
<p>Ellipses&hellip;and&hellip;and &hellip; .</p>
<hr />
<h1>LaTeX</h1>
<ul>
<li>\cite[22-23]{smith.1899}</li>
<li>\doublespacing</li>
<li>$2+2=4$</li>
<li>$x \in y$</li>
<li>$\alpha \wedge \omega$</li>
<li>$223$</li>
<li>$p$-Tree</li>
<li>$\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$</li>
<li>Here&rsquo;s one that has a line break in it: $\alpha + \omega \times x^2$.</li>
</ul>
<p>These shouldn&rsquo;t be math:</p>
<ul>
<li>To get the famous equation, write <code>$e = mc^2$</code>.</li>
<li>$22,000 is a <em>lot</em> of money. So is $34,000. (It worked if &ldquo;lot&rdquo; is emphasized.)</li>
<li>Escaped <code>$</code>: $73 <em>this should be emphasized</em> 23$.</li>
</ul>
<p>Here&rsquo;s a LaTeX table:</p>
<p>\begin{tabular}{|l|l|}\hline
Animal &amp; Number \\ \hline
Dog &amp; 2 \\
Cat &amp; 1 \\ \hline
\end{tabular}</p>
<hr />
<h1>Special Characters</h1>
<p>Here is some unicode:</p>
<ul>
<li>I hat: &Icirc;</li>
<li>o umlaut: &ouml;</li>
<li>section: &sect;</li>
<li>set membership: &isin;</li>
<li>copyright: &copy;</li>
</ul>
<p>AT&amp;T has an ampersand in their name.</p>
<p>AT&amp;T is another way to write it.</p>
<p>This &amp; that.</p>
<p>4 &lt; 5.</p>
<p>6 &gt; 5.</p>
<p>Backslash: \</p>
<p>Backtick: &lsquo;</p>
<p>Asterisk: *</p>
<p>Underscore: _</p>
<p>Left brace: {</p>
<p>Right brace: }</p>
<p>Left bracket: [</p>
<p>Right bracket: ]</p>
<p>Left paren: (</p>
<p>Right paren: )</p>
<p>Greater-than: &gt;</p>
<p>Hash: #</p>
<p>Period: .</p>
<p>Bang: !</p>
<p>Plus: +</p>
<p>Minus: -</p>
<hr />
<h1>Links</h1>
<h2>Explicit</h2>
<p>Just a <a href="/url/">URL</a>.</p>
<p><a href="/url/" title="title">URL and title</a>.</p>
<p><a href="/url/" title="title preceded by two spaces">URL and title</a>.</p>
<p><a href="/url/" title="title preceded by a tab">URL and title</a>.</p>
<p><a href="/url/" title="title with &ldquo;quotes&rdquo; in it">URL and title</a></p>
<p><a href="/url/" title="title with single quotes">URL and title</a></p>
<p><script type="text/javascript">
<!--
h='&#110;&#x6f;&#x77;&#104;&#x65;&#114;&#x65;&#46;&#110;&#x65;&#116;';a='&#64;';n='&#110;&#x6f;&#98;&#x6f;&#100;&#x79;';e=n+a+h;
document.write('<a h'+'ref'+'="ma'+'ilto'+':'+e+'">'+'Email link'+'<\/'+'a'+'>');
// -->
</script><noscript>&#x45;&#x6d;&#x61;&#x69;&#108;&#32;&#108;&#x69;&#110;&#x6b;&#32;&#40;&#110;&#x6f;&#98;&#x6f;&#100;&#x79;&#32;&#x61;&#116;&#32;&#110;&#x6f;&#x77;&#104;&#x65;&#114;&#x65;&#32;&#100;&#x6f;&#116;&#32;&#110;&#x65;&#116;&#x29;</noscript></p>
<p><a href="">Empty</a>.</p>
<h2>Reference</h2>
<p>Foo <a href="/url/">bar</a>.</p>
<p>Foo <a href="/url/">bar</a>.</p>
<p>Foo <a href="/url/">bar</a>.</p>
<p>With <a href="/url/">embedded [brackets]</a>.</p>
<p><a href="/url/">b</a> by itself should be a link.</p>
<p>Indented <a href="/url">once</a>.</p>
<p>Indented <a href="/url">twice</a>.</p>
<p>Indented <a href="/url">thrice</a>.</p>
<p>This should [not][] be a link.</p>
<pre><code>[not]: /url
</code></pre>
<p>Foo <a href="/url/" title="Title with &ldquo;quotes&rdquo; inside">bar</a>.</p>
<p>Foo <a href="/url/" title="Title with &ldquo;quote&rdquo; inside">biz</a>.</p>
<h2>With ampersands</h2>
<p>Here&rsquo;s a <a href="http://example.com/?foo=1&amp;bar=2">link with an ampersand in the URL</a>.</p>
<p>Here&rsquo;s a link with an amersand in the link text: <a href="http://att.com/" title="AT&amp;T">AT&amp;T</a>.</p>
<p>Here&rsquo;s an <a href="/script?foo=1&amp;bar=2">inline link</a>.</p>
<p>Here&rsquo;s an <a href="/script?foo=1&amp;bar=2">inline link in pointy braces</a>.</p>
<h2>Autolinks</h2>
<p>With an ampersand: <a href="http://example.com/?foo=1&amp;bar=2">http://example.com/?foo=1&amp;bar=2</a></p>
<ul>
<li>In a list?</li>
<li><a href="http://example.com/">http://example.com/</a></li>
<li>It should.</li>
</ul>
<p>An e-mail address: <script type="text/javascript">
<!--
h='&#110;&#x6f;&#x77;&#104;&#x65;&#114;&#x65;&#46;&#110;&#x65;&#116;';a='&#64;';n='&#110;&#x6f;&#98;&#x6f;&#100;&#x79;';e=n+a+h;
document.write('<a h'+'ref'+'="ma'+'ilto'+':'+e+'">'+e+'<\/'+'a'+'>');
// -->
</script><noscript>&#110;&#x6f;&#98;&#x6f;&#100;&#x79;&#32;&#x61;&#116;&#32;&#110;&#x6f;&#x77;&#104;&#x65;&#114;&#x65;&#32;&#100;&#x6f;&#116;&#32;&#110;&#x65;&#116;</noscript></p>
<blockquote>
<p>Blockquoted: <a href="http://example.com/">http://example.com/</a></p>
</blockquote>
<p>Auto-links should not occur here: <code>&lt;http://example.com/&gt;</code></p>
<pre><code>or here: &lt;http://example.com/&gt;
</code></pre>
<hr />
<h1>Images</h1>
<p>From &ldquo;Voyage dans la Lune&rdquo; by Georges Melies (1902):</p>
<p><img src="lalune.jpg" title="Voyage dans la Lune" alt="lalune"></p>
<p>Here is a movie <img src="movie.jpg" alt="movie"> icon.</p>
<hr />
<h1>Footnotes</h1>
<p>Here is a footnote reference,<sup class="footnoteRef" id="fnref1"><a href="#fn1">1</a></sup> and another.<sup class="footnoteRef" id="fnref2"><a href="#fn2">2</a></sup> This should <em>not</em> be a footnote reference, because it contains a space.[^my note] Here is an inline note.<sup class="footnoteRef" id="fnref3"><a href="#fn3">3</a></sup></p>
<blockquote>
<p>Notes can go in quotes.<sup class="footnoteRef" id="fnref4"><a href="#fn4">4</a></sup></p>
</blockquote>
<ol>
<li>And in list items.<sup class="footnoteRef" id="fnref5"><a href="#fn5">5</a></sup></li>
</ol>
<p>This paragraph should not be part of the note, as it is not indented.</p>
<div class="footnotes">
<hr />
<ol>
<li id="fn1"><p>Here is the footnote. It can go anywhere after the footnote reference. It need not be placed at the end of the document.</p>
<a href="#fnref1" class="footnoteBacklink" title="Jump back to footnote 1">&#8617;</a></li>
<li id="fn2"><p>Here&rsquo;s the long note. This one contains multiple blocks.</p>
<p>Subsequent blocks are indented to show that they belong to the footnote (as with list items).</p>
<pre><code> { &lt;code&gt; }
</code></pre>
<p>If you want, you can indent every line, but you can also be lazy and just indent the first line of each block.</p>
<a href="#fnref2" class="footnoteBacklink" title="Jump back to footnote 2">&#8617;</a></li>
<li id="fn3"><p>This is <em>easier</em> to type. Inline notes may contain <a href="http://google.com">links</a> and <code>]</code> verbatim characters.</p>
<a href="#fnref3" class="footnoteBacklink" title="Jump back to footnote 3">&#8617;</a></li>
<li id="fn4"><p>In quote.</p>
<a href="#fnref4" class="footnoteBacklink" title="Jump back to footnote 4">&#8617;</a></li>
<li id="fn5"><p>In list.</p>
<a href="#fnref5" class="footnoteBacklink" title="Jump back to footnote 5">&#8617;</a></li>
</ol>
</div>
</body>
</html>