diff options
29 files changed, 231 insertions, 277 deletions
diff --git a/src/Tests/Arbitrary.hs b/src/Tests/Arbitrary.hs index 986e3e4d5..9d65e1f1f 100644 --- a/src/Tests/Arbitrary.hs +++ b/src/Tests/Arbitrary.hs @@ -41,10 +41,6 @@ arbInline :: Int -> Gen Inline arbInline n = frequency $ [ (60, liftM Str realString) , (60, return Space) , (10, liftM2 Code arbAttr realString) - , (5, return EmDash) - , (5, return EnDash) - , (5, return Apostrophe) - , (5, return Ellipses) , (5, elements [ RawInline "html" "<a id=\"eek\">" , RawInline "latex" "\\my{command}" ]) ] ++ [ x | x <- nesters, n > 1] diff --git a/src/Tests/Readers/LaTeX.hs b/src/Tests/Readers/LaTeX.hs index 781867597..7d8aeb3e9 100644 --- a/src/Tests/Readers/LaTeX.hs +++ b/src/Tests/Readers/LaTeX.hs @@ -87,7 +87,7 @@ natbibCitations = testGroup "natbib" , "group" =: "\\citetext{\\citealp[see][p.~34--35]{item1}; \\citealp[also][chap. 3]{item3}}" =?> para (cite [baseCitation{ citationMode = NormalCitation , citationPrefix = [Str "see"] - , citationSuffix = [Str "p.\160\&34",EnDash,Str "35"] } + , citationSuffix = [Str "p.\160\&34",Str "-",Str "35"] } ,baseCitation{ citationMode = NormalCitation , citationId = "item3" , citationPrefix = [Str "also"] @@ -95,7 +95,7 @@ natbibCitations = testGroup "natbib" ] mempty) , "suffix and locator" =: "\\citep[pp.~33, 35--37, and nowhere else]{item1}" =?> para (cite [baseCitation{ citationMode = NormalCitation - , citationSuffix = [Str "pp.\160\&33,",Space,Str "35",EnDash,Str "37,",Space,Str "and",Space,Str "nowhere",Space, Str "else"] }] mempty) + , citationSuffix = [Str "pp.\160\&33,",Space,Str "35",Str "-",Str "37,",Space,Str "and",Space,Str "nowhere",Space, Str "else"] }] mempty) , "suffix only" =: "\\citep[and nowhere else]{item1}" =?> para (cite [baseCitation{ citationMode = NormalCitation , citationSuffix = toList $ text "and nowhere else" }] mempty) @@ -134,7 +134,7 @@ biblatexCitations = testGroup "biblatex" , "group" =: "\\autocites[see][p.~34--35]{item1}[also][chap. 3]{item3}" =?> para (cite [baseCitation{ citationMode = NormalCitation , citationPrefix = [Str "see"] - , citationSuffix = [Str "p.\160\&34",EnDash,Str "35"] } + , citationSuffix = [Str "p.\160\&34",Str "-",Str "35"] } ,baseCitation{ citationMode = NormalCitation , citationId = "item3" , citationPrefix = [Str "also"] @@ -142,7 +142,7 @@ biblatexCitations = testGroup "biblatex" ] mempty) , "suffix and locator" =: "\\autocite[pp.~33, 35--37, and nowhere else]{item1}" =?> para (cite [baseCitation{ citationMode = NormalCitation - , citationSuffix = [Str "pp.\160\&33,",Space,Str "35",EnDash,Str "37,",Space,Str "and",Space,Str "nowhere",Space, Str "else"] }] mempty) + , citationSuffix = [Str "pp.\160\&33,",Space,Str "35",Str "-",Str "37,",Space,Str "and",Space,Str "nowhere",Space, Str "else"] }] mempty) , "suffix only" =: "\\autocite[and nowhere else]{item1}" =?> para (cite [baseCitation{ citationMode = NormalCitation , citationSuffix = toList $ text "and nowhere else" }] mempty) diff --git a/src/Tests/Readers/Markdown.hs b/src/Tests/Readers/Markdown.hs index ca04b8e22..aa8a312ff 100644 --- a/src/Tests/Readers/Markdown.hs +++ b/src/Tests/Readers/Markdown.hs @@ -60,7 +60,7 @@ tests = [ testGroup "inline code" , testGroup "smart punctuation" [ test markdownSmart "quote before ellipses" ("'...hi'" - =?> para (singleQuoted (singleton Ellipses <> "hi"))) + =?> para (singleQuoted ("…hi"))) , test markdownSmart "apostrophe before emph" ("D'oh! A l'*aide*!" =?> para ("D’oh! A l’" <> emph "aide" <> "!")) diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index 78642b074..5fa375ca6 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -779,22 +779,22 @@ doubleQuoteEnd = do ellipses :: GenParser Char st Inline ellipses = do - try (charOrRef "…\133") <|> try (string "..." >> return '…') - return Ellipses + try (charOrRef "\8230\133") <|> try (string "..." >> return '…') + return (Str "\8230") dash :: GenParser Char st Inline dash = enDash <|> emDash enDash :: GenParser Char st Inline enDash = do - try (charOrRef "–\150") <|> + try (charOrRef "\8211\150") <|> try (char '-' >> lookAhead (satisfy isDigit) >> return '–') - return EnDash + return (Str "\8211") emDash :: GenParser Char st Inline emDash = do - try (charOrRef "—\151") <|> (try $ string "--" >> optional (char '-') >> return '—') - return EmDash + try (charOrRef "\8212\151") <|> (try $ string "--" >> optional (char '-') >> return '-') + return (Str "\8212") -- -- Macros diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index c418fef2a..708aa58c1 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -802,13 +802,13 @@ ellipses = try $ do optional $ char 'l' string "dots" optional $ try $ string "{}" - return Ellipses + return (Str "…") enDash :: GenParser Char st Inline -enDash = try (string "--") >> return EnDash +enDash = try (string "--") >> return (Str "-") emDash :: GenParser Char st Inline -emDash = try (string "---") >> return EmDash +emDash = try (string "---") >> return (Str "—") hyphen :: GenParser Char st Inline hyphen = char '-' >> return (Str "-") diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 96b2d4315..db68df629 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -1087,20 +1087,18 @@ nonEndline = satisfy (/='\n') str :: GenParser Char ParserState Inline str = do - st <- getState + smart <- stateSmart `fmap` getState a <- alphaNum as <- many $ alphaNum <|> (try $ char '_' >>~ lookAhead alphaNum) - <|> if stateStrict st - then mzero - else (try $ satisfy (\c -> c == '\'' || c == '\x2019') >> + <|> if smart + then (try $ satisfy (\c -> c == '\'' || c == '\x2019') >> lookAhead alphaNum >> return '\x2019') - -- for things like l'aide - would be better to return - -- an Apostrophe, but we can't in this context + -- for things like l'aide + else mzero let result = a:as - state <- getState let spacesToNbr = map (\c -> if c == ' ' then '\160' else c) - if stateSmart state + if smart then case likelyAbbrev result of [] -> return $ Str result xs -> choice (map (\x -> diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index fac965b89..301848d6e 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -325,10 +325,6 @@ stringify = queryWith go go (Str x) = x go (Code _ x) = x go (Math _ x) = x - go EmDash = "--" - go EnDash = "-" - go Apostrophe = "'" - go Ellipses = "..." go LineBreak = " " go _ = "" diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index f45c20e9e..1913eb92b 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -321,10 +321,6 @@ inlineToAsciiDoc opts (Quoted SingleQuote lst) = do inlineToAsciiDoc opts (Quoted DoubleQuote lst) = do contents <- inlineListToAsciiDoc opts lst return $ "``" <> contents <> "''" -inlineToAsciiDoc _ EmDash = return "\8212" -inlineToAsciiDoc _ EnDash = return "\8211" -inlineToAsciiDoc _ Apostrophe = return "\8217" -inlineToAsciiDoc _ Ellipses = return "\8230" inlineToAsciiDoc _ (Code _ str) = return $ text "`" <> text (escapeStringUsing (backslashEscapes "`") str) <> "`" inlineToAsciiDoc _ (Str str) = return $ text $ escapeString str diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index b59b71cf0..a6771437d 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -102,6 +102,10 @@ escapeCharForConTeXt ch = ']' -> "{]}" '_' -> "\\letterunderscore{}" '\160' -> "~" + '\x2014' -> "---" + '\x2013' -> "--" + '\x2019' -> "'" + '\x2026' -> "\\ldots{}" x -> [x] -- | Escape string for ConTeXt @@ -258,10 +262,6 @@ inlineToConTeXt (Quoted DoubleQuote lst) = do contents <- inlineListToConTeXt lst return $ "\\quotation" <> braces contents inlineToConTeXt (Cite _ lst) = inlineListToConTeXt lst -inlineToConTeXt Apostrophe = return $ char '\'' -inlineToConTeXt EmDash = return "---" -inlineToConTeXt EnDash = return "--" -inlineToConTeXt Ellipses = return "\\ldots{}" inlineToConTeXt (Str str) = return $ text $ stringToConTeXt str inlineToConTeXt (Math InlineMath str) = return $ char '$' <> text str <> char '$' diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 150033f3f..f3ac726a9 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -248,10 +248,6 @@ inlineToDocbook opts (Quoted _ lst) = inTagsSimple "quote" $ inlinesToDocbook opts lst inlineToDocbook opts (Cite _ lst) = inlinesToDocbook opts lst -inlineToDocbook _ Apostrophe = char '\'' -inlineToDocbook _ Ellipses = text "…" -inlineToDocbook _ EmDash = text "—" -inlineToDocbook _ EnDash = text "–" inlineToDocbook _ (Code _ str) = inTagsSimple "literal" $ text (escapeStringForXML str) inlineToDocbook opts (Math _ str) = inlinesToDocbook opts $ readTeXMath str diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 1cee2b8e6..e3ade3c9e 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -540,10 +540,6 @@ inlineToHtml opts inline = (Str str) -> return $ strToHtml str (Space) -> return $ strToHtml " " (LineBreak) -> return H.br - (EmDash) -> return $ strToHtml "—" - (EnDash) -> return $ strToHtml "–" - (Ellipses) -> return $ strToHtml "…" - (Apostrophe) -> return $ strToHtml "’" (Emph lst) -> inlineListToHtml opts lst >>= return . H.em (Strong lst) -> inlineListToHtml opts lst >>= return . H.strong (Code attr str) -> case highlight formatHtmlInline attr str of diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 117ecca51..dd11cd2fe 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -162,6 +162,8 @@ stringToLaTeX isUrl = escapeStringUsing latexEscapes , ('\x201C', "``") , ('\x201D', "''") , ('\x2026', "\\ldots{}") + , ('\x2014', "---") + , ('\x2013', "--") ] -- | Puts contents into LaTeX command. @@ -201,8 +203,8 @@ blockToLaTeX (CodeBlock (_,classes,keyvalAttr) str) = do then modify (\s -> s{ stVerbInNote = True }) >> return "Verbatim" else return "verbatim" - return $ flush (text $ "\\begin{" ++ env ++ "}") $$ text str $$ - text ("\\end{" ++ env ++ "}") $$ cr -- final cr because of notes + return $ flush (text ("\\begin{" ++ env ++ "}") $$ text str $$ + text ("\\end{" ++ env ++ "}")) $$ cr -- final cr because of notes listingsCodeBlock = do st <- get let params = if writerListings (stOptions st) @@ -236,7 +238,7 @@ blockToLaTeX (CodeBlock (_,classes,keyvalAttr) str) = do case highlight formatLaTeXBlock ("",classes,keyvalAttr) str of Nothing -> rawCodeBlock Just h -> modify (\st -> st{ stHighlighting = True }) >> - return (text h) + return (flush $ text h) blockToLaTeX (RawBlock "latex" x) = return $ text x <> blankline blockToLaTeX (RawBlock _ _) = return empty blockToLaTeX (BulletList lst) = do @@ -365,7 +367,6 @@ inlineListToLaTeX lst = mapM inlineToLaTeX lst >>= return . hcat isQuoted :: Inline -> Bool isQuoted (Quoted _ _) = True -isQuoted Apostrophe = True isQuoted _ = False -- | Convert inline element to LaTeX @@ -441,10 +442,6 @@ inlineToLaTeX (Quoted DoubleQuote lst) = do then "\\," else empty return $ "``" <> s1 <> contents <> s2 <> "''" -inlineToLaTeX Apostrophe = return $ char '\'' -inlineToLaTeX EmDash = return "---" -inlineToLaTeX EnDash = return "--" -inlineToLaTeX Ellipses = return "\\ldots{}" inlineToLaTeX (Str str) = return $ text $ stringToLaTeX False str inlineToLaTeX (Math InlineMath str) = return $ char '$' <> text str <> char '$' inlineToLaTeX (Math DisplayMath str) = return $ "\\[" <> text str <> "\\]" diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 78b9274d6..d3735efa7 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -98,7 +98,13 @@ noteToMan opts num note = do -- | Association list of characters to escape. manEscapes :: [(Char, String)] -manEscapes = [('\160', "\\ "), ('\'', "\\[aq]")] ++ backslashEscapes "@\\" +manEscapes = [ ('\160', "\\ ") + , ('\'', "\\[aq]") + , ('’', "'") + , ('\x2014', "\\[em]") + , ('\x2013', "\\[en]") + , ('\x2026', "\\&...") + ] ++ backslashEscapes "@\\" -- | Escape special characters for Man. escapeString :: String -> String @@ -303,10 +309,6 @@ inlineToMan opts (Quoted DoubleQuote lst) = do return $ text "\\[lq]" <> contents <> text "\\[rq]" inlineToMan opts (Cite _ lst) = inlineListToMan opts lst -inlineToMan _ EmDash = return $ text "\\[em]" -inlineToMan _ EnDash = return $ text "\\[en]" -inlineToMan _ Apostrophe = return $ char '\'' -inlineToMan _ Ellipses = return $ text "\\&..." inlineToMan _ (Code _ str) = return $ text $ "\\f[C]" ++ escapeCode str ++ "\\f[]" inlineToMan _ (Str str) = return $ text $ escapeString str diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 70202294f..f0f608432 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -432,10 +432,6 @@ inlineToMarkdown opts (Quoted SingleQuote lst) = do inlineToMarkdown opts (Quoted DoubleQuote lst) = do contents <- inlineListToMarkdown opts lst return $ "“" <> contents <> "”" -inlineToMarkdown _ EmDash = return "\8212" -inlineToMarkdown _ EnDash = return "\8211" -inlineToMarkdown _ Apostrophe = return "\8217" -inlineToMarkdown _ Ellipses = return "\8230" inlineToMarkdown opts (Code attr str) = let tickGroups = filter (\s -> '`' `elem` s) $ group str longest = if null tickGroups diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index a7c7fc482..f31a2c2d1 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -346,22 +346,14 @@ inlineToMediaWiki opts (SmallCaps lst) = inlineListToMediaWiki opts lst inlineToMediaWiki opts (Quoted SingleQuote lst) = do contents <- inlineListToMediaWiki opts lst - return $ "‘" ++ contents ++ "’" + return $ "\8216" ++ contents ++ "\8217" inlineToMediaWiki opts (Quoted DoubleQuote lst) = do contents <- inlineListToMediaWiki opts lst - return $ "“" ++ contents ++ "”" + return $ "\8220" ++ contents ++ "\8221" inlineToMediaWiki opts (Cite _ lst) = inlineListToMediaWiki opts lst -inlineToMediaWiki _ EmDash = return "—" - -inlineToMediaWiki _ EnDash = return "–" - -inlineToMediaWiki _ Apostrophe = return "’" - -inlineToMediaWiki _ Ellipses = return "…" - inlineToMediaWiki _ (Code _ str) = return $ "<tt>" ++ (escapeString str) ++ "</tt>" diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index e675f4e65..23ef2e31d 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -154,8 +154,8 @@ inHeaderTags i d = , ("text:outline-level", show i)] d inQuotes :: QuoteType -> Doc -> Doc -inQuotes SingleQuote s = text "‘" <> s <> text "’" -inQuotes DoubleQuote s = text "“" <> s <> text "”" +inQuotes SingleQuote s = char '\8216' <> s <> char '\8217' +inQuotes DoubleQuote s = char '\8220' <> s <> char '\8221' handleSpaces :: String -> Doc handleSpaces s @@ -361,10 +361,6 @@ inlinesToOpenDocument o l = hcat <$> mapM (inlineToOpenDocument o) l -- | Convert an inline element to OpenDocument. inlineToOpenDocument :: WriterOptions -> Inline -> State WriterState Doc inlineToOpenDocument o ils - | Ellipses <- ils = inTextStyle $ text "…" - | EmDash <- ils = inTextStyle $ text "—" - | EnDash <- ils = inTextStyle $ text "–" - | Apostrophe <- ils = inTextStyle $ text "’" | Space <- ils = inTextStyle space | LineBreak <- ils = return $ selfClosingTag "text:line-break" [] | Str s <- ils = inTextStyle $ handleSpaces $ escapeStringForXML s diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 6e0fb98e1..4c77ba7c6 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -95,7 +95,12 @@ noteToOrg num note = do -- | Escape special characters for Org. escapeString :: String -> String -escapeString = escapeStringUsing (backslashEscapes "^_") +escapeString = escapeStringUsing $ + [ ('\x2014',"---") + , ('\x2013',"--") + , ('\x2019',"'") + , ('\x2026',"...") + ] ++ backslashEscapes "^_" titleToOrg :: [Inline] -> State WriterState Doc titleToOrg [] = return empty @@ -249,10 +254,6 @@ inlineToOrg (Quoted DoubleQuote lst) = do contents <- inlineListToOrg lst return $ "\"" <> contents <> "\"" inlineToOrg (Cite _ lst) = inlineListToOrg lst -inlineToOrg EmDash = return "---" -inlineToOrg EnDash = return "--" -inlineToOrg Apostrophe = return "'" -inlineToOrg Ellipses = return "..." inlineToOrg (Code _ str) = return $ "=" <> text str <> "=" inlineToOrg (Str str) = return $ text $ escapeString str inlineToOrg (Math t str) = do diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 0f0479e16..125ed4f13 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -281,10 +281,6 @@ inlineToRST (Quoted DoubleQuote lst) = do return $ "“" <> contents <> "”" inlineToRST (Cite _ lst) = inlineListToRST lst -inlineToRST EmDash = return $ char '\8212' -inlineToRST EnDash = return $ char '\8211' -inlineToRST Apostrophe = return $ char '\8217' -inlineToRST Ellipses = return $ char '\8230' inlineToRST (Code _ str) = return $ "``" <> text str <> "``" inlineToRST (Str str) = return $ text $ escapeString str inlineToRST (Math t str) = do diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index eb36c1ca6..4e7c2a7cd 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -106,7 +106,15 @@ handleUnicode (c:cs) = -- | Escape special characters. escapeSpecial :: String -> String -escapeSpecial = escapeStringUsing (('\t',"\\tab "):(backslashEscapes "{\\}")) +escapeSpecial = escapeStringUsing $ + [ ('\t',"\\tab ") + , ('\8216',"\\u8216'") + , ('\8217',"\\u8217'") + , ('\8220',"\\u8220\"") + , ('\8221',"\\u8221\"") + , ('\8211',"\\u8211-") + , ('\8212',"\\u8212-") + ] ++ backslashEscapes "{\\}" -- | Escape strings as needed for rich text format. stringToRTF :: String -> String @@ -287,10 +295,6 @@ inlineToRTF (Quoted SingleQuote lst) = "\\u8216'" ++ (inlineListToRTF lst) ++ "\\u8217'" inlineToRTF (Quoted DoubleQuote lst) = "\\u8220\"" ++ (inlineListToRTF lst) ++ "\\u8221\"" -inlineToRTF Apostrophe = "\\u8217'" -inlineToRTF Ellipses = "\\u8230?" -inlineToRTF EmDash = "\\u8212-" -inlineToRTF EnDash = "\\u8211-" inlineToRTF (Code _ str) = "{\\f1 " ++ (codeStringToRTF str) ++ "}" inlineToRTF (Str str) = stringToRTF str inlineToRTF (Math _ str) = inlineListToRTF $ readTeXMath str diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 4f6645cd5..563ad7044 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -96,6 +96,10 @@ stringToTexinfo = escapeStringUsing texinfoEscapes , ('@', "@@") , (',', "@comma{}") -- only needed in argument lists , ('\160', "@ ") + , ('\x2014', "---") + , ('\x2013', "--") + , ('\x2026', "@dots{}") + , ('\x2019', "'") ] -- | Puts contents into Texinfo command. @@ -387,10 +391,6 @@ inlineToTexinfo (Quoted DoubleQuote lst) = do inlineToTexinfo (Cite _ lst) = inlineListToTexinfo lst -inlineToTexinfo Apostrophe = return $ char '\'' -inlineToTexinfo EmDash = return $ text "---" -inlineToTexinfo EnDash = return $ text "--" -inlineToTexinfo Ellipses = return $ text "@dots{}" inlineToTexinfo (Str str) = return $ text (stringToTexinfo str) inlineToTexinfo (Math _ str) = return $ inCmd "math" $ text str inlineToTexinfo (RawInline f str) | f == "latex" || f == "tex" = diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 6614ec28e..26d5ec6d7 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -72,15 +72,19 @@ withUseTags action = do -- | Escape one character as needed for Textile. escapeCharForTextile :: Char -> String escapeCharForTextile x = case x of - '&' -> "&" - '<' -> "<" - '>' -> ">" - '"' -> """ - '*' -> "*" - '_' -> "_" - '@' -> "@" - '|' -> "|" - c -> [c] + '&' -> "&" + '<' -> "<" + '>' -> ">" + '"' -> """ + '*' -> "*" + '_' -> "_" + '@' -> "@" + '|' -> "|" + '\x2014' -> " -- " + '\x2013' -> " - " + '\x2019' -> "'" + '\x2026' -> "..." + c -> [c] -- | Escape string as needed for Textile. escapeStringForTextile :: String -> String @@ -370,14 +374,6 @@ inlineToTextile opts (Quoted DoubleQuote lst) = do inlineToTextile opts (Cite _ lst) = inlineListToTextile opts lst -inlineToTextile _ EmDash = return " -- " - -inlineToTextile _ EnDash = return " - " - -inlineToTextile _ Apostrophe = return "'" - -inlineToTextile _ Ellipses = return "..." - inlineToTextile _ (Code _ str) = return $ if '@' `elem` str then "<tt>" ++ escapeStringForXML str ++ "</tt>" diff --git a/tests/latex-reader.native b/tests/latex-reader.native index a5e14dd8f..c2ac98c56 100644 --- a/tests/latex-reader.native +++ b/tests/latex-reader.native @@ -1,5 +1,5 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docAuthors = [[Str "John",Space,Str "MacFarlane"],[Str "Anonymous"]], docDate = [Str "July",Space,Str "17,",Space,Str "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",Apostrophe,Str "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.",Space,Str "Most",Space,Str "of",Space,Str "them",Space,Str "are",Space,Str "adapted",Space,Str "from",Space,Str "John",Space,Str "Gruber",Str "\8217",Str "s",Space,Str "markdown",Space,Str "test",Space,Str "suite."] ,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"] ("/url","")] @@ -14,9 +14,9 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Str "with",Space,Str "no",Space,Str "blank",Space,Str "line"] ,HorizontalRule ,Header 1 [Str "Paragraphs"] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "regular",Space,Str "paragraph."] +,Para [Str "Here",Str "\8217",Str "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",Apostrophe,Str "s",Space,Str "one",Space,Str "with",Space,Str "a",Space,Str "bullet.",Space,Str "*",Space,Str "criminey."] +,Para [Str "Here",Str "\8217",Str "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."] ,HorizontalRule ,Header 1 [Str "Block",Space,Str "Quotes"] @@ -44,11 +44,11 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA [OrderedList (1,Decimal,Period) [[Para [Str "do",Space,Str "laundry"]] ,[Para [Str "take",Space,Str "out",Space,Str "the",Space,Str "trash"]]]] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "nested",Space,Str "one:"] +,Para [Str "Here",Str "\8217",Str "s",Space,Str "a",Space,Str "nested",Space,Str "one:"] ,BlockQuote [Para [Str "Joe",Space,Str "said:"] ,BlockQuote - [Para [Str "Don",Apostrophe,Str "t",Space,Str "quote",Space,Str "me."]]] + [Para [Str "Don",Str "\8217",Str "t",Space,Str "quote",Space,Str "me."]]] ,Para [Str "And",Space,Str "a",Space,Str "following",Space,Str "paragraph."] ,HorizontalRule ,Header 1 [Str "Code",Space,Str "Blocks"] @@ -113,7 +113,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Str "Multiple",Space,Str "paragraphs:"] ,OrderedList (1,Decimal,Period) [[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",Apostrophe,Str "s",Space,Str "back."]] + ,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",Str "\8217",Str "s",Space,Str "back."]] ,[Para [Str "Item",Space,Str "2."]] ,[Para [Str "Item",Space,Str "3."]]] ,Header 2 [Str "Nested"] @@ -123,7 +123,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA [[Para [Str "Tab"] ,BulletList [[Para [Str "Tab"]]]]]]] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "another:"] +,Para [Str "Here",Str "\8217",Str "s",Space,Str "another:"] ,OrderedList (1,Decimal,Period) [[Para [Str "First"]] ,[Para [Str "Second:"] @@ -217,7 +217,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Str "Simple",Space,Str "block",Space,Str "on",Space,Str "one",Space,Str "line:"] ,Para [Str "foo",Space,Str "And",Space,Str "nested",Space,Str "without",Space,Str "indentation:"] ,Para [Str "foo",Space,Str "bar",Space,Str "Interpreted",Space,Str "markdown",Space,Str "in",Space,Str "a",Space,Str "table:"] -,Para [Str "This",Space,Str "is",Space,Emph [Str "emphasized"],Space,Str "And",Space,Str "this",Space,Str "is",Space,Strong [Str "strong"],Space,Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "simple",Space,Str "block:"] +,Para [Str "This",Space,Str "is",Space,Emph [Str "emphasized"],Space,Str "And",Space,Str "this",Space,Str "is",Space,Strong [Str "strong"],Space,Str "Here",Str "\8217",Str "s",Space,Str "a",Space,Str "simple",Space,Str "block:"] ,Para [Str "foo",Space,Str "This",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "code",Space,Str "block,",Space,Str "though:"] ,CodeBlock ("",[],[]) "<div>\n foo\n</div>" ,Para [Str "As",Space,Str "should",Space,Str "this:"] @@ -230,7 +230,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Str "Just",Space,Str "plain",Space,Str "comment,",Space,Str "with",Space,Str "trailing",Space,Str "spaces",Space,Str "on",Space,Str "the",Space,Str "line:"] ,Para [Str "Code:"] ,CodeBlock ("",[],[]) "<hr />" -,Para [Str "Hr",Apostrophe,Str "s:"] +,Para [Str "Hr",Str "\8217",Str "s:"] ,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 "."] @@ -250,11 +250,11 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Quoted DoubleQuote [Str "Hello,"],Space,Str "said",Space,Str "the",Space,Str "spider.",Space,Quoted DoubleQuote [Quoted SingleQuote [Str "Shelob"],Space,Str "is",Space,Str "my",Space,Str "name."]] ,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."] ,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.",Space,Str "So",Space,Str "is",Space,Quoted SingleQuote [Str "pine."]] -,Para [Quoted SingleQuote [Str "He",Space,Str "said,",Space,Quoted DoubleQuote [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",Apostrophe,Str "s?"] +,Para [Quoted SingleQuote [Str "He",Space,Str "said,",Space,Quoted DoubleQuote [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",Str "\8217",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"] ("http://example.com/?foo=1&bar=2","")],Str "."] -,Para [Str "Some",Space,Str "dashes:",Space,Str "one",EmDash,Str "two",EmDash,Str "three",EmDash,Str "four",EmDash,Str "five."] -,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."] -,Para [Str "Ellipses",Ellipses,Str "and",Ellipses,Str "and",Ellipses,Str "."] +,Para [Str "Some",Space,Str "dashes:",Space,Str "one",Str "\8212",Str "two",Str "\8212",Str "three",Str "\8212",Str "four",Str "\8212",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",Str "\8230",Str "and",Str "\8230",Str "and",Str "\8230",Str "."] ,HorizontalRule ,Header 1 [Str "LaTeX"] ,BulletList @@ -266,13 +266,13 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,[Para [Math InlineMath "223"]] ,[Para [Math InlineMath "p",Str "-",Str "Tree"]] ,[Para [Math InlineMath "\\frac{d}{dx}f(x)=\\lim_{h\\to 0}\\frac{f(x+h)-f(x)}{h}"]] - ,[Para [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,Math InlineMath "\\alpha + \\omega \\times x^2",Str "."]]] -,Para [Str "These",Space,Str "shouldn",Apostrophe,Str "t",Space,Str "be",Space,Str "math:"] + ,[Para [Str "Here",Str "\8217",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,Math InlineMath "\\alpha + \\omega \\times x^2",Str "."]]] +,Para [Str "These",Space,Str "shouldn",Str "\8217",Str "t",Space,Str "be",Space,Str "math:"] ,BulletList [[Para [Str "To",Space,Str "get",Space,Str "the",Space,Str "famous",Space,Str "equation,",Space,Str "write",Space,Code ("",[],[]) "$e = mc^2$",Str "."]] ,[Para [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,Quoted DoubleQuote [Str "lot"],Space,Str "is",Space,Str "emphasized.)"]] ,[Para [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",Apostrophe,Str "s",Space,Str "a",Space,Str "LaTeX",Space,Str "table:"] +,Para [Str "Here",Str "\8217",Str "s",Space,Str "a",Space,Str "LaTeX",Space,Str "table:"] ,Table [] [AlignLeft,AlignLeft] [0.0,0.0] [[Plain [Str "Animal"]] ,[Plain [Str "Number"]]] @@ -336,10 +336,10 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Str "Foo",Space,Link [Str "bar"] ("/url/",""),Str "."] ,Para [Str "Foo",Space,Link [Str "biz"] ("/url/",""),Str "."] ,Header 2 [Str "With",Space,Str "ampersands"] -,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"] ("http://example.com/?foo=1&bar=2",""),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",Str "&",Str "T"] ("http://att.com/",""),Str "."] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "an",Space,Link [Str "inline",Space,Str "link"] ("/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"] ("/script?foo=1&bar=2",""),Str "."] +,Para [Str "Here",Str "\8217",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"] ("http://example.com/?foo=1&bar=2",""),Str "."] +,Para [Str "Here",Str "\8217",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",Str "&",Str "T"] ("http://att.com/",""),Str "."] +,Para [Str "Here",Str "\8217",Str "s",Space,Str "an",Space,Link [Str "inline",Space,Str "link"] ("/script?foo=1&bar=2",""),Str "."] +,Para [Str "Here",Str "\8217",Str "s",Space,Str "an",Space,Link [Str "inline",Space,Str "link",Space,Str "in",Space,Str "pointy",Space,Str "braces"] ("/script?foo=1&bar=2",""),Str "."] ,Header 2 [Str "Autolinks"] ,Para [Str "With",Space,Str "an",Space,Str "ampersand:",Space,Link [Code ("",["url"],[]) "http://example.com/?foo=1&bar=2"] ("http://example.com/?foo=1&bar=2","")] ,BulletList @@ -358,7 +358,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "movie",Space,Image [Str "image"] ("movie.jpg",""),Space,Str "icon."] ,HorizontalRule ,Header 1 [Str "Footnotes"] -,Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "footnote",Space,Str "reference,",Note [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."]],Space,Str "and",Space,Str "another.",Note [Para [Str "Here",Apostrophe,Str "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)."],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."]],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.",Note [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"] ("http://google.com",""),Space,Str "and",Space,Code ("",[],[]) "]",Space,Str "verbatim",Space,Str "characters,",Space,Str "as",Space,Str "well",Space,Str "as",Space,Str "[",Str "bracketed",Space,Str "text",Str "]",Str "."]]] +,Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "footnote",Space,Str "reference,",Note [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."]],Space,Str "and",Space,Str "another.",Note [Para [Str "Here",Str "\8217",Str "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)."],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."]],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.",Note [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"] ("http://google.com",""),Space,Str "and",Space,Code ("",[],[]) "]",Space,Str "verbatim",Space,Str "characters,",Space,Str "as",Space,Str "well",Space,Str "as",Space,Str "[",Str "bracketed",Space,Str "text",Str "]",Str "."]]] ,BlockQuote [Para [Str "Notes",Space,Str "can",Space,Str "go",Space,Str "in",Space,Str "quotes.",Note [Para [Str "In",Space,Str "quote."]]]] ,OrderedList (1,Decimal,Period) diff --git a/tests/rst-reader.native b/tests/rst-reader.native index 3e521cb7c..612db85bd 100644 --- a/tests/rst-reader.native +++ b/tests/rst-reader.native @@ -3,26 +3,26 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite",Str ": [([Str "Revision"], [[Para [Str "3"]]])] ,Header 1 [Str "Level",Space,Str "one",Space,Str "header"] -,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 "."] +,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",Str "\8217",Str "s",Space,Str "markdown",Space,Str "test",Space,Str "suite",Str "."] ,Header 2 [Str "Level",Space,Str "two",Space,Str "header"] ,Header 3 [Str "Level",Space,Str "three"] ,Header 4 [Str "Level",Space,Str "four",Space,Str "with",Space,Emph [Str "emphasis"]] ,Header 5 [Str "Level",Space,Str "five"] ,Header 1 [Str "Paragraphs"] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "regular",Space,Str "paragraph",Str "."] +,Para [Str "Here",Str "\8217",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 "Here",Str "\8217",Str "s",Space,Str "one",Space,Str "with",Space,Str "a",Space,Str "bullet",Str ".",Space,Str "*",Space,Str "criminey",Str "."] ,Para [Str "Horizontal",Space,Str "rule",Str ":"] ,HorizontalRule ,Para [Str "Another",Str ":"] ,HorizontalRule ,Header 1 [Str "Block",Space,Str "Quotes"] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "block",Space,Str "quote",Str ":"] +,Para [Str "Here",Str "\8217",Str "s",Space,Str "a",Space,Str "block",Space,Str "quote",Str ":"] ,BlockQuote [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 "."]] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "another,",Space,Str "differently",Space,Str "indented",Str ":"] +,Para [Str "Here",Str "\8217",Str "s",Space,Str "another,",Space,Str "differently",Space,Str "indented",Str ":"] ,BlockQuote - [Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "block",Space,Str "quote",Str ".",Space,Str "It",Apostrophe,Str "s",Space,Str "indented",Space,Str "with",Space,Str "a",Space,Str "tab",Str "."] + [Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "block",Space,Str "quote",Str ".",Space,Str "It",Str "\8217",Str "s",Space,Str "indented",Space,Str "with",Space,Str "a",Space,Str "tab",Str "."] ,Para [Str "Code",Space,Str "in",Space,Str "a",Space,Str "block",Space,Str "quote",Str ":"] ,CodeBlock ("",[],[]) "sub status {\n print \"working\";\n}" ,Para [Str "List",Space,Str "in",Space,Str "a",Space,Str "block",Space,Str "quote",Str ":"] @@ -98,7 +98,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite",Str ": ,Para [Str "Multiple",Space,Str "paragraphs",Str ":"] ,OrderedList (1,Decimal,Period) [[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 "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",Str "\8217",Str "s",Space,Str "back",Str "."]] ,[Para [Str "Item",Space,Str "2",Str "."]] ,[Para [Str "Item",Space,Str "3",Str "."]]] ,Para [Str "Nested",Str ":"] @@ -108,7 +108,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite",Str ": [[Para [Str "Tab"] ,BulletList [[Plain [Str "Tab"]]]]]]] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "another",Str ":"] +,Para [Str "Here",Str "\8217",Str "s",Space,Str "another",Str ":"] ,OrderedList (1,Decimal,Period) [[Para [Str "First"]] ,[Para [Str "Second",Str ":"] @@ -165,14 +165,14 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite",Str ": ,([Str "city"], [[Para [Emph [Str "Nowhere"],Str ",",Space,Str "MA,",Space,Str "USA"]]]) ,([Str "phone"], - [[Para [Str "123",EnDash,Str "4567"]]])]] + [[Para [Str "123",Str "\8211",Str "4567"]]])]] ,DefinitionList [([Str "address"], [[Para [Str "61",Space,Str "Main",Space,Str "St",Str "."]]]) ,([Str "city"], [[Para [Emph [Str "Nowhere"],Str ",",Space,Str "MA,",Space,Str "USA"]]]) ,([Str "phone"], - [[Para [Str "123",EnDash,Str "4567"]]])] + [[Para [Str "123",Str "\8211",Str "4567"]]])] ,Header 1 [Str "HTML",Space,Str "Blocks"] ,Para [Str "Simple",Space,Str "block",Space,Str "on",Space,Str "one",Space,Str "line",Str ":"] ,RawBlock "html" "<div>foo</div>\n" @@ -216,8 +216,8 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite",Str ": ,Para [Str "Explicit",Str ":",Space,Str "a",Space,Link [Str "URL"] ("/url/",""),Str "."] ,Para [Str "Two",Space,Str "anonymous",Space,Str "links",Str ":",Space,Link [Str "the",Space,Str "first"] ("/url1/",""),Space,Str "and",Space,Link [Str "the",Space,Str "second"] ("/url2/","")] ,Para [Str "Reference",Space,Str "links",Str ":",Space,Link [Str "link1"] ("/url1/",""),Space,Str "and",Space,Link [Str "link2"] ("/url2/",""),Space,Str "and",Space,Link [Str "link1"] ("/url1/",""),Space,Str "again",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"] ("http://example.com/?foo=1&bar=2",""),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",Str ":",Space,Link [Str "AT&T"] ("/url/",""),Str "."] +,Para [Str "Here",Str "\8217",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"] ("http://example.com/?foo=1&bar=2",""),Str "."] +,Para [Str "Here",Str "\8217",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",Str ":",Space,Link [Str "AT&T"] ("/url/",""),Str "."] ,Para [Str "Autolinks",Str ":",Space,Link [Str "http://example.com/?foo=1&bar=2"] ("http://example.com/?foo=1&bar=2",""),Space,Str "and",Space,Link [Str "nobody@nowhere.net"] ("mailto:nobody@nowhere.net",""),Str "."] ,Para [Str "But",Space,Str "not",Space,Str "here",Str ":"] ,CodeBlock ("",[],[]) "http://example.com/" diff --git a/tests/testsuite.native b/tests/testsuite.native index 879cb24fc..691c4959a 100644 --- a/tests/testsuite.native +++ b/tests/testsuite.native @@ -1,5 +1,5 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docAuthors = [[Str "John",Space,Str "MacFarlane"],[Str "Anonymous"]], docDate = [Str "July",Space,Str "17",Str ",",Space,Str "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",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 "."] +[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\8217s",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"] ("/url","")] @@ -14,9 +14,9 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Str "with",Space,Str "no",Space,Str "blank",Space,Str "line"] ,HorizontalRule ,Header 1 [Str "Paragraphs"] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "regular",Space,Str "paragraph",Str "."] +,Para [Str "Here\8217s",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 "Here\8217s",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"] @@ -100,7 +100,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Str "Multiple",Space,Str "paragraphs",Str ":"] ,OrderedList (1,Decimal,Period) [[Para [Str "Item",Space,Str "1",Str ",",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 "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\8217s",Space,Str "back",Str "."]] ,[Para [Str "Item",Space,Str "2",Str "."]] ,[Para [Str "Item",Space,Str "3",Str "."]]] ,Header 2 [Str "Nested"] @@ -110,7 +110,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA [[Plain [Str "Tab"] ,BulletList [[Plain [Str "Tab"]]]]]]] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "another",Str ":"] +,Para [Str "Here\8217s",Space,Str "another",Str ":"] ,OrderedList (1,Decimal,Period) [[Plain [Str "First"]] ,[Plain [Str "Second",Str ":"] @@ -243,7 +243,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,RawBlock "html" "</td>\n<td>" ,Plain [Str "And",Space,Str "this",Space,Str "is",Space,Strong [Str "strong"]] ,RawBlock "html" "</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",Apostrophe,Str "s",Space,Str "a",Space,Str "simple",Space,Str "block",Str ":"] +,Para [Str "Here\8217s",Space,Str "a",Space,Str "simple",Space,Str "block",Str ":"] ,RawBlock "html" "<div>\n " ,Plain [Str "foo"] ,RawBlock "html" "</div>\n" @@ -265,7 +265,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,RawBlock "html" "<!-- foo --> \n" ,Para [Str "Code",Str ":"] ,CodeBlock ("",[],[]) "<hr />" -,Para [Str "Hr",Apostrophe,Str "s",Str ":"] +,Para [Str "Hr\8217s",Str ":"] ,RawBlock "html" "<hr>\n\n<hr />\n\n<hr />\n\n<hr> \n\n<hr /> \n\n<hr /> \n\n<hr class=\"foo\" id=\"bar\" />\n\n<hr class=\"foo\" id=\"bar\" />\n\n<hr class=\"foo\" id=\"bar\">\n" ,HorizontalRule ,Header 1 [Str "Inline",Space,Str "Markup"] @@ -286,11 +286,11 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Quoted DoubleQuote [Str "Hello",Str ","],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",Str ","],Space,Quoted SingleQuote [Str "elm",Str ","],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",Str ",",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",Str "?"] +,Para [Quoted SingleQuote [Str "He",Space,Str "said",Str ",",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\8217s",Str "?"] ,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"] ("http://example.com/?foo=1&bar=2","")],Str "."] -,Para [Str "Some",Space,Str "dashes",Str ":",Space,Str "one",EmDash,Str "two",Space,EmDash,Space,Str "three",EmDash,Str "four",Space,EmDash,Space,Str "five",Str "."] -,Para [Str "Dashes",Space,Str "between",Space,Str "numbers",Str ":",Space,Str "5",EnDash,Str "7",Str ",",Space,Str "255",EnDash,Str "66",Str ",",Space,Str "1987",EnDash,Str "1999",Str "."] -,Para [Str "Ellipses",Ellipses,Str "and",Ellipses,Str "and",Ellipses,Str "."] +,Para [Str "Some",Space,Str "dashes",Str ":",Space,Str "one",Str "\8212",Str "two",Space,Str "\8212",Space,Str "three",Str "\8212",Str "four",Space,Str "\8212",Space,Str "five",Str "."] +,Para [Str "Dashes",Space,Str "between",Space,Str "numbers",Str ":",Space,Str "5",Str "\8211",Str "7",Str ",",Space,Str "255",Str "\8211",Str "66",Str ",",Space,Str "1987",Str "\8211",Str "1999",Str "."] +,Para [Str "Ellipses",Str "\8230",Str "and",Str "\8230",Str "and",Str "\8230",Str "."] ,HorizontalRule ,Header 1 [Str "LaTeX"] ,BulletList @@ -300,15 +300,15 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,[Plain [Math InlineMath "\\alpha \\wedge \\omega"]] ,[Plain [Math InlineMath "223"]] ,[Plain [Math InlineMath "p",Str "-",Str "Tree"]] - ,[Plain [Str "Here",Apostrophe,Str "s",Space,Str "some",Space,Str "display",Space,Str "math",Str ":",Space,Math DisplayMath "\\frac{d}{dx}f(x)=\\lim_{h\\to 0}\\frac{f(x+h)-f(x)}{h}"]] - ,[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",Str ":",Space,Math InlineMath "\\alpha + \\omega \\times x^2",Str "."]]] -,Para [Str "These",Space,Str "shouldn",Apostrophe,Str "t",Space,Str "be",Space,Str "math",Str ":"] + ,[Plain [Str "Here\8217s",Space,Str "some",Space,Str "display",Space,Str "math",Str ":",Space,Math DisplayMath "\\frac{d}{dx}f(x)=\\lim_{h\\to 0}\\frac{f(x+h)-f(x)}{h}"]] + ,[Plain [Str "Here\8217s",Space,Str "one",Space,Str "that",Space,Str "has",Space,Str "a",Space,Str "line",Space,Str "break",Space,Str "in",Space,Str "it",Str ":",Space,Math InlineMath "\\alpha + \\omega \\times x^2",Str "."]]] +,Para [Str "These",Space,Str "shouldn\8217t",Space,Str "be",Space,Str "math",Str ":"] ,BulletList [[Plain [Str "To",Space,Str "get",Space,Str "the",Space,Str "famous",Space,Str "equation",Str ",",Space,Str "write",Space,Code ("",[],[]) "$e = mc^2$",Str "."]] ,[Plain [Str "$",Str "22",Str ",",Str "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",Str ",",Str "000",Str ".",Space,Str "(",Str "It",Space,Str "worked",Space,Str "if",Space,Quoted DoubleQuote [Str "lot"],Space,Str "is",Space,Str "emphasized",Str ".",Str ")"]] ,[Plain [Str "Shoes",Space,Str "(",Str "$",Str "20",Str ")",Space,Str "and",Space,Str "socks",Space,Str "(",Str "$",Str "5",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",Apostrophe,Str "s",Space,Str "a",Space,Str "LaTeX",Space,Str "table",Str ":"] +,Para [Str "Here\8217s",Space,Str "a",Space,Str "LaTeX",Space,Str "table",Str ":"] ,RawBlock "latex" "\\begin{tabular}{|l|l|}\\hline\nAnimal & Number \\\\ \\hline\nDog & 2 \\\\\nCat & 1 \\\\ \\hline\n\\end{tabular}" ,HorizontalRule ,Header 1 [Str "Special",Space,Str "Characters"] @@ -366,10 +366,10 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Str "Foo",Space,Link [Str "bar"] ("/url/","Title with \"quotes\" inside"),Str "."] ,Para [Str "Foo",Space,Link [Str "biz"] ("/url/","Title with \"quote\" inside"),Str "."] ,Header 2 [Str "With",Space,Str "ampersands"] -,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"] ("http://example.com/?foo=1&bar=2",""),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",Str ":",Space,Link [Str "AT",Str "&",Str "T"] ("http://att.com/","AT&T"),Str "."] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "an",Space,Link [Str "inline",Space,Str "link"] ("/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"] ("/script?foo=1&bar=2",""),Str "."] +,Para [Str "Here\8217s",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"] ("http://example.com/?foo=1&bar=2",""),Str "."] +,Para [Str "Here\8217s",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",Str ":",Space,Link [Str "AT",Str "&",Str "T"] ("http://att.com/","AT&T"),Str "."] +,Para [Str "Here\8217s",Space,Str "an",Space,Link [Str "inline",Space,Str "link"] ("/script?foo=1&bar=2",""),Str "."] +,Para [Str "Here\8217s",Space,Str "an",Space,Link [Str "inline",Space,Str "link",Space,Str "in",Space,Str "pointy",Space,Str "braces"] ("/script?foo=1&bar=2",""),Str "."] ,Header 2 [Str "Autolinks"] ,Para [Str "With",Space,Str "an",Space,Str "ampersand",Str ":",Space,Link [Code ("",["url"],[]) "http://example.com/?foo=1&bar=2"] ("http://example.com/?foo=1&bar=2","")] ,BulletList @@ -388,7 +388,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "movie",Space,Image [Str "movie"] ("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",Str ",",Note [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 "."]],Space,Str "and",Space,Str "another",Str ".",Note [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 "(",Str "as",Space,Str "with",Space,Str "list",Space,Str "items",Str ")",Str "."],CodeBlock ("",[],[]) " { <code> }",Para [Str "If",Space,Str "you",Space,Str "want",Str ",",Space,Str "you",Space,Str "can",Space,Str "indent",Space,Str "every",Space,Str "line",Str ",",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 "."]],Space,Str "This",Space,Str "should",Space,Emph [Str "not"],Space,Str "be",Space,Str "a",Space,Str "footnote",Space,Str "reference",Str ",",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 ".",Note [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"] ("http://google.com",""),Space,Str "and",Space,Code ("",[],[]) "]",Space,Str "verbatim",Space,Str "characters",Str ",",Space,Str "as",Space,Str "well",Space,Str "as",Space,Str "[",Str "bracketed",Space,Str "text",Str "]",Str "."]]] +,Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "footnote",Space,Str "reference",Str ",",Note [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 "."]],Space,Str "and",Space,Str "another",Str ".",Note [Para [Str "Here\8217s",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 "(",Str "as",Space,Str "with",Space,Str "list",Space,Str "items",Str ")",Str "."],CodeBlock ("",[],[]) " { <code> }",Para [Str "If",Space,Str "you",Space,Str "want",Str ",",Space,Str "you",Space,Str "can",Space,Str "indent",Space,Str "every",Space,Str "line",Str ",",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 "."]],Space,Str "This",Space,Str "should",Space,Emph [Str "not"],Space,Str "be",Space,Str "a",Space,Str "footnote",Space,Str "reference",Str ",",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 ".",Note [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"] ("http://google.com",""),Space,Str "and",Space,Code ("",[],[]) "]",Space,Str "verbatim",Space,Str "characters",Str ",",Space,Str "as",Space,Str "well",Space,Str "as",Space,Str "[",Str "bracketed",Space,Str "text",Str "]",Str "."]]] ,BlockQuote [Para [Str "Notes",Space,Str "can",Space,Str "go",Space,Str "in",Space,Str "quotes",Str ".",Note [Para [Str "In",Space,Str "quote",Str "."]]]] ,OrderedList (1,Decimal,Period) diff --git a/tests/textile-reader.native b/tests/textile-reader.native index 5dd6301f1..8e149c33d 100644 --- a/tests/textile-reader.native +++ b/tests/textile-reader.native @@ -1,5 +1,5 @@ Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []}) -[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 "Textile",Space,Str "Reader",Str ".",Space,Str "Part",Space,Str "of",Space,Str "it",Space,Str "comes",LineBreak,Str "from",Space,Str "John",Space,Str "Gruber",Apostrophe,Str "s",Space,Str "markdown",Space,Str "test",Space,Str "suite",Str "."] +[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 "Textile",Space,Str "Reader",Str ".",Space,Str "Part",Space,Str "of",Space,Str "it",Space,Str "comes",LineBreak,Str "from",Space,Str "John",Space,Str "Gruber",Str "\8217",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 "embeded",Space,Str "link"] ("http://www.example.com","")] @@ -8,9 +8,9 @@ Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []}) ,Header 5 [Str "Level",Space,Str "5"] ,Header 6 [Str "Level",Space,Str "6"] ,Header 1 [Str "Paragraphs"] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "regular",Space,Str "paragraph",Str "."] +,Para [Str "Here",Str "\8217",Str "s",Space,Str "a",Space,Str "regular",Space,Str "paragraph",Str "."] ,Para [Str "Line",Space,Str "breaks",Space,Str "are",Space,Str "preserved",Space,Str "in",Space,Str "textile",Str ",",Space,Str "so",Space,Str "you",Space,Str "can",Space,Str "not",Space,Str "wrap",Space,Str "your",Space,Str "very",LineBreak,Str "long",Space,Str "paragraph",Space,Str "with",Space,Str "your",Space,Str "favourite",Space,Str "text",Space,Str "editor",Space,Str "and",Space,Str "have",Space,Str "it",Space,Str "rendered",LineBreak,Str "with",Space,Str "no",Space,Str "break",Str "."] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "one",Space,Str "with",Space,Str "a",Space,Str "bullet",Str "."] +,Para [Str "Here",Str "\8217",Str "s",Space,Str "one",Space,Str "with",Space,Str "a",Space,Str "bullet",Str "."] ,BulletList [[Plain [Str "criminey",Str "."]]] ,Para [Str "There",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "paragraph",Space,Str "break",Space,Str "between",Space,Str "here"] @@ -70,9 +70,9 @@ Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []}) ,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 ".",LineBreak,Str "This",Space,Str "is",Space,Strong [Str "strong"],Str ",",Space,Str "and",Space,Str "so",Space,Strong [Str "is",Space,Str "this"],Str ".",LineBreak,Str "A",Space,Link [Strong [Str "strong",Space,Str "link"]] ("http://www.foobar.com",""),Str "."] ,Para [Emph [Strong [Str "This",Space,Str "is",Space,Str "strong",Space,Str "and",Space,Str "em",Str "."]],LineBreak,Str "So",Space,Str "is",Space,Strong [Emph [Str "this"]],Space,Str "word",Space,Str "and",Space,Emph [Strong [Str "that",Space,Str "one"]],Str ".",LineBreak,Strikeout [Str "This",Space,Str "is",Space,Str "strikeout",Space,Str "and",Space,Strong [Str "strong"]]] ,Para [Str "Superscripts",Str ":",Space,Str "a",Superscript [Str "bc"],Str "d",Space,Str "a",Superscript [Strong [Str "hello"]],Space,Str "a",Superscript [Str "hello",Space,Str "there"],Str ".",LineBreak,Str "Subscripts",Str ":",Space,Str "H",Subscript [Str "2"],Str "O",Str ",",Space,Str "H",Subscript [Str "23"],Str "O",Str ",",Space,Str "H",Subscript [Str "many",Space,Str "of",Space,Str "them"],Str "O",Str "."] -,Para [Str "Dashes",Space,Str ":",Space,Str "How",Space,Str "cool",Space,EmDash,Space,Str "automatic",Space,Str "dashes",Str "."] -,Para [Str "Elipses",Space,Str ":",Space,Str "He",Space,Str "thought",Space,Str "and",Space,Str "thought",Space,Ellipses,Space,Str "and",Space,Str "then",Space,Str "thought",Space,Str "some",Space,Str "more",Str "."] -,Para [Str "Quotes",Space,Str "and",Space,Str "apostrophes",Space,Str ":",Space,Quoted DoubleQuote [Str "I",Apostrophe,Str "d",Space,Str "like",Space,Str "to",Space,Str "thank",Space,Str "you"],Space,Str "for",Space,Str "example",Str "."] +,Para [Str "Dashes",Space,Str ":",Space,Str "How",Space,Str "cool",Space,Str "\8212",Space,Str "automatic",Space,Str "dashes",Str "."] +,Para [Str "Elipses",Space,Str ":",Space,Str "He",Space,Str "thought",Space,Str "and",Space,Str "thought",Space,Str "\8230",Space,Str "and",Space,Str "then",Space,Str "thought",Space,Str "some",Space,Str "more",Str "."] +,Para [Str "Quotes",Space,Str "and",Space,Str "apostrophes",Space,Str ":",Space,Quoted DoubleQuote [Str "I",Str "\8217",Str "d",Space,Str "like",Space,Str "to",Space,Str "thank",Space,Str "you"],Space,Str "for",Space,Str "example",Str "."] ,Header 1 [Str "Links"] ,Header 2 [Str "Explicit"] ,Para [Str "Just",Space,Str "a",Space,Link [Str "url"] ("http://www.url.com","")] @@ -96,7 +96,7 @@ Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []}) ,[[Plain [Str "bella"]] ,[Plain [Str "45"]] ,[Plain [Str "f"]]]] -,Para [Str "and",Space,Str "some",Space,Str "text",Space,Str "following",Space,Ellipses] +,Para [Str "and",Space,Str "some",Space,Str "text",Space,Str "following",Space,Str "\8230"] ,Header 2 [Str "With",Space,Str "headers"] ,Table [] [AlignDefault,AlignDefault,AlignDefault] [0.0,0.0,0.0] [[Plain [Str "name"]] @@ -136,7 +136,7 @@ Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []}) ,RawBlock "html" "</div>" ,Para [Str "as",Space,Str "well",Str "."] ,BulletList - [[Plain [Str "this",Space,Str "<",Str "div",Str ">",Space,Str "won",Apostrophe,Str "t",Space,Str "produce",Space,Str "raw",Space,Str "html",Space,Str "blocks",Space,Str "<",Str "/div",Str ">"]] + [[Plain [Str "this",Space,Str "<",Str "div",Str ">",Space,Str "won",Str "\8217",Str "t",Space,Str "produce",Space,Str "raw",Space,Str "html",Space,Str "blocks",Space,Str "<",Str "/div",Str ">"]] ,[Plain [Str "but",Space,Str "this",Space,RawInline "html" "<strong>",Space,Str "will",Space,Str "produce",Space,Str "inline",Space,Str "html",Space,RawInline "html" "</strong>"]]] ,Para [Str "Can",Space,Str "you",Space,Str "prove",Space,Str "that",Space,Str "2",Space,Str "<",Space,Str "3",Space,Str "?"] ,Header 1 [Str "Acronyms",Space,Str "and",Space,Str "marks"] diff --git a/tests/writer.docbook b/tests/writer.docbook index d2b28a28a..d767b6e20 100644 --- a/tests/writer.docbook +++ b/tests/writer.docbook @@ -16,7 +16,7 @@ </articleinfo> <para> This is a set of tests for pandoc. Most of them are adapted from John - Gruber's markdown test suite. + Gruber’s markdown test suite. </para> <section id="headers"> <title>Headers</title> @@ -56,7 +56,7 @@ <section id="paragraphs"> <title>Paragraphs</title> <para> - Here's a regular paragraph. + Here’s a regular paragraph. </para> <para> In Markdown 1.0.0 and earlier. Version 8. This line turns into a list @@ -64,7 +64,7 @@ a list item. </para> <para> - Here's one with a bullet. * criminey. + Here’s one with a bullet. * criminey. </para> <para> There should be a hard line break<literallayout></literallayout>here. @@ -364,7 +364,7 @@ These should not be escaped: \$ \\ \> \[ \{ Item 1, graf one. </para> <para> - Item 1. graf two. The quick brown fox jumped over the lazy dog's + Item 1. graf two. The quick brown fox jumped over the lazy dog’s back. </para> </listitem> @@ -404,7 +404,7 @@ These should not be escaped: \$ \\ \> \[ \{ </listitem> </itemizedlist> <para> - Here's another: + Here’s another: </para> <orderedlist numeration="arabic"> <listitem> @@ -893,7 +893,7 @@ These should not be escaped: \$ \\ \> \[ \{ <script type="text/javascript">document.write('This *should not* be interpreted as markdown');</script> <para> - Here's a simple block: + Here’s a simple block: </para> <div> @@ -956,7 +956,7 @@ These should not be escaped: \$ \\ \> \[ \{ <hr /> </programlisting> <para> - Hr's: + Hr’s: </para> <hr> @@ -1041,7 +1041,7 @@ These should not be escaped: \$ \\ \> \[ \{ </para> <para> <quote>He said, <quote>I want to go.</quote></quote> Were you alive in the - 70's? + 70’s? </para> <para> Here is some quoted <quote><literal>code</literal></quote> and a @@ -1092,19 +1092,19 @@ These should not be escaped: \$ \\ \> \[ \{ </listitem> <listitem> <para> - Here's some display math: + Here’s some display math: $\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$ </para> </listitem> <listitem> <para> - Here's one that has a line break in it: + Here’s one that has a line break in it: <emphasis>α</emphasis> + <emphasis>ω</emphasis> × <emphasis>x</emphasis><superscript>2</superscript>. </para> </listitem> </itemizedlist> <para> - These shouldn't be math: + These shouldn’t be math: </para> <itemizedlist> <listitem> @@ -1131,7 +1131,7 @@ These should not be escaped: \$ \\ \> \[ \{ </listitem> </itemizedlist> <para> - Here's a LaTeX table: + Here’s a LaTeX table: </para> </section> <section id="special-characters"> @@ -1304,18 +1304,18 @@ These should not be escaped: \$ \\ \> \[ \{ <section id="with-ampersands"> <title>With ampersands</title> <para> - Here's a <ulink url="http://example.com/?foo=1&bar=2">link with an + Here’s a <ulink url="http://example.com/?foo=1&bar=2">link with an ampersand in the URL</ulink>. </para> <para> - Here's a link with an amersand in the link text: + Here’s a link with an amersand in the link text: <ulink url="http://att.com/">AT&T</ulink>. </para> <para> - Here's an <ulink url="/script?foo=1&bar=2">inline link</ulink>. + Here’s an <ulink url="/script?foo=1&bar=2">inline link</ulink>. </para> <para> - Here's an <ulink url="/script?foo=1&bar=2">inline link in pointy + Here’s an <ulink url="/script?foo=1&bar=2">inline link in pointy braces</ulink>. </para> </section> @@ -1392,7 +1392,7 @@ or here: <http://example.com/> </para> </footnote> and another.<footnote> <para> - Here's the long note. This one contains multiple blocks. + Here’s the long note. This one contains multiple blocks. </para> <para> Subsequent blocks are indented to show that they belong to the diff --git a/tests/writer.mediawiki b/tests/writer.mediawiki index af4f7050c..314e7ab2f 100644 --- a/tests/writer.mediawiki +++ b/tests/writer.mediawiki @@ -1,4 +1,4 @@ -This is a set of tests for pandoc. Most of them are adapted from John Gruber’s markdown test suite. +This is a set of tests for pandoc. Most of them are adapted from John Gruber’s markdown test suite. ----- @@ -30,11 +30,11 @@ with no blank line = Paragraphs = -Here’s a regular paragraph. +Here’s a regular paragraph. 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. -Here’s one with a bullet. * criminey. +Here’s one with a bullet. * criminey. There should be a hard line break<br /> here. @@ -160,7 +160,7 @@ Multiple paragraphs: <ol style="list-style-type: decimal;"> <li><p>Item 1, graf one.</p> -<p>Item 1. graf two. The quick brown fox jumped over the lazy dog’s back.</p></li> +<p>Item 1. graf two. The quick brown fox jumped over the lazy dog’s back.</p></li> <li><p>Item 2.</p></li> <li><p>Item 3.</p></li></ol> @@ -172,7 +172,7 @@ Multiple paragraphs: -Here’s another: +Here’s another: # First # Second: @@ -350,7 +350,7 @@ And this is '''strong''' <script type="text/javascript">document.write('This *should not* be interpreted as markdown');</script> -Here’s a simple block: +Here’s a simple block: <div> @@ -401,7 +401,7 @@ Just plain comment, with trailing spaces on the line: Code: <pre><hr /></pre> -Hr’s: +Hr’s: <hr> @@ -455,21 +455,21 @@ These should not be superscripts or subscripts, because of the unescaped spaces: = 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. +‘A’, ‘B’, and ‘C’ are letters. -‘Oak,’ ‘elm,’ and ‘beech’ are names of trees. So is ‘pine.’ +‘Oak,’ ‘elm,’ and ‘beech’ are names of trees. So is ‘pine.’ -‘He said, “I want to go.”’ Were you alive in the 70’s? +‘He said, “I want to go.”’ Were you alive in the 70’s? -Here is some quoted ‘<tt>code</tt>’ and a “[http://example.com/?foo=1&bar=2 quoted link]”. +Here is some quoted ‘<tt>code</tt>’ and a “[http://example.com/?foo=1&bar=2 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. +Dashes between numbers: 5–7, 255–66, 1987–1999. -Ellipses…and…and…. +Ellipses…and…and…. ----- @@ -482,17 +482,17 @@ Ellipses…and…and…. * <math>\alpha \wedge \omega</math> * <math>223</math> * <math>p</math>-Tree -* Here’s some display math: <math>\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}</math> -* Here’s one that has a line break in it: <math>\alpha + \omega \times x^2</math>. +* Here’s some display math: <math>\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}</math> +* Here’s one that has a line break in it: <math>\alpha + \omega \times x^2</math>. -These shouldn’t be math: +These shouldn’t be math: * To get the famous equation, write <tt>$e = mc^2$</tt>. -* $22,000 is a ''lot'' of money. So is $34,000. (It worked if “lot” is emphasized.) +* $22,000 is a ''lot'' of money. So is $34,000. (It worked if “lot” is emphasized.) * Shoes ($20) and socks ($5). * Escaped <tt>$</tt>: $73 ''this should be emphasized'' 23$. -Here’s a LaTeX table: +Here’s a LaTeX table: @@ -602,13 +602,13 @@ Foo [[url/|biz]]. == With ampersands == -Here’s a [http://example.com/?foo=1&bar=2 link with an ampersand in the URL]. +Here’s a [http://example.com/?foo=1&bar=2 link with an ampersand in the URL]. -Here’s a link with an amersand in the link text: [http://att.com/ AT&T]. +Here’s a link with an amersand in the link text: [http://att.com/ AT&T]. -Here’s an [[script?foo=1&bar=2|inline link]]. +Here’s an [[script?foo=1&bar=2|inline link]]. -Here’s an [[script?foo=1&bar=2|inline link in pointy braces]]. +Here’s an [[script?foo=1&bar=2|inline link in pointy braces]]. == Autolinks == @@ -630,7 +630,7 @@ Auto-links should not occur here: <tt><http://example.com/></tt> = Images = -From “Voyage dans la Lune” by Georges Melies (1902): +From “Voyage dans la Lune” by Georges Melies (1902): [[Image:lalune.jpg|frame|none|alt=Voyage dans la Lune|caption lalune]] @@ -642,7 +642,7 @@ Here is a movie [[Image:movie.jpg|movie]] icon. = Footnotes = Here is a footnote reference,<ref>Here is the footnote. It can go anywhere after the footnote reference. It need not be placed at the end of the document. -</ref> and another.<ref>Here’s the long note. This one contains multiple blocks. +</ref> and another.<ref>Here’s the long note. This one contains multiple blocks. Subsequent blocks are indented to show that they belong to the footnote (as with list items). diff --git a/tests/writer.native b/tests/writer.native index 879cb24fc..691c4959a 100644 --- a/tests/writer.native +++ b/tests/writer.native @@ -1,5 +1,5 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docAuthors = [[Str "John",Space,Str "MacFarlane"],[Str "Anonymous"]], docDate = [Str "July",Space,Str "17",Str ",",Space,Str "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",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 "."] +[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\8217s",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"] ("/url","")] @@ -14,9 +14,9 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Str "with",Space,Str "no",Space,Str "blank",Space,Str "line"] ,HorizontalRule ,Header 1 [Str "Paragraphs"] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "a",Space,Str "regular",Space,Str "paragraph",Str "."] +,Para [Str "Here\8217s",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 "Here\8217s",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"] @@ -100,7 +100,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Str "Multiple",Space,Str "paragraphs",Str ":"] ,OrderedList (1,Decimal,Period) [[Para [Str "Item",Space,Str "1",Str ",",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 "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\8217s",Space,Str "back",Str "."]] ,[Para [Str "Item",Space,Str "2",Str "."]] ,[Para [Str "Item",Space,Str "3",Str "."]]] ,Header 2 [Str "Nested"] @@ -110,7 +110,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA [[Plain [Str "Tab"] ,BulletList [[Plain [Str "Tab"]]]]]]] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "another",Str ":"] +,Para [Str "Here\8217s",Space,Str "another",Str ":"] ,OrderedList (1,Decimal,Period) [[Plain [Str "First"]] ,[Plain [Str "Second",Str ":"] @@ -243,7 +243,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,RawBlock "html" "</td>\n<td>" ,Plain [Str "And",Space,Str "this",Space,Str "is",Space,Strong [Str "strong"]] ,RawBlock "html" "</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",Apostrophe,Str "s",Space,Str "a",Space,Str "simple",Space,Str "block",Str ":"] +,Para [Str "Here\8217s",Space,Str "a",Space,Str "simple",Space,Str "block",Str ":"] ,RawBlock "html" "<div>\n " ,Plain [Str "foo"] ,RawBlock "html" "</div>\n" @@ -265,7 +265,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,RawBlock "html" "<!-- foo --> \n" ,Para [Str "Code",Str ":"] ,CodeBlock ("",[],[]) "<hr />" -,Para [Str "Hr",Apostrophe,Str "s",Str ":"] +,Para [Str "Hr\8217s",Str ":"] ,RawBlock "html" "<hr>\n\n<hr />\n\n<hr />\n\n<hr> \n\n<hr /> \n\n<hr /> \n\n<hr class=\"foo\" id=\"bar\" />\n\n<hr class=\"foo\" id=\"bar\" />\n\n<hr class=\"foo\" id=\"bar\">\n" ,HorizontalRule ,Header 1 [Str "Inline",Space,Str "Markup"] @@ -286,11 +286,11 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Quoted DoubleQuote [Str "Hello",Str ","],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",Str ","],Space,Quoted SingleQuote [Str "elm",Str ","],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",Str ",",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",Str "?"] +,Para [Quoted SingleQuote [Str "He",Space,Str "said",Str ",",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\8217s",Str "?"] ,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"] ("http://example.com/?foo=1&bar=2","")],Str "."] -,Para [Str "Some",Space,Str "dashes",Str ":",Space,Str "one",EmDash,Str "two",Space,EmDash,Space,Str "three",EmDash,Str "four",Space,EmDash,Space,Str "five",Str "."] -,Para [Str "Dashes",Space,Str "between",Space,Str "numbers",Str ":",Space,Str "5",EnDash,Str "7",Str ",",Space,Str "255",EnDash,Str "66",Str ",",Space,Str "1987",EnDash,Str "1999",Str "."] -,Para [Str "Ellipses",Ellipses,Str "and",Ellipses,Str "and",Ellipses,Str "."] +,Para [Str "Some",Space,Str "dashes",Str ":",Space,Str "one",Str "\8212",Str "two",Space,Str "\8212",Space,Str "three",Str "\8212",Str "four",Space,Str "\8212",Space,Str "five",Str "."] +,Para [Str "Dashes",Space,Str "between",Space,Str "numbers",Str ":",Space,Str "5",Str "\8211",Str "7",Str ",",Space,Str "255",Str "\8211",Str "66",Str ",",Space,Str "1987",Str "\8211",Str "1999",Str "."] +,Para [Str "Ellipses",Str "\8230",Str "and",Str "\8230",Str "and",Str "\8230",Str "."] ,HorizontalRule ,Header 1 [Str "LaTeX"] ,BulletList @@ -300,15 +300,15 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,[Plain [Math InlineMath "\\alpha \\wedge \\omega"]] ,[Plain [Math InlineMath "223"]] ,[Plain [Math InlineMath "p",Str "-",Str "Tree"]] - ,[Plain [Str "Here",Apostrophe,Str "s",Space,Str "some",Space,Str "display",Space,Str "math",Str ":",Space,Math DisplayMath "\\frac{d}{dx}f(x)=\\lim_{h\\to 0}\\frac{f(x+h)-f(x)}{h}"]] - ,[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",Str ":",Space,Math InlineMath "\\alpha + \\omega \\times x^2",Str "."]]] -,Para [Str "These",Space,Str "shouldn",Apostrophe,Str "t",Space,Str "be",Space,Str "math",Str ":"] + ,[Plain [Str "Here\8217s",Space,Str "some",Space,Str "display",Space,Str "math",Str ":",Space,Math DisplayMath "\\frac{d}{dx}f(x)=\\lim_{h\\to 0}\\frac{f(x+h)-f(x)}{h}"]] + ,[Plain [Str "Here\8217s",Space,Str "one",Space,Str "that",Space,Str "has",Space,Str "a",Space,Str "line",Space,Str "break",Space,Str "in",Space,Str "it",Str ":",Space,Math InlineMath "\\alpha + \\omega \\times x^2",Str "."]]] +,Para [Str "These",Space,Str "shouldn\8217t",Space,Str "be",Space,Str "math",Str ":"] ,BulletList [[Plain [Str "To",Space,Str "get",Space,Str "the",Space,Str "famous",Space,Str "equation",Str ",",Space,Str "write",Space,Code ("",[],[]) "$e = mc^2$",Str "."]] ,[Plain [Str "$",Str "22",Str ",",Str "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",Str ",",Str "000",Str ".",Space,Str "(",Str "It",Space,Str "worked",Space,Str "if",Space,Quoted DoubleQuote [Str "lot"],Space,Str "is",Space,Str "emphasized",Str ".",Str ")"]] ,[Plain [Str "Shoes",Space,Str "(",Str "$",Str "20",Str ")",Space,Str "and",Space,Str "socks",Space,Str "(",Str "$",Str "5",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",Apostrophe,Str "s",Space,Str "a",Space,Str "LaTeX",Space,Str "table",Str ":"] +,Para [Str "Here\8217s",Space,Str "a",Space,Str "LaTeX",Space,Str "table",Str ":"] ,RawBlock "latex" "\\begin{tabular}{|l|l|}\\hline\nAnimal & Number \\\\ \\hline\nDog & 2 \\\\\nCat & 1 \\\\ \\hline\n\\end{tabular}" ,HorizontalRule ,Header 1 [Str "Special",Space,Str "Characters"] @@ -366,10 +366,10 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Str "Foo",Space,Link [Str "bar"] ("/url/","Title with \"quotes\" inside"),Str "."] ,Para [Str "Foo",Space,Link [Str "biz"] ("/url/","Title with \"quote\" inside"),Str "."] ,Header 2 [Str "With",Space,Str "ampersands"] -,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"] ("http://example.com/?foo=1&bar=2",""),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",Str ":",Space,Link [Str "AT",Str "&",Str "T"] ("http://att.com/","AT&T"),Str "."] -,Para [Str "Here",Apostrophe,Str "s",Space,Str "an",Space,Link [Str "inline",Space,Str "link"] ("/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"] ("/script?foo=1&bar=2",""),Str "."] +,Para [Str "Here\8217s",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"] ("http://example.com/?foo=1&bar=2",""),Str "."] +,Para [Str "Here\8217s",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",Str ":",Space,Link [Str "AT",Str "&",Str "T"] ("http://att.com/","AT&T"),Str "."] +,Para [Str "Here\8217s",Space,Str "an",Space,Link [Str "inline",Space,Str "link"] ("/script?foo=1&bar=2",""),Str "."] +,Para [Str "Here\8217s",Space,Str "an",Space,Link [Str "inline",Space,Str "link",Space,Str "in",Space,Str "pointy",Space,Str "braces"] ("/script?foo=1&bar=2",""),Str "."] ,Header 2 [Str "Autolinks"] ,Para [Str "With",Space,Str "an",Space,Str "ampersand",Str ":",Space,Link [Code ("",["url"],[]) "http://example.com/?foo=1&bar=2"] ("http://example.com/?foo=1&bar=2","")] ,BulletList @@ -388,7 +388,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "movie",Space,Image [Str "movie"] ("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",Str ",",Note [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 "."]],Space,Str "and",Space,Str "another",Str ".",Note [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 "(",Str "as",Space,Str "with",Space,Str "list",Space,Str "items",Str ")",Str "."],CodeBlock ("",[],[]) " { <code> }",Para [Str "If",Space,Str "you",Space,Str "want",Str ",",Space,Str "you",Space,Str "can",Space,Str "indent",Space,Str "every",Space,Str "line",Str ",",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 "."]],Space,Str "This",Space,Str "should",Space,Emph [Str "not"],Space,Str "be",Space,Str "a",Space,Str "footnote",Space,Str "reference",Str ",",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 ".",Note [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"] ("http://google.com",""),Space,Str "and",Space,Code ("",[],[]) "]",Space,Str "verbatim",Space,Str "characters",Str ",",Space,Str "as",Space,Str "well",Space,Str "as",Space,Str "[",Str "bracketed",Space,Str "text",Str "]",Str "."]]] +,Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "footnote",Space,Str "reference",Str ",",Note [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 "."]],Space,Str "and",Space,Str "another",Str ".",Note [Para [Str "Here\8217s",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 "(",Str "as",Space,Str "with",Space,Str "list",Space,Str "items",Str ")",Str "."],CodeBlock ("",[],[]) " { <code> }",Para [Str "If",Space,Str "you",Space,Str "want",Str ",",Space,Str "you",Space,Str "can",Space,Str "indent",Space,Str "every",Space,Str "line",Str ",",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 "."]],Space,Str "This",Space,Str "should",Space,Emph [Str "not"],Space,Str "be",Space,Str "a",Space,Str "footnote",Space,Str "reference",Str ",",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 ".",Note [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"] ("http://google.com",""),Space,Str "and",Space,Code ("",[],[]) "]",Space,Str "verbatim",Space,Str "characters",Str ",",Space,Str "as",Space,Str "well",Space,Str "as",Space,Str "[",Str "bracketed",Space,Str "text",Str "]",Str "."]]] ,BlockQuote [Para [Str "Notes",Space,Str "can",Space,Str "go",Space,Str "in",Space,Str "quotes",Str ".",Note [Para [Str "In",Space,Str "quote",Str "."]]]] ,OrderedList (1,Decimal,Period) diff --git a/tests/writer.opendocument b/tests/writer.opendocument index 4e02db650..587c16502 100644 --- a/tests/writer.opendocument +++ b/tests/writer.opendocument @@ -864,7 +864,7 @@ <text:p text:style-name="Author">Anonymous</text:p> <text:p text:style-name="Date">July 17, 2006</text:p> <text:p text:style-name="Text_20_body">This is a set of tests for pandoc. Most -of them are adapted from John Gruber’s markdown test suite.</text:p> +of them are adapted from John Gruber’s markdown test suite.</text:p> <text:p text:style-name="Horizontal_20_Line" /> <text:h text:style-name="Heading_20_1" text:outline-level="1">Headers</text:h> <text:h text:style-name="Heading_20_2" text:outline-level="2">Level 2 with an @@ -883,12 +883,12 @@ link</text:span></text:a></text:h> <text:p text:style-name="First_20_paragraph">with no blank line</text:p> <text:p text:style-name="Horizontal_20_Line" /> <text:h text:style-name="Heading_20_1" text:outline-level="1">Paragraphs</text:h> -<text:p text:style-name="First_20_paragraph">Here’s a regular +<text:p text:style-name="First_20_paragraph">Here’s a regular paragraph.</text:p> <text:p text:style-name="Text_20_body">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.</text:p> -<text:p text:style-name="Text_20_body">Here’s one with a bullet. * +<text:p text:style-name="Text_20_body">Here’s one with a bullet. * criminey.</text:p> <text:p text:style-name="Text_20_body">There should be a hard line break<text:line-break />here.</text:p> @@ -1061,7 +1061,7 @@ Blocks</text:h> <text:list-item> <text:p text:style-name="P29">Item 1, graf one.</text:p> <text:p text:style-name="P29">Item 1. graf two. The quick brown fox jumped - over the lazy dog’s back.</text:p> + over the lazy dog’s back.</text:p> </text:list-item> <text:list-item> <text:p text:style-name="P29">Item 2.</text:p> @@ -1084,7 +1084,7 @@ Blocks</text:h> </text:list> </text:list-item> </text:list> -<text:p text:style-name="First_20_paragraph">Here’s another:</text:p> +<text:p text:style-name="First_20_paragraph">Here’s another:</text:p> <text:list text:style-name="L16"> <text:list-item> <text:p text:style-name="P33">First</text:p> @@ -1303,7 +1303,7 @@ table:</text:p> <text:span text:style-name="T5">emphasized</text:span></text:p> <text:p text:style-name="Text_20_body">And this is <text:span text:style-name="T6">strong</text:span></text:p> -<text:p text:style-name="Text_20_body">Here’s a simple block:</text:p> +<text:p text:style-name="Text_20_body">Here’s a simple block:</text:p> <text:p text:style-name="Text_20_body">foo</text:p> <text:p text:style-name="Text_20_body">This should be a code block, though:</text:p> @@ -1323,7 +1323,7 @@ comment:</text:p> spaces on the line:</text:p> <text:p text:style-name="Text_20_body">Code:</text:p> <text:p text:style-name="P50"><hr /></text:p> -<text:p text:style-name="First_20_paragraph">Hr’s:</text:p> +<text:p text:style-name="First_20_paragraph">Hr’s:</text:p> <text:p text:style-name="Horizontal_20_Line" /> <text:h text:style-name="Heading_20_1" text:outline-level="1">Inline Markup</text:h> @@ -1374,23 +1374,22 @@ subscripts, because of the unescaped spaces: a^b c^d, a~b c~d.</text:p> <text:p text:style-name="Horizontal_20_Line" /> <text:h text:style-name="Heading_20_1" text:outline-level="1">Smart quotes, ellipses, dashes</text:h> -<text:p text:style-name="First_20_paragraph">“Hello,” said the -spider. “‘Shelob’ is my name.”</text:p> -<text:p text:style-name="Text_20_body">‘A’, ‘B’, and -‘C’ are letters.</text:p> -<text:p text:style-name="Text_20_body">‘Oak,’ ‘elm,’ -and ‘beech’ are names of trees. So is ‘pine.’</text:p> -<text:p text:style-name="Text_20_body">‘He said, “I want to -go.”’ Were you alive in the 70’s?</text:p> +<text:p text:style-name="First_20_paragraph">“Hello,” said the spider. +“‘Shelob’ is my name.”</text:p> +<text:p text:style-name="Text_20_body">‘A’, ‘B’, and ‘C’ are letters.</text:p> +<text:p text:style-name="Text_20_body">‘Oak,’ ‘elm,’ and ‘beech’ are names of +trees. So is ‘pine.’</text:p> +<text:p text:style-name="Text_20_body">‘He said, “I want to go.”’ Were you +alive in the 70’s?</text:p> <text:p text:style-name="Text_20_body">Here is some quoted -‘<text:span text:style-name="Teletype">code</text:span>’ and a -“<text:a xlink:type="simple" xlink:href="http://example.com/?foo=1&bar=2" office:name=""><text:span text:style-name="Definition">quoted -link</text:span></text:a>”.</text:p> -<text:p text:style-name="Text_20_body">Some dashes: one—two — -three—four — five.</text:p> -<text:p text:style-name="Text_20_body">Dashes between numbers: 5–7, -255–66, 1987–1999.</text:p> -<text:p text:style-name="Text_20_body">Ellipses…and…and….</text:p> +‘<text:span text:style-name="Teletype">code</text:span>’ and a +“<text:a xlink:type="simple" xlink:href="http://example.com/?foo=1&bar=2" office:name=""><text:span text:style-name="Definition">quoted +link</text:span></text:a>”.</text:p> +<text:p text:style-name="Text_20_body">Some dashes: one—two — three—four — +five.</text:p> +<text:p text:style-name="Text_20_body">Dashes between numbers: 5–7, 255–66, +1987–1999.</text:p> +<text:p text:style-name="Text_20_body">Ellipses…and…and….</text:p> <text:p text:style-name="Horizontal_20_Line" /> <text:h text:style-name="Heading_20_1" text:outline-level="1">LaTeX</text:h> <text:list text:style-name="L26"> @@ -1413,17 +1412,15 @@ three—four — five.</text:p> <text:p text:style-name="P51"><text:span text:style-name="T62">p</text:span>-Tree</text:p> </text:list-item> <text:list-item> - <text:p text:style-name="P51">Here’s some display math: + <text:p text:style-name="P51">Here’s some display math: $\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$</text:p> </text:list-item> <text:list-item> - <text:p text:style-name="P51">Here’s one that has a line break in - it: + <text:p text:style-name="P51">Here’s one that has a line break in it: <text:span text:style-name="T63">α</text:span> + <text:span text:style-name="T64">ω</text:span> × <text:span text:style-name="T65">x</text:span><text:span text:style-name="T66">2</text:span>.</text:p> </text:list-item> </text:list> -<text:p text:style-name="First_20_paragraph">These shouldn’t be -math:</text:p> +<text:p text:style-name="First_20_paragraph">These shouldn’t be math:</text:p> <text:list text:style-name="L27"> <text:list-item> <text:p text:style-name="P52">To get the famous equation, write @@ -1432,7 +1429,7 @@ math:</text:p> <text:list-item> <text:p text:style-name="P52">$22,000 is a <text:span text:style-name="T67">lot</text:span> of money. So is $34,000. - (It worked if “lot” is emphasized.)</text:p> + (It worked if “lot” is emphasized.)</text:p> </text:list-item> <text:list-item> <text:p text:style-name="P52">Shoes ($20) and socks ($5).</text:p> @@ -1447,8 +1444,7 @@ math:</text:p> 23$.</text:p> </text:list-item> </text:list> -<text:p text:style-name="First_20_paragraph">Here’s a LaTeX -table:</text:p> +<text:p text:style-name="First_20_paragraph">Here’s a LaTeX table:</text:p> <text:p text:style-name="Horizontal_20_Line" /> <text:h text:style-name="Heading_20_1" text:outline-level="1">Special Characters</text:h> @@ -1538,16 +1534,16 @@ by itself should be a link.</text:p> <text:a xlink:type="simple" xlink:href="/url/" office:name="Title with "quote" inside"><text:span text:style-name="Definition">biz</text:span></text:a>.</text:p> <text:h text:style-name="Heading_20_2" text:outline-level="2">With ampersands</text:h> -<text:p text:style-name="First_20_paragraph">Here’s a +<text:p text:style-name="First_20_paragraph">Here’s a <text:a xlink:type="simple" xlink:href="http://example.com/?foo=1&bar=2" office:name=""><text:span text:style-name="Definition">link with an ampersand in the URL</text:span></text:a>.</text:p> -<text:p text:style-name="Text_20_body">Here’s a link with an amersand in -the link text: +<text:p text:style-name="Text_20_body">Here’s a link with an amersand in the +link text: <text:a xlink:type="simple" xlink:href="http://att.com/" office:name="AT&T"><text:span text:style-name="Definition">AT&T</text:span></text:a>.</text:p> -<text:p text:style-name="Text_20_body">Here’s an +<text:p text:style-name="Text_20_body">Here’s an <text:a xlink:type="simple" xlink:href="/script?foo=1&bar=2" office:name=""><text:span text:style-name="Definition">inline link</text:span></text:a>.</text:p> -<text:p text:style-name="Text_20_body">Here’s an +<text:p text:style-name="Text_20_body">Here’s an <text:a xlink:type="simple" xlink:href="/script?foo=1&bar=2" office:name=""><text:span text:style-name="Definition">inline link in pointy braces</text:span></text:a>.</text:p> <text:h text:style-name="Heading_20_2" text:outline-level="2">Autolinks</text:h> @@ -1573,8 +1569,8 @@ link in pointy braces</text:span></text:a>.</text:p> <text:p text:style-name="P57">or here: <http://example.com/></text:p> <text:p text:style-name="Horizontal_20_Line" /> <text:h text:style-name="Heading_20_1" text:outline-level="1">Images</text:h> -<text:p text:style-name="First_20_paragraph">From “Voyage dans la -Lune” by Georges Melies (1902):</text:p> +<text:p text:style-name="First_20_paragraph">From “Voyage dans la Lune” by +Georges Melies (1902):</text:p> <text:p text:style-name="Text_20_body"><draw:frame><draw:image xlink:href="lalune.jpg" xlink:type="simple" xlink:show="embed" xlink:actuate="onLoad" /></draw:frame></text:p> <text:p text:style-name="Text_20_body">Here is a movie <draw:frame><draw:image xlink:href="movie.jpg" xlink:type="simple" xlink:show="embed" xlink:actuate="onLoad" /></draw:frame> @@ -1586,7 +1582,7 @@ reference,<text:note text:id="ftn0" text:note-class="footnote"><text:note-citati is the footnote. It can go anywhere after the footnote reference. It need not be placed at the end of the document.</text:p></text:note-body></text:note> and -another.<text:note text:id="ftn1" text:note-class="footnote"><text:note-citation>2</text:note-citation><text:note-body><text:p text:style-name="Footnote">Here’s +another.<text:note text:id="ftn1" text:note-class="footnote"><text:note-citation>2</text:note-citation><text:note-body><text:p text:style-name="Footnote">Here’s the long note. This one contains multiple blocks.</text:p><text:p text:style-name="Footnote">Subsequent blocks are indented to show that they belong to the footnote (as with list |