Textile reader: Removed raw LaTeX parsing.

This isn't part of Textile.
This commit is contained in:
John MacFarlane 2013-08-07 14:30:47 -07:00
parent d44d166431
commit bb61624bb2

View file

@ -56,7 +56,6 @@ import Text.Pandoc.Shared
import Text.Pandoc.Options
import Text.Pandoc.Parsing
import Text.Pandoc.Readers.HTML ( htmlTag, isInlineTag, isBlockTag )
import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock )
import Text.HTML.TagSoup (parseTags, innerText, fromAttrib, Tag(..))
import Text.HTML.TagSoup.Match
import Data.List ( intercalate )
@ -126,7 +125,6 @@ blockParsers = [ codeBlock
, commentBlock
, anyList
, rawHtmlBlock
, rawLaTeXBlock'
, maybeExplicitBlock "table" table
, maybeExplicitBlock "p" para
]
@ -292,13 +290,6 @@ rawHtmlBlock = try $ do
optional blanklines
return $ RawBlock "html" b
-- | Raw block of LaTeX content
rawLaTeXBlock' :: Parser [Char] ParserState Block
rawLaTeXBlock' = do
guardEnabled Ext_raw_tex
RawBlock "latex" <$> (rawLaTeXBlock <* spaces)
-- | In textile, paragraphs are separated by blank lines.
para :: Parser [Char] ParserState Block
para = try $ Para . normalizeSpaces <$> manyTill inline blockBreak
@ -373,7 +364,6 @@ inlineParsers = [ str
, escapedInline
, htmlSpan
, rawHtmlInline
, rawLaTeXInline'
, note
, try $ (char '[' *> inlineMarkup <* char ']')
, inlineMarkup
@ -489,12 +479,6 @@ endline = try $ do
rawHtmlInline :: Parser [Char] ParserState Inline
rawHtmlInline = RawInline "html" . snd <$> htmlTag isInlineTag
-- | Raw LaTeX Inline
rawLaTeXInline' :: Parser [Char] ParserState Inline
rawLaTeXInline' = try $ do
guardEnabled Ext_raw_tex
rawLaTeXInline
-- | Textile standard link syntax is "label":target. But we
-- can also have ["label":target].
link :: Parser [Char] ParserState Inline