diff options
39 files changed, 186 insertions, 156 deletions
diff --git a/pandoc.cabal b/pandoc.cabal index b505af1e0..f57ca1bb2 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -1,5 +1,5 @@ Name: pandoc -Version: 1.7 +Version: 1.8 Cabal-Version: >= 1.6 Build-Type: Custom License: GPL @@ -202,7 +202,7 @@ Library random >= 1 && < 1.1, extensible-exceptions >= 0.1 && < 0.2, citeproc-hs >= 0.3 && < 0.4, - pandoc-types == 1.7.*, + pandoc-types == 1.8.*, json >= 0.4 && < 0.5, dlist >= 0.4 && < 0.6, tagsoup >= 0.12 && < 0.13 @@ -286,7 +286,7 @@ Executable pandoc random >= 1 && < 1.1, extensible-exceptions >= 0.1 && < 0.2, citeproc-hs >= 0.3 && < 0.4, - pandoc-types == 1.7.*, + pandoc-types == 1.8.*, json >= 0.4 && < 0.5, dlist >= 0.4 && < 0.6, tagsoup >= 0.12 && < 0.13 diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index 6e7db4f8a..4a2671157 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -662,13 +662,12 @@ newtype Key = Key [Inline] deriving (Show, Read, Eq, Ord) toKey :: [Inline] -> Key toKey = Key . bottomUp lowercase where lowercase :: Inline -> Inline - lowercase (Str xs) = Str (map toLower xs) - lowercase (Math t xs) = Math t (map toLower xs) - lowercase (Code xs) = Code (map toLower xs) - lowercase (TeX xs) = TeX (map toLower xs) - lowercase (HtmlInline xs) = HtmlInline (map toLower xs) - lowercase LineBreak = Space - lowercase x = x + lowercase (Str xs) = Str (map toLower xs) + lowercase (Math t xs) = Math t (map toLower xs) + lowercase (Code xs) = Code (map toLower xs) + lowercase (RawInline f xs) = RawInline f (map toLower xs) + lowercase LineBreak = Space + lowercase x = x fromKey :: Key -> [Inline] fromKey (Key xs) = xs diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index 0cbdf72b0..d267a4ff2 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -169,7 +169,7 @@ pRawHtmlBlock = do raw <- pHtmlBlock "script" <|> pHtmlBlock "style" <|> pRawTag state <- getState if stateParseRaw state && not (null raw) - then return [RawHtml raw] + then return [RawBlock "html" raw] else return [] pHtmlBlock :: String -> TagParser String @@ -347,7 +347,7 @@ pRawHtmlInline = do result <- pSatisfy (tagComment (const True)) <|> pSatisfy isInlineTag state <- getState if stateParseRaw state - then return [HtmlInline $ renderTags' [result]] + then return [RawInline "html" $ renderTags' [result]] else return [] pInlinesInTags :: String -> ([Inline] -> Inline) diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index ad4953648..1944dd651 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -448,7 +448,7 @@ rawLaTeXEnvironment :: GenParser Char st Block rawLaTeXEnvironment = do contents <- rawLaTeXEnvironment' spaces - return $ Para [TeX contents] + return $ RawBlock "latex" contents -- | Parse any LaTeX environment and return a string containing -- the whole literal environment as raw TeX. @@ -491,7 +491,7 @@ demacro (n,st,args) = try $ do let raw = "\\" ++ n ++ st ++ concat args s' <- applyMacros' raw if raw == s' - then return $ TeX raw + then return $ RawInline "latex" raw else do inp <- getInput setInput $ s' ++ inp diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 0334cf8f4..e7abbc695 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -661,10 +661,10 @@ definitionList = do -- isHtmlOrBlank :: Inline -> Bool -isHtmlOrBlank (HtmlInline _) = True -isHtmlOrBlank (Space) = True -isHtmlOrBlank (LineBreak) = True -isHtmlOrBlank _ = False +isHtmlOrBlank (RawInline "html" _) = True +isHtmlOrBlank (Space) = True +isHtmlOrBlank (LineBreak) = True +isHtmlOrBlank _ = False para :: GenParser Char ParserState Block para = try $ do @@ -693,7 +693,7 @@ htmlBlock = try $ do first <- htmlElement finalSpace <- many spaceChar finalNewlines <- many newline - return $ RawHtml $ first ++ finalSpace ++ finalNewlines + return $ RawBlock "html" $ first ++ finalSpace ++ finalNewlines strictHtmlBlock :: GenParser Char ParserState [Char] strictHtmlBlock = do @@ -713,7 +713,7 @@ rawTeXBlock = do failIfStrict result <- rawLaTeXEnvironment' <|> rawConTeXtEnvironment' spaces - return $ Para [TeX result] + return $ RawBlock "latex" result rawHtmlBlocks :: GenParser Char ParserState Block rawHtmlBlocks = do @@ -730,7 +730,7 @@ rawHtmlBlocks = do return $ blk ++ sps let combined = concat htmlBlocks let combined' = if last combined == '\n' then init combined else combined - return $ RawHtml combined' + return $ RawBlock "html" combined' -- -- Tables @@ -1186,8 +1186,8 @@ inlineNote = try $ do rawLaTeXInline' :: GenParser Char ParserState Inline rawLaTeXInline' = do failIfStrict - (rawConTeXtEnvironment' >>= return . TeX) - <|> (rawLaTeXEnvironment' >>= return . TeX) + (rawConTeXtEnvironment' >>= return . RawInline "latex") + <|> (rawLaTeXEnvironment' >>= return . RawInline "latex") <|> rawLaTeXInline rawConTeXtEnvironment' :: GenParser Char st String @@ -1212,7 +1212,7 @@ rawHtmlInline = do (_,result) <- if stateStrict st then htmlTag (not . isTextTag) else htmlTag isInlineTag - return $ HtmlInline result + return $ RawInline "html" result -- Citations diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index d65aac6e5..fec49b40e 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -373,8 +373,10 @@ birdTrackLine = do -- rawHtmlBlock :: GenParser Char st Block -rawHtmlBlock = try $ string ".. raw:: html" >> blanklines >> - indentedBlock >>= return . RawHtml +rawHtmlBlock = try $ do + string ".. raw:: html" + blanklines + indentedBlock >>= return . RawBlock "html" -- -- raw latex @@ -385,7 +387,7 @@ rawLaTeXBlock = try $ do string ".. raw:: latex" blanklines result <- indentedBlock - return $ Para [(TeX result)] + return $ RawBlock "latex" result -- -- block quotes diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index 7749a946c..714cac9f4 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -281,7 +281,7 @@ rawHtmlBlock :: GenParser Char ParserState Block rawHtmlBlock = try $ do (_,b) <- htmlTag isBlockTag optional blanklines - return $ RawHtml b + return $ RawBlock "html" b -- | In textile, paragraphs are separated by blank lines. para :: GenParser Char ParserState Block @@ -457,7 +457,8 @@ endline = try $ do return LineBreak rawHtmlInline :: GenParser Char ParserState Inline -rawHtmlInline = liftM (HtmlInline . snd) $ htmlTag isInlineTag +rawHtmlInline = liftM (RawInline "html" . snd) + $ htmlTag isInlineTag -- | Textile standard link syntax is "label":target link :: GenParser Char ParserState Inline diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 81c552e41..0235a536a 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -267,7 +267,7 @@ removeEmptyBlocks (Null : xs) = removeEmptyBlocks xs removeEmptyBlocks (BulletList [] : xs) = removeEmptyBlocks xs removeEmptyBlocks (OrderedList _ [] : xs) = removeEmptyBlocks xs removeEmptyBlocks (DefinitionList [] : xs) = removeEmptyBlocks xs -removeEmptyBlocks (RawHtml [] : xs) = removeEmptyBlocks xs +removeEmptyBlocks (RawBlock _ [] : xs) = removeEmptyBlocks xs removeEmptyBlocks (x:xs) = x : removeEmptyBlocks xs removeEmptyBlocks [] = [] @@ -278,8 +278,7 @@ removeEmptyInlines (Subscript [] : zs) = removeEmptyInlines zs removeEmptyInlines (Superscript [] : zs) = removeEmptyInlines zs removeEmptyInlines (SmallCaps [] : zs) = removeEmptyInlines zs removeEmptyInlines (Strikeout [] : zs) = removeEmptyInlines zs -removeEmptyInlines (TeX [] : zs) = removeEmptyInlines zs -removeEmptyInlines (HtmlInline [] : zs) = removeEmptyInlines zs +removeEmptyInlines (RawInline _ [] : zs) = removeEmptyInlines zs removeEmptyInlines (Code [] : zs) = removeEmptyInlines zs removeEmptyInlines (x : xs) = x : removeEmptyInlines xs removeEmptyInlines [] = [] @@ -311,10 +310,8 @@ consolidateInlines (SmallCaps xs : SmallCaps ys : zs) = consolidateInlines $ SmallCaps (xs ++ ys) : zs consolidateInlines (Strikeout xs : Strikeout ys : zs) = consolidateInlines $ Strikeout (xs ++ ys) : zs -consolidateInlines (TeX x : TeX y : zs) = consolidateInlines $ - TeX (x ++ y) : zs -consolidateInlines (HtmlInline x : HtmlInline y : zs) = consolidateInlines $ - HtmlInline (x ++ y) : zs +consolidateInlines (RawInline f x : RawInline f' y : zs) | f == f' = + consolidateInlines $ RawInline f (x ++ y) : zs consolidateInlines (Code x : Code y : zs) = consolidateInlines $ Code (x ++ y) : zs consolidateInlines (x : xs) = x : consolidateInlines xs diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 06e81f7a4..ea8a60771 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -124,7 +124,10 @@ blockToConTeXt (BlockQuote lst) = do blockToConTeXt (CodeBlock _ str) = return $ "\\starttyping" <> cr <> flush (text str) <> cr <> "\\stoptyping" $$ blankline -- blankline because \stoptyping can't have anything after it, inc. '}' -blockToConTeXt (RawHtml _) = return empty +blockToConTeXt (RawBlock "context" str) = return $ text str +-- for backwards compatibility, allow latex too: +blockToConTeXt (RawBlock "latex" str) = return $ text str +blockToConTeXt (RawBlock _ _ ) = return empty blockToConTeXt (BulletList lst) = do contents <- mapM listItemToConTeXt lst return $ "\\startitemize" $$ vcat contents $$ text "\\stopitemize" <> blankline @@ -264,8 +267,10 @@ inlineToConTeXt (Math InlineMath str) = return $ char '$' <> text str <> char '$' inlineToConTeXt (Math DisplayMath str) = return $ text "\\startformula " <> text str <> text " \\stopformula" -inlineToConTeXt (TeX str) = return $ text str -inlineToConTeXt (HtmlInline _) = return empty +inlineToConTeXt (RawInline "context" str) = return $ text str +-- backwards compatibility, allow latex too +inlineToConTeXt (RawInline "latex" str) = return $ text str +inlineToConTeXt (RawInline _ _) = return empty inlineToConTeXt (LineBreak) = return $ text "\\crlf" <> cr inlineToConTeXt Space = return space inlineToConTeXt (Link [Code str] (src, tit)) = -- since ConTeXt has its own diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index d0fb2c541..aac4002f5 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -179,7 +179,10 @@ blockToDocbook opts (OrderedList (start, numstyle, _) (first:rest)) = in inTags True "orderedlist" attribs items blockToDocbook opts (DefinitionList lst) = inTagsIndented "variablelist" $ deflistItemsToDocbook opts lst -blockToDocbook _ (RawHtml str) = text str -- raw XML block +blockToDocbook _ (RawBlock "docbook" str) = text str -- raw XML block +-- we allow html for compatibility with earlier versions of pandoc +blockToDocbook _ (RawBlock "html" str) = text str -- raw XML block +blockToDocbook _ (RawBlock _ _) = empty blockToDocbook _ HorizontalRule = empty -- not semantic blockToDocbook opts (Table caption aligns widths headers rows) = let alignStrings = map alignmentToString aligns @@ -258,8 +261,7 @@ inlineToDocbook _ EnDash = text "–" inlineToDocbook _ (Code str) = inTagsSimple "literal" $ text (escapeStringForXML str) inlineToDocbook opts (Math _ str) = inlinesToDocbook opts $ readTeXMath str -inlineToDocbook _ (TeX _) = empty -inlineToDocbook _ (HtmlInline _) = empty +inlineToDocbook _ (RawInline _ _) = empty inlineToDocbook _ LineBreak = inTagsSimple "literallayout" empty inlineToDocbook _ Space = space inlineToDocbook opts (Link txt (src, _)) = diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index c2038a3c1..33b8aa76a 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -233,13 +233,13 @@ transformInlines (MathML _) _ _ (x@(Math _ _) : xs) = do mathml ++ "</ops:case><ops:default>" ++ fallback ++ "</ops:default>" ++ "</ops:switch>" result = if "<math" `isPrefixOf` mathml then inOps else mathml - return $ HtmlInline result : xs -transformInlines _ _ _ (HtmlInline _ : xs) = return $ Str "" : xs + return $ RawInline "html" result : xs +transformInlines _ _ _ (RawInline _ _ : xs) = return $ Str "" : xs transformInlines _ _ _ (Link lab (_,_) : xs) = return $ lab ++ xs transformInlines _ _ _ xs = return xs transformBlock :: Block -> Block -transformBlock (RawHtml _) = Null +transformBlock (RawBlock _ _) = Null transformBlock x = x (!) :: Node t => (t -> Element) -> [(String, String)] -> t -> Element diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 93f96b2f9..94dec864e 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -105,8 +105,8 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do toc <- if writerTableOfContents opts then tableOfContents opts sects else return Nothing - let startSlide = RawHtml "<div class=\"slide\">\n" - endSlide = RawHtml "</div>\n" + let startSlide = RawBlock "html" "<div class=\"slide\">\n" + endSlide = RawBlock "html" "</div>\n" let cutUp (HorizontalRule : Header 1 ys : xs) = cutUp (Header 1 ys : xs) cutUp (HorizontalRule : xs) = [endSlide, startSlide] ++ cutUp xs cutUp (Header 1 ys : xs) = [endSlide, startSlide] ++ @@ -311,7 +311,8 @@ blockToHtml opts (Para [Image txt (s,tit)]) = do else thediv ! [theclass "figure"] << [img, paragraph ! [theclass "caption"] << capt] blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph) -blockToHtml _ (RawHtml str) = return $ primHtml str +blockToHtml _ (RawBlock "html" str) = return $ primHtml str +blockToHtml _ (RawBlock _ _) = return noHtml blockToHtml _ (HorizontalRule) = return $ hr blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do let classes' = if writerLiterateHaskell opts @@ -540,11 +541,12 @@ inlineToHtml opts inline = return $ case t of InlineMath -> m DisplayMath -> br +++ m +++ br ) - (TeX str) -> case writerHTMLMathMethod opts of - LaTeXMathML _ -> do modify (\st -> st {stMath = True}) - return $ primHtml str - _ -> return noHtml - (HtmlInline str) -> return $ primHtml str + (RawInline "latex" str) -> case writerHTMLMathMethod opts of + LaTeXMathML _ -> do modify (\st -> st {stMath = True}) + return $ primHtml str + _ -> return noHtml + (RawInline "html" str) -> return $ primHtml str + (RawInline _ _) -> return noHtml (Link [Code str] (s,_)) | "mailto:" `isPrefixOf` s -> return $ obfuscateLink opts str s (Link txt (s,_)) | "mailto:" `isPrefixOf` s -> do @@ -585,7 +587,7 @@ blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html blockListToNote opts ref blocks = -- If last block is Para or Plain, include the backlink at the end of -- that block. Otherwise, insert a new Plain block with the backlink. - let backlink = [HtmlInline $ " <a href=\"#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref ++ + let backlink = [RawInline "html" $ " <a href=\"#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref ++ "\" class=\"footnoteBackLink\"" ++ " title=\"Jump back to footnote " ++ ref ++ "\">↩</a>"] blocks' = if null blocks diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 64a1e03ac..e6687ff08 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -151,7 +151,7 @@ inCmd cmd contents = char '\\' <> text cmd <> braces contents deVerb :: [Inline] -> [Inline] deVerb [] = [] deVerb ((Code str):rest) = - (TeX $ "\\texttt{" ++ stringToLaTeX str ++ "}"):(deVerb rest) + (RawInline "latex" $ "\\texttt{" ++ stringToLaTeX str ++ "}"):(deVerb rest) deVerb (other:rest) = other:(deVerb rest) -- | Convert Pandoc block element to LaTeX. @@ -184,7 +184,8 @@ blockToLaTeX (CodeBlock (_,classes,_) str) = do else return "verbatim" return $ "\\begin{" <> text env <> "}" $$ flush (text str) $$ "\\end{" <> text env <> "}" $$ cr -- final cr needed because of footnotes -blockToLaTeX (RawHtml _) = return empty +blockToLaTeX (RawBlock "latex" x) = return $ text x +blockToLaTeX (RawBlock _ _) = return empty blockToLaTeX (BulletList lst) = do items <- mapM listItemToLaTeX lst return $ "\\begin{itemize}" $$ vcat items $$ "\\end{itemize}" @@ -360,8 +361,8 @@ inlineToLaTeX Ellipses = return "\\ldots{}" inlineToLaTeX (Str str) = return $ text $ stringToLaTeX str inlineToLaTeX (Math InlineMath str) = return $ char '$' <> text str <> char '$' inlineToLaTeX (Math DisplayMath str) = return $ "\\[" <> text str <> "\\]" -inlineToLaTeX (TeX str) = return $ text str -inlineToLaTeX (HtmlInline _) = return empty +inlineToLaTeX (RawInline "latex" str) = return $ text str +inlineToLaTeX (RawInline _ _) = return empty inlineToLaTeX (LineBreak) = return "\\\\" inlineToLaTeX Space = return space inlineToLaTeX (Link txt (src, _)) = diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 0fd78dadf..c3e4ea3bb 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -145,7 +145,8 @@ blockToMan opts (Para inlines) = do contents <- liftM vcat $ mapM (inlineListToMan opts) $ splitSentences inlines return $ text ".PP" $$ contents -blockToMan _ (RawHtml _) = return empty +blockToMan _ (RawBlock "man" str) = return $ text str +blockToMan _ (RawBlock _ _) = return empty blockToMan _ HorizontalRule = return $ text ".PP" $$ text " * * * * *" blockToMan opts (Header level inlines) = do contents <- inlineListToMan opts inlines @@ -313,8 +314,8 @@ inlineToMan opts (Math InlineMath str) = inlineListToMan opts $ readTeXMath str inlineToMan opts (Math DisplayMath str) = do contents <- inlineListToMan opts $ readTeXMath str return $ cr <> text ".RS" $$ contents $$ text ".RE" -inlineToMan _ (TeX _) = return empty -inlineToMan _ (HtmlInline _) = return empty +inlineToMan _ (RawInline "man" str) = return $ text str +inlineToMan _ (RawInline _ _) = return empty inlineToMan _ (LineBreak) = return $ cr <> text ".PD 0" $$ text ".P" $$ text ".PD" <> cr inlineToMan _ Space = return space diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 3c0d4cc6d..c2a3a730c 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -75,8 +75,7 @@ plainify = bottomUp go go (SmallCaps xs) = SmallCaps xs go (Code s) = Str s go (Math _ s) = Str s - go (TeX _) = Str "" - go (HtmlInline _) = Str "" + go (RawInline _ _) = Str "" go (Link xs _) = SmallCaps xs go (Image xs _) = SmallCaps $ [Str "["] ++ xs ++ [Str "]"] go (Cite _ cits) = SmallCaps cits @@ -206,11 +205,13 @@ blockToMarkdown opts (Para inlines) = do then text "\\" else empty return $ esc <> contents <> blankline -blockToMarkdown _ (RawHtml str) = do - st <- get - if stPlain st - then return empty - else return $ text str <> text "\n" +blockToMarkdown _ (RawBlock f str) + | f == "html" || f == "latex" || f == "markdown" = do + st <- get + if stPlain st + then return empty + else return $ text str <> text "\n" +blockToMarkdown _ (RawBlock _ _) = return empty blockToMarkdown _ HorizontalRule = return $ blankline <> text "* * * * *" <> blankline blockToMarkdown opts (Header level inlines) = do @@ -439,8 +440,9 @@ inlineToMarkdown _ (Math InlineMath str) = return $ "$" <> text str <> "$" inlineToMarkdown _ (Math DisplayMath str) = return $ "$$" <> text str <> "$$" -inlineToMarkdown _ (TeX str) = return $ text str -inlineToMarkdown _ (HtmlInline str) = return $ text str +inlineToMarkdown _ (RawInline f str) + | f == "html" || f == "latex" || f == "markdown" = return $ text str +inlineToMarkdown _ (RawInline _ _) = return empty inlineToMarkdown opts (LineBreak) = return $ if writerStrictMarkdown opts then " " <> cr diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index e8cb33caf..1400b5846 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -96,7 +96,9 @@ blockToMediaWiki opts (Para inlines) = do then "<p>" ++ contents ++ "</p>" else contents ++ if null listLevel then "\n" else "" -blockToMediaWiki _ (RawHtml str) = return str +blockToMediaWiki _ (RawBlock "mediawiki" str) = return str +blockToMediaWiki _ (RawBlock "html" str) = return str +blockToMediaWiki _ (RawBlock _ _) = return "" blockToMediaWiki _ HorizontalRule = return "\n-----\n" @@ -368,9 +370,9 @@ inlineToMediaWiki _ (Str str) = return $ escapeString str inlineToMediaWiki _ (Math _ str) = return $ "<math>" ++ str ++ "</math>" -- note: str should NOT be escaped -inlineToMediaWiki _ (TeX _) = return "" - -inlineToMediaWiki _ (HtmlInline str) = return str +inlineToMediaWiki _ (RawInline "mediawiki" str) = return str +inlineToMediaWiki _ (RawInline "html" str) = return str +inlineToMediaWiki _ (RawInline _ _) = return "" inlineToMediaWiki _ (LineBreak) = return "<br />\n" diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 3dc3bd974..59980a30c 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -279,7 +279,7 @@ blockToOpenDocument o bs | Header i b <- bs = inHeaderTags i <$> inlinesToOpenDocument o b | BlockQuote b <- bs = mkBlockQuote b | CodeBlock _ s <- bs = preformatted s - | RawHtml _ <- bs = return empty + | RawBlock _ _ <- bs = return empty | DefinitionList b <- bs = defList b | BulletList b <- bs = bulletListToOpenDocument o b | OrderedList a b <- bs = orderedList a b @@ -365,8 +365,9 @@ inlineToOpenDocument o ils | Code s <- ils = preformatted s | Math _ s <- ils = inlinesToOpenDocument o (readTeXMath s) | Cite _ l <- ils = inlinesToOpenDocument o l - | TeX _ <- ils = return empty - | HtmlInline s <- ils = preformatted s + | RawInline "opendocument" s <- ils = preformatted s + | RawInline "html" s <- ils = preformatted s -- for backwards compat. + | RawInline _ _ <- ils = return empty | Link l (s,t) <- ils = mkLink s t <$> inlinesToOpenDocument o l | Image _ (s,_) <- ils = return $ mkImg s | Note l <- ils = mkNote l diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 59f7e14f5..af4070696 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -115,9 +115,12 @@ blockToOrg (Para [Image txt (src,tit)]) = do blockToOrg (Para inlines) = do contents <- inlineListToOrg inlines return $ contents <> blankline -blockToOrg (RawHtml str) = +blockToOrg (RawBlock "html" str) = return $ blankline $$ "#+BEGIN_HTML" $$ nest 2 (text str) $$ "#+END_HTML" $$ blankline +blockToOrg (RawBlock "latex" str) = return $ text str +blockToOrg (RawBlock "org" str) = return $ text str +blockToOrg (RawBlock _ _) = return empty blockToOrg HorizontalRule = return $ blankline $$ "--------------" $$ blankline blockToOrg (Header level inlines) = do contents <- inlineListToOrg inlines @@ -257,8 +260,8 @@ inlineToOrg (Math t str) = do return $ if t == InlineMath then "$" <> text str <> "$" else "$$" <> text str <> "$$" -inlineToOrg (TeX str) = return $ text str -inlineToOrg (HtmlInline _) = return empty +inlineToOrg (RawInline "latex" str) = return $ text str +inlineToOrg (RawInline _ _) = return empty inlineToOrg (LineBreak) = return cr -- there's no line break in Org inlineToOrg Space = return space inlineToOrg (Link txt (src, _)) = do diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index e36df0602..1d1f79d57 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -148,8 +148,8 @@ blockToRST (Para [Image txt (src,tit)]) = do blockToRST (Para inlines) = do contents <- inlineListToRST inlines return $ contents <> blankline -blockToRST (RawHtml str) = - return $ blankline <> ".. raw:: html" $+$ +blockToRST (RawBlock f str) = + return $ blankline <> ".. raw:: " <> text f $+$ (nest 3 $ text str) $$ blankline blockToRST HorizontalRule = return $ blankline $$ "--------------" $$ blankline @@ -292,8 +292,7 @@ inlineToRST (Math t str) = do return $ if t == InlineMath then ":math:`$" <> text str <> "$`" else ":math:`$$" <> text str <> "$$`" -inlineToRST (TeX _) = return empty -inlineToRST (HtmlInline _) = return empty +inlineToRST (RawInline _ _) = return empty inlineToRST (LineBreak) = return cr -- there's no line break in RST inlineToRST Space = return space inlineToRST (Link [Code str] (src, _)) | src == str || diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index ae71e1307..31a28101c 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -159,7 +159,8 @@ blockToRTF indent alignment (BlockQuote lst) = concatMap (blockToRTF (indent + indentIncrement) alignment) lst blockToRTF indent _ (CodeBlock _ str) = rtfPar indent 0 AlignLeft ("\\f1 " ++ (codeStringToRTF str)) -blockToRTF _ _ (RawHtml _) = "" +blockToRTF _ _ (RawBlock "rtf" str) = str +blockToRTF _ _ (RawBlock _ _) = "" blockToRTF indent alignment (BulletList lst) = spaceAtEnd $ concatMap (listItemToRTF alignment indent (bulletMarker indent)) lst blockToRTF indent alignment (OrderedList attribs lst) = spaceAtEnd $ concat $ @@ -268,8 +269,8 @@ inlineToRTF (Code str) = "{\\f1 " ++ (codeStringToRTF str) ++ "}" inlineToRTF (Str str) = stringToRTF str inlineToRTF (Math _ str) = inlineListToRTF $ readTeXMath str inlineToRTF (Cite _ lst) = inlineListToRTF lst -inlineToRTF (TeX _) = "" -inlineToRTF (HtmlInline _) = "" +inlineToRTF (RawInline "rtf" str) = str +inlineToRTF (RawInline _ _) = "" inlineToRTF (LineBreak) = "\\line " inlineToRTF Space = " " inlineToRTF (Link text (src, _)) = diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 50d141f6c..9869e67b6 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -129,7 +129,10 @@ blockToTexinfo (CodeBlock _ str) = do flush (text str) $$ text "@end verbatim" <> blankline -blockToTexinfo (RawHtml _) = return empty +blockToTexinfo (RawBlock "texinfo" str) = return $ text str +blockToTexinfo (RawBlock "latex" str) = + return $ text "@tex" $$ text str $$ text "@end tex" +blockToTexinfo (RawBlock _ _) = return empty blockToTexinfo (BulletList lst) = do items <- mapM listItemToTexinfo lst @@ -388,8 +391,10 @@ 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 (TeX str) = return $ text "@tex" $$ text str $$ text "@end tex" -inlineToTexinfo (HtmlInline _) = return empty +inlineToTexinfo (RawInline "latex" str) = + return $ text "@tex" $$ text str $$ text "@end tex" +inlineToTexinfo (RawInline "texinfo" str) = return $ text str +inlineToTexinfo (RawInline _ _) = return empty inlineToTexinfo (LineBreak) = return $ text "@*" inlineToTexinfo Space = return $ char ' ' diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index cab582fc3..9bfff0dba 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -109,7 +109,10 @@ blockToTextile opts (Para inlines) = do then "<p>" ++ contents ++ "</p>" else contents ++ if null listLevel then "\n" else "" -blockToTextile _ (RawHtml str) = return str +blockToTextile _ (RawBlock f str) = + if f == "html" || f == "textile" + then return str + else return "" blockToTextile _ HorizontalRule = return "<hr />\n" @@ -385,9 +388,10 @@ inlineToTextile _ (Str str) = return $ escapeStringForTextile str inlineToTextile _ (Math _ str) = return $ "<span class=\"math\">" ++ escapeStringForXML str ++ "</math>" -inlineToTextile _ (TeX _) = return "" - -inlineToTextile _ (HtmlInline str) = return str +inlineToTextile _ (RawInline f str) = + if f == "html" || f == "textile" + then return str + else return "" inlineToTextile _ (LineBreak) = return "\n" diff --git a/tests/Tests/Arbitrary.hs b/tests/Tests/Arbitrary.hs index 1da7db143..0191fda7b 100644 --- a/tests/Tests/Arbitrary.hs +++ b/tests/Tests/Arbitrary.hs @@ -35,6 +35,8 @@ arbInline n = frequency $ [ (60, liftM Str realString) , (5, return EnDash) , (5, return Apostrophe) , (5, return Ellipses) + , (5, elements [ RawInline "html" "<a>*&*</a>" + , RawInline "latex" "\\my{command}" ]) ] ++ [ x | x <- nesters, n > 1] where nesters = [ (10, liftM Emph $ listOf $ arbInline (n-1)) , (10, liftM Strong $ listOf $ arbInline (n-1)) @@ -66,7 +68,11 @@ arbBlock :: Int -> Gen Block arbBlock n = frequency $ [ (10, liftM Plain arbitrary) , (15, liftM Para arbitrary) , (5, liftM2 CodeBlock arbitrary realString) - , (2, liftM RawHtml realString) + , (2, elements [ RawBlock "html" + "<div>\n*&*\n</div>" + , RawBlock "latex" + "\\begin[opt]{env}\nhi\n{\\end{env}" + ]) , (5, do x1 <- choose (1 :: Int, 6) x2 <- arbitrary return (Header x1 x2)) diff --git a/tests/latex-reader.native b/tests/latex-reader.native index 79c48fca0..cb5f201aa 100644 --- a/tests/latex-reader.native +++ b/tests/latex-reader.native @@ -259,7 +259,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,Header 1 [Str "LaTeX"] ,BulletList [[Para [Cite [Citation {citationId = "smith.1899", citationPrefix = [], citationSuffix = [Str "22",Str "-",Str "23"], citationMode = NormalCitation, citationNoteNum = 0, citationHash = 0}] []]] - ,[Para [TeX "\\doublespacing"]] + ,[Para [RawInline "latex" "\\doublespacing"]] ,[Para [Math InlineMath "2+2=4"]] ,[Para [Math InlineMath "x \\in y"]] ,[Para [Math InlineMath "\\alpha \\wedge \\omega"]] diff --git a/tests/markdown-reader-more.native b/tests/markdown-reader-more.native index ce093b9fa..003eceb70 100644 --- a/tests/markdown-reader-more.native +++ b/tests/markdown-reader-more.native @@ -2,8 +2,8 @@ ,Header 2 [Str "Blank",Space,Str "line",Space,Str "before",Space,Str "URL",Space,Str "in",Space,Str "link",Space,Str "reference"] ,Para [Link [Str "foo"] ("/url",""),Space,Str "and",Space,Link [Str "bar"] ("/url","title")] ,Header 2 [Str "Raw",Space,Str "ConTeXt",Space,Str "environments"] -,Para [TeX "\\placeformula",Space,TeX "\\startformula\n L_{1} = L_{2}\n \\stopformula"] -,Para [TeX "\\start[a2]\n\\start[a2]\n\\stop[a2]\n\\stop[a2]"] +,Para [RawInline "latex" "\\placeformula",Space,RawInline "latex" "\\startformula\n L_{1} = L_{2}\n \\stopformula"] +,RawBlock "latex" "\\start[a2]\n\\start[a2]\n\\stop[a2]\n\\stop[a2]" ,Header 2 [Str "URLs",Space,Str "with",Space,Str "spaces"] ,Para [Link [Str "foo"] ("/bar%20and%20baz",""),Space,Link [Str "foo"] ("/bar%20and%20baz",""),Space,Link [Str "foo"] ("/bar%20and%20baz",""),Space,Link [Str "foo"] ("bar%20baz","title")] ,Para [Link [Str "baz"] ("/foo%20foo",""),Space,Link [Str "bam"] ("/foo%20fee",""),Space,Link [Str "bork"] ("/foo/zee%20zob","title")] @@ -11,13 +11,13 @@ ,HorizontalRule ,HorizontalRule ,Header 2 [Str "Raw",Space,Str "HTML",Space,Str "before",Space,Str "header"] -,Plain [HtmlInline "<a>",HtmlInline "</a>"] +,Plain [RawInline "html" "<a>",RawInline "html" "</a>"] ,Header 3 [Str "my",Space,Str "header"] ,Header 2 [Str "$",Space,Str "in",Space,Str "math"] ,Para [Math InlineMath "\\$2 + \\$3"] ,Header 2 [Str "Commented",Str "-",Str "out",Space,Str "list",Space,Str "item"] ,BulletList - [[Plain [Str "one",Space,HtmlInline "<!--\n- two\n-->"]] + [[Plain [Str "one",Space,RawInline "html" "<!--\n- two\n-->"]] ,[Plain [Str "three"]]] ,Header 2 [Str "Backslash",Space,Str "newline"] ,Para [Str "hi",LineBreak,Str "there"] diff --git a/tests/rst-reader.native b/tests/rst-reader.native index 1134cb245..e11e7b0ed 100644 --- a/tests/rst-reader.native +++ b/tests/rst-reader.native @@ -174,11 +174,11 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite",Str ": [[Plain [Str "123",EnDash,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 ":"] -,RawHtml "<div>foo</div>\n" +,RawBlock "html" "<div>foo</div>\n" ,Para [Str "Now,",Space,Str "nested",Str ":"] -,RawHtml "<div>\n <div>\n <div>\n foo\n </div>\n </div>\n</div>\n" +,RawBlock "html" "<div>\n <div>\n <div>\n foo\n </div>\n </div>\n</div>\n" ,Header 1 [Str "LaTeX",Space,Str "Block"] -,Para [TeX "\\begin{tabular}{|l|l|}\\hline\nAnimal & Number \\\\ \\hline\nDog & 2 \\\\\nCat & 1 \\\\ \\hline\n\\end{tabular}\n"] +,RawBlock "latex" "\\begin{tabular}{|l|l|}\\hline\nAnimal & Number \\\\ \\hline\nDog & 2 \\\\\nCat & 1 \\\\ \\hline\n\\end{tabular}\n" ,Header 1 [Str "Inline",Space,Str "Markup"] ,Para [Str "This",Space,Str "is",Space,Emph [Str "emphasized"],Str ".",Space,Str "This",Space,Str "is",Space,Strong [Str "strong"],Str "."] ,Para [Str "This",Space,Str "is",Space,Str "code",Str ":",Space,Code ">",Str ",",Space,Code "$",Str ",",Space,Code "\\",Str ",",Space,Code "\\$",Str ",",Space,Code "<html>",Str "."] diff --git a/tests/testsuite.native b/tests/testsuite.native index 072849bbf..607c95eb2 100644 --- a/tests/testsuite.native +++ b/tests/testsuite.native @@ -228,45 +228,45 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,[Plain [Str "sublist"]]]]])] ,Header 1 [Str "HTML",Space,Str "Blocks"] ,Para [Str "Simple",Space,Str "block",Space,Str "on",Space,Str "one",Space,Str "line",Str ":"] -,RawHtml "<div>" +,RawBlock "html" "<div>" ,Plain [Str "foo"] -,RawHtml "</div>\n" +,RawBlock "html" "</div>\n" ,Para [Str "And",Space,Str "nested",Space,Str "without",Space,Str "indentation",Str ":"] -,RawHtml "<div>\n<div>\n<div>" +,RawBlock "html" "<div>\n<div>\n<div>" ,Plain [Str "foo"] -,RawHtml "</div>\n</div>\n<div>" +,RawBlock "html" "</div>\n</div>\n<div>" ,Plain [Str "bar"] -,RawHtml "</div>\n</div>\n" +,RawBlock "html" "</div>\n</div>\n" ,Para [Str "Interpreted",Space,Str "markdown",Space,Str "in",Space,Str "a",Space,Str "table",Str ":"] -,RawHtml "<table>\n<tr>\n<td>" +,RawBlock "html" "<table>\n<tr>\n<td>" ,Plain [Str "This",Space,Str "is",Space,Emph [Str "emphasized"]] -,RawHtml "</td>\n<td>" +,RawBlock "html" "</td>\n<td>" ,Plain [Str "And",Space,Str "this",Space,Str "is",Space,Strong [Str "strong"]] -,RawHtml "</td>\n</tr>\n</table>\n\n<script type=\"text/javascript\">document.write('This *should not* be interpreted as markdown');</script>\n" +,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 ":"] -,RawHtml "<div>\n " +,RawBlock "html" "<div>\n " ,Plain [Str "foo"] -,RawHtml "</div>\n" +,RawBlock "html" "</div>\n" ,Para [Str "This",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "code",Space,Str "block",Str ",",Space,Str "though",Str ":"] ,CodeBlock ("",[],[]) "<div>\n foo\n</div>" ,Para [Str "As",Space,Str "should",Space,Str "this",Str ":"] ,CodeBlock ("",[],[]) "<div>foo</div>" ,Para [Str "Now",Str ",",Space,Str "nested",Str ":"] -,RawHtml "<div>\n <div>\n <div>\n " +,RawBlock "html" "<div>\n <div>\n <div>\n " ,Plain [Str "foo"] -,RawHtml "</div>\n </div>\n</div>\n" +,RawBlock "html" "</div>\n </div>\n</div>\n" ,Para [Str "This",Space,Str "should",Space,Str "just",Space,Str "be",Space,Str "an",Space,Str "HTML",Space,Str "comment",Str ":"] -,RawHtml "<!-- Comment -->\n" +,RawBlock "html" "<!-- Comment -->\n" ,Para [Str "Multiline",Str ":"] -,RawHtml "<!--\nBlah\nBlah\n-->\n\n<!--\n This is another comment.\n-->\n" +,RawBlock "html" "<!--\nBlah\nBlah\n-->\n\n<!--\n This is another comment.\n-->\n" ,Para [Str "Code",Space,Str "block",Str ":"] ,CodeBlock ("",[],[]) "<!-- Comment -->" ,Para [Str "Just",Space,Str "plain",Space,Str "comment",Str ",",Space,Str "with",Space,Str "trailing",Space,Str "spaces",Space,Str "on",Space,Str "the",Space,Str "line",Str ":"] -,RawHtml "<!-- foo --> \n" +,RawBlock "html" "<!-- foo --> \n" ,Para [Str "Code",Str ":"] ,CodeBlock ("",[],[]) "<hr />" ,Para [Str "Hr",Apostrophe,Str "s",Str ":"] -,RawHtml "<hr>\n\n<hr />\n\n<hr />\n\n<hr> \n\n<hr /> \n\n<hr /> \n\n<hr class=\"foo\" id=\"bar\" />\n\n<hr class=\"foo\" id=\"bar\" />\n\n<hr class=\"foo\" id=\"bar\">\n" +,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"] ,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 "."] @@ -294,7 +294,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,HorizontalRule ,Header 1 [Str "LaTeX"] ,BulletList - [[Plain [TeX "\\cite[22-23]{smith.1899}"]] + [[Plain [RawInline "latex" "\\cite[22-23]{smith.1899}"]] ,[Plain [Math InlineMath "2+2=4"]] ,[Plain [Math InlineMath "x \\in y"]] ,[Plain [Math InlineMath "\\alpha \\wedge \\omega"]] @@ -309,7 +309,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,[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 [TeX "\\begin{tabular}{|l|l|}\\hline\nAnimal & Number \\\\ \\hline\nDog & 2 \\\\\nCat & 1 \\\\ \\hline\n\\end{tabular}"] +,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"] ,Para [Str "Here",Space,Str "is",Space,Str "some",Space,Str "unicode",Str ":"] diff --git a/tests/textile-reader.native b/tests/textile-reader.native index d0079cd19..fad1c0972 100644 --- a/tests/textile-reader.native +++ b/tests/textile-reader.native @@ -125,18 +125,18 @@ Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []}) ,[Plain [Str "24"]] ,[Plain [Str "f"]]]] ,Header 1 [Str "Raw",Space,Str "HTML"] -,Para [Str "However",Str ",",Space,HtmlInline "<strong>",Space,Str "raw",Space,Str "HTML",Space,Str "inlines",Space,HtmlInline "</strong>",Space,Str "are",Space,Str "accepted",Str ",",Space,Str "as",Space,Str "well",Space,Str "as",Space,Str ":"] -,RawHtml "<div class=\"foobar\">" +,Para [Str "However",Str ",",Space,RawInline "html" "<strong>",Space,Str "raw",Space,Str "HTML",Space,Str "inlines",Space,RawInline "html" "</strong>",Space,Str "are",Space,Str "accepted",Str ",",Space,Str "as",Space,Str "well",Space,Str "as",Space,Str ":"] +,RawBlock "html" "<div class=\"foobar\">" ,Para [Str "any",Space,Strong [Str "Raw",Space,Str "HTML",Space,Str "Block"],Space,Str "with",Space,Str "bold",LineBreak] -,RawHtml "</div>" +,RawBlock "html" "</div>" ,Para [Str "Html",Space,Str "blocks",Space,Str "can",Space,Str "be"] -,RawHtml "<div>" +,RawBlock "html" "<div>" ,Para [Str "inlined"] -,RawHtml "</div>" +,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 "but",Space,Str "this",Space,HtmlInline "<strong>",Space,Str "will",Space,Str "produce",Space,Str "inline",Space,Str "html",Space,HtmlInline "</strong>"]]] + ,[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"] ,Para [Str "PBS",Space,Str "(",Str "Public",Space,Str "Broadcasting",Space,Str "System",Str ")"] diff --git a/tests/writer.context b/tests/writer.context index 316cd7735..f47249c5a 100644 --- a/tests/writer.context +++ b/tests/writer.context @@ -696,7 +696,6 @@ Animal & Number \\ \hline Dog & 2 \\ Cat & 1 \\ \hline \end{tabular} - \thinrule \subject{Special Characters} diff --git a/tests/writer.docbook b/tests/writer.docbook index 15704f8bf..e7e948288 100644 --- a/tests/writer.docbook +++ b/tests/writer.docbook @@ -1133,8 +1133,6 @@ These should not be escaped: \$ \\ \> \[ \{ <para> Here's a LaTeX table: </para> - <para> - </para> </section> <section id="special-characters"> <title>Special Characters</title> diff --git a/tests/writer.html b/tests/writer.html index ae83dc20f..f2c850c81 100644 --- a/tests/writer.html +++ b/tests/writer.html @@ -846,8 +846,6 @@ Blah ></ul ><p >Here’s a LaTeX table:</p -><p -></p ><hr /><h1 id="special-characters" >Special Characters</h1 diff --git a/tests/writer.latex b/tests/writer.latex index e6adff585..44e11c874 100644 --- a/tests/writer.latex +++ b/tests/writer.latex @@ -634,7 +634,6 @@ Animal & Number \\ \hline Dog & 2 \\ Cat & 1 \\ \hline \end{tabular} - \begin{center}\rule{3in}{0.4pt}\end{center} \section{Special Characters} diff --git a/tests/writer.man b/tests/writer.man index 80897f252..bdbb91604 100644 --- a/tests/writer.man +++ b/tests/writer.man @@ -591,7 +591,6 @@ Escaped \f[C]$\f[]: $73 \f[I]this should be emphasized\f[] 23$. .PP Here's a LaTeX table: .PP -.PP * * * * * .SH Special Characters .PP diff --git a/tests/writer.mediawiki b/tests/writer.mediawiki index 557396bfb..af4f7050c 100644 --- a/tests/writer.mediawiki +++ b/tests/writer.mediawiki @@ -496,7 +496,6 @@ Here’s a LaTeX table: - ----- = Special Characters = diff --git a/tests/writer.native b/tests/writer.native index 072849bbf..607c95eb2 100644 --- a/tests/writer.native +++ b/tests/writer.native @@ -228,45 +228,45 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,[Plain [Str "sublist"]]]]])] ,Header 1 [Str "HTML",Space,Str "Blocks"] ,Para [Str "Simple",Space,Str "block",Space,Str "on",Space,Str "one",Space,Str "line",Str ":"] -,RawHtml "<div>" +,RawBlock "html" "<div>" ,Plain [Str "foo"] -,RawHtml "</div>\n" +,RawBlock "html" "</div>\n" ,Para [Str "And",Space,Str "nested",Space,Str "without",Space,Str "indentation",Str ":"] -,RawHtml "<div>\n<div>\n<div>" +,RawBlock "html" "<div>\n<div>\n<div>" ,Plain [Str "foo"] -,RawHtml "</div>\n</div>\n<div>" +,RawBlock "html" "</div>\n</div>\n<div>" ,Plain [Str "bar"] -,RawHtml "</div>\n</div>\n" +,RawBlock "html" "</div>\n</div>\n" ,Para [Str "Interpreted",Space,Str "markdown",Space,Str "in",Space,Str "a",Space,Str "table",Str ":"] -,RawHtml "<table>\n<tr>\n<td>" +,RawBlock "html" "<table>\n<tr>\n<td>" ,Plain [Str "This",Space,Str "is",Space,Emph [Str "emphasized"]] -,RawHtml "</td>\n<td>" +,RawBlock "html" "</td>\n<td>" ,Plain [Str "And",Space,Str "this",Space,Str "is",Space,Strong [Str "strong"]] -,RawHtml "</td>\n</tr>\n</table>\n\n<script type=\"text/javascript\">document.write('This *should not* be interpreted as markdown');</script>\n" +,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 ":"] -,RawHtml "<div>\n " +,RawBlock "html" "<div>\n " ,Plain [Str "foo"] -,RawHtml "</div>\n" +,RawBlock "html" "</div>\n" ,Para [Str "This",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "code",Space,Str "block",Str ",",Space,Str "though",Str ":"] ,CodeBlock ("",[],[]) "<div>\n foo\n</div>" ,Para [Str "As",Space,Str "should",Space,Str "this",Str ":"] ,CodeBlock ("",[],[]) "<div>foo</div>" ,Para [Str "Now",Str ",",Space,Str "nested",Str ":"] -,RawHtml "<div>\n <div>\n <div>\n " +,RawBlock "html" "<div>\n <div>\n <div>\n " ,Plain [Str "foo"] -,RawHtml "</div>\n </div>\n</div>\n" +,RawBlock "html" "</div>\n </div>\n</div>\n" ,Para [Str "This",Space,Str "should",Space,Str "just",Space,Str "be",Space,Str "an",Space,Str "HTML",Space,Str "comment",Str ":"] -,RawHtml "<!-- Comment -->\n" +,RawBlock "html" "<!-- Comment -->\n" ,Para [Str "Multiline",Str ":"] -,RawHtml "<!--\nBlah\nBlah\n-->\n\n<!--\n This is another comment.\n-->\n" +,RawBlock "html" "<!--\nBlah\nBlah\n-->\n\n<!--\n This is another comment.\n-->\n" ,Para [Str "Code",Space,Str "block",Str ":"] ,CodeBlock ("",[],[]) "<!-- Comment -->" ,Para [Str "Just",Space,Str "plain",Space,Str "comment",Str ",",Space,Str "with",Space,Str "trailing",Space,Str "spaces",Space,Str "on",Space,Str "the",Space,Str "line",Str ":"] -,RawHtml "<!-- foo --> \n" +,RawBlock "html" "<!-- foo --> \n" ,Para [Str "Code",Str ":"] ,CodeBlock ("",[],[]) "<hr />" ,Para [Str "Hr",Apostrophe,Str "s",Str ":"] -,RawHtml "<hr>\n\n<hr />\n\n<hr />\n\n<hr> \n\n<hr /> \n\n<hr /> \n\n<hr class=\"foo\" id=\"bar\" />\n\n<hr class=\"foo\" id=\"bar\" />\n\n<hr class=\"foo\" id=\"bar\">\n" +,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"] ,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 "."] @@ -294,7 +294,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,HorizontalRule ,Header 1 [Str "LaTeX"] ,BulletList - [[Plain [TeX "\\cite[22-23]{smith.1899}"]] + [[Plain [RawInline "latex" "\\cite[22-23]{smith.1899}"]] ,[Plain [Math InlineMath "2+2=4"]] ,[Plain [Math InlineMath "x \\in y"]] ,[Plain [Math InlineMath "\\alpha \\wedge \\omega"]] @@ -309,7 +309,7 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA ,[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 [TeX "\\begin{tabular}{|l|l|}\\hline\nAnimal & Number \\\\ \\hline\nDog & 2 \\\\\nCat & 1 \\\\ \\hline\n\\end{tabular}"] +,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"] ,Para [Str "Here",Space,Str "is",Space,Str "some",Space,Str "unicode",Str ":"] diff --git a/tests/writer.rst b/tests/writer.rst index 79d989915..189886a87 100644 --- a/tests/writer.rst +++ b/tests/writer.rst @@ -617,6 +617,14 @@ These shouldn’t be math: Here’s a LaTeX table: +.. raw:: latex + + \begin{tabular}{|l|l|}\hline + Animal & Number \\ \hline + Dog & 2 \\ + Cat & 1 \\ \hline + \end{tabular} + -------------- Special Characters diff --git a/tests/writer.rtf b/tests/writer.rtf index 3cb1d2996..3acbe4ef5 100644 --- a/tests/writer.rtf +++ b/tests/writer.rtf @@ -277,7 +277,6 @@ quoted link {\pard \ql \f0 \sa0 \li360 \fi-360 \bullet \tx360\tab Shoes ($20) and socks ($5).\par} {\pard \ql \f0 \sa0 \li360 \fi-360 \bullet \tx360\tab Escaped {\f1 $}: $73 {\i this should be emphasized} 23$.\sa180\par} {\pard \ql \f0 \sa180 \li0 \fi0 Here\u8217's a LaTeX table:\par} -{\pard \ql \f0 \sa180 \li0 \fi0 \par} {\pard \qc \f0 \sa180 \li0 \fi0 \emdash\emdash\emdash\emdash\emdash\par} {\pard \ql \f0 \sa180 \li0 \fi0 \b \fs36 Special Characters\par} {\pard \ql \f0 \sa180 \li0 \fi0 Here is some unicode:\par} diff --git a/tests/writer.texinfo b/tests/writer.texinfo index 62611d7a6..4e08e8f63 100644 --- a/tests/writer.texinfo +++ b/tests/writer.texinfo @@ -789,7 +789,6 @@ Dog & 2 \\ Cat & 1 \\ \hline \end{tabular} @end tex - @iftex @bigskip@hrule@bigskip @end iftex diff --git a/tests/writer.textile b/tests/writer.textile index 8abbdb848..51aca5a08 100644 --- a/tests/writer.textile +++ b/tests/writer.textile @@ -533,7 +533,6 @@ These shouldn't be math: Here's a LaTeX table: - <hr /> h1. Special Characters |