{- This module was generated from data in the Kate syntax highlighting file latex.xml, version 1.47,
   by  Jeroen Wijnhout (Jeroen.Wijnhout@kdemail.net)+Holger Danielsson (holger.danielsson@versanet.de)+Michel Ludwig (michel.ludwig@kdemail.net)+Thomas Braun (thomas.braun@virtuell-zuhause.de) -}

module Text.Highlighting.Kate.Syntax.Latex ( highlight, parseExpression, syntaxName, syntaxExtensions ) where
import Text.Highlighting.Kate.Definitions
import Text.Highlighting.Kate.Common
import Text.ParserCombinators.Parsec
import Control.Monad (when)
import Data.Map (fromList)
import Data.Maybe (fromMaybe, maybeToList)

-- | Full name of language.
syntaxName :: String
syntaxName = "LaTeX"

-- | Filename extensions for this language.
syntaxExtensions :: String
syntaxExtensions = "*.tex;*.ltx;*.dtx;*.sty;*.cls;*.bbx;*.cbx;*.lbx;"

-- | Highlight source code using this syntax definition.
highlight :: String -> Either String [SourceLine]
highlight input =
  case runParser parseSource startingState "source" input of
    Left err     -> Left $ show err
    Right result -> Right result

-- | Parse an expression using appropriate local context.
parseExpression :: GenParser Char SyntaxState LabeledSource
parseExpression = do
  st <- getState
  let oldLang = synStLanguage st
  setState $ st { synStLanguage = "LaTeX" }
  context <- currentContext <|> (pushContext "Normal Text" >> currentContext)
  result <- parseRules context
  updateState $ \st -> st { synStLanguage = oldLang }
  return result

parseSource = do 
  lineContents <- lookAhead wholeLine
  updateState $ \st -> st { synStCurrentLine = lineContents }
  result <- manyTill parseSourceLine eof
  return $ map normalizeHighlighting result

startingState = SyntaxState {synStContexts = fromList [("LaTeX",["Normal Text"])], synStLanguage = "LaTeX", synStCurrentLine = "", synStCharsParsedInLine = 0, synStPrevChar = '\n', synStCaseSensitive = True, synStKeywordCaseSensitive = True, synStCaptures = []}

parseSourceLine = manyTill parseExpressionInternal pEndLine

pEndLine = do
  lookAhead $ newline <|> (eof >> return '\n')
  context <- currentContext
  case context of
    "Normal Text" -> return () >> pHandleEndLine
    "NoWeb" -> return () >> pHandleEndLine
    "Sectioning" -> return () >> pHandleEndLine
    "SectioningInside" -> return () >> pHandleEndLine
    "SectioningContrSeq" -> (popContext) >> pEndLine
    "SectioningMathMode" -> return () >> pHandleEndLine
    "SectioningMathContrSeq" -> (popContext) >> pEndLine
    "Footnoting" -> return () >> pHandleEndLine
    "FootnotingInside" -> return () >> pHandleEndLine
    "FootnotingMathMode" -> return () >> pHandleEndLine
    "NewCommand" -> return () >> pHandleEndLine
    "DefCommand" -> return () >> pHandleEndLine
    "CommandParameterStart" -> return () >> pHandleEndLine
    "CommandParameter" -> return () >> pHandleEndLine
    "ContrSeq" -> (popContext) >> pEndLine
    "ToEndOfLine" -> (popContext) >> pEndLine
    "Verb" -> (popContext >> popContext) >> pEndLine
    "VerbEnd" -> (popContext >> popContext >> popContext) >> pEndLine
    "Label" -> return () >> pHandleEndLine
    "LabelOption" -> return () >> pHandleEndLine
    "LabelParameter" -> return () >> pHandleEndLine
    "FancyLabel" -> return () >> pHandleEndLine
    "FancyLabelParameter" -> return () >> pHandleEndLine
    "FancyLabelRoundBrackets" -> return () >> pHandleEndLine
    "FindEndEnvironment" -> return () >> pHandleEndLine
    "EndEnvironment" -> return () >> pHandleEndLine
    "EndLatexEnv" -> return () >> pHandleEndLine
    "FindBeginEnvironment" -> return () >> pHandleEndLine
    "BeginEnvironment" -> return () >> pHandleEndLine
    "LatexEnv" -> return () >> pHandleEndLine
    "VerbatimEnv" -> return () >> pHandleEndLine
    "VerbatimEnvParam" -> return () >> pHandleEndLine
    "Verbatim" -> return () >> pHandleEndLine
    "VerbFindEnd" -> (popContext) >> pEndLine
    "CommentEnv" -> return () >> pHandleEndLine
    "BlockComment" -> return () >> pHandleEndLine
    "CommFindEnd" -> (popContext) >> pEndLine
    "MathEnv" -> return () >> pHandleEndLine
    "MathEnvParam" -> return () >> pHandleEndLine
    "EnvCommon" -> return () >> pHandleEndLine
    "MathModeEnv" -> return () >> pHandleEndLine
    "MathFindEnd" -> (popContext) >> pEndLine
    "TabEnv" -> return () >> pHandleEndLine
    "Tab" -> return () >> pHandleEndLine
    "Column Separator" -> return () >> pHandleEndLine
    "TabFindEnd" -> (popContext) >> pEndLine
    "MathMode" -> return () >> pHandleEndLine
    "MathModeDisplay" -> return () >> pHandleEndLine
    "MathModeEquation" -> return () >> pHandleEndLine
    "MathModeEnsure" -> return () >> pHandleEndLine
    "MathModeCommon" -> return () >> pHandleEndLine
    "MathContrSeq" -> (popContext) >> pEndLine
    "MathModeText" -> return () >> pHandleEndLine
    "MathModeTextParameterStart" -> return () >> pHandleEndLine
    "MathModeTextParameter" -> return () >> pHandleEndLine
    "Multiline Comment" -> return () >> pHandleEndLine
    "Comment" -> (popContext) >> pEndLine
    _ -> pHandleEndLine

withAttribute attr txt = do
  when (null txt) $ fail "Parser matched no text"
  let labs = attr : maybeToList (lookup attr styles)
  st <- getState
  let oldCharsParsed = synStCharsParsedInLine st
  let prevchar = if null txt then '\n' else last txt
  updateState $ \st -> st { synStCharsParsedInLine = oldCharsParsed + length txt, synStPrevChar = prevchar } 
  return (labs, txt)

styles = [("Comment","co"),("Error","al"),("Region Marker","re"),("Alert","al")]

parseExpressionInternal = do
  context <- currentContext
  parseRules context <|> (pDefault >>= withAttribute (fromMaybe "" $ lookup context defaultAttributes))


regex_'5c'5cbegin'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 = compileRegex "\\\\begin(?=[^a-zA-Z])"
regex_'5c'5cend'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 = compileRegex "\\\\end(?=[^a-zA-Z])"
regex_'5c'5c'28cite'7cparencite'7cautocite'7cAutocite'7ccitetitle'29'5c'2a'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 = compileRegex "\\\\(cite|parencite|autocite|Autocite|citetitle)\\*(?=[^a-zA-Z])"
regex_'5c'5c'28cites'7cCites'7cparencites'7cParencites'7cautocites'7cAutocites'7csupercites'7cfootcites'7cFootcites'29'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 = compileRegex "\\\\(cites|Cites|parencites|Parencites|autocites|Autocites|supercites|footcites|Footcites)(?=[^a-zA-Z])"
regex_'5c'5c'28cite'7cnocite'7cCite'7cparencite'7cParencite'7cfootcite'7cFootcite'7ctextcite'7cTextcite'7csupercite'7cautocite'7cAutocite'7cciteauthor'7cCiteauthor'7ccitetitle'7cciteyear'7cciteurl'7cnocite'7cfullcite'7cfootfullcite'29'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 = compileRegex "\\\\(cite|nocite|Cite|parencite|Parencite|footcite|Footcite|textcite|Textcite|supercite|autocite|Autocite|citeauthor|Citeauthor|citetitle|citeyear|citeurl|nocite|fullcite|footfullcite)(?=[^a-zA-Z])"
regex_'5c'5c'28subref'5c'2a'3f'7ccref'5c'2a'3f'7clabel'7cpageref'7cautoref'7cref'7cvpageref'7cvref'7cpagecite'7ceqref'29'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 = compileRegex "\\\\(subref\\*?|cref\\*?|label|pageref|autoref|ref|vpageref|vref|pagecite|eqref)(?=[^a-zA-Z])"
regex_'5c'5c'28part'7cchapter'7csection'7csubsection'7csubsubsection'7cparagraph'7csubparagraph'29'5c'2a'3f'5cs'2a'28'3f'3d'5b'5c'7b'5c'5b'5d'29 = compileRegex "\\\\(part|chapter|section|subsection|subsubsection|paragraph|subparagraph)\\*?\\s*(?=[\\{\\[])"
regex_'5c'5c'28footnote'29'5c'2a'3f'5cs'2a'28'3f'3d'5b'5c'7b'5c'5b'5d'29 = compileRegex "\\\\(footnote)\\*?\\s*(?=[\\{\\[])"
regex_'5c'5c'28renewcommand'7cprovidenewcommand'7cnewcommand'29'5c'2a'3f'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 = compileRegex "\\\\(renewcommand|providenewcommand|newcommand)\\*?(?=[^a-zA-Z])"
regex_'5c'5c'28e'7cg'7cx'29'3fdef'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 = compileRegex "\\\\(e|g|x)?def(?=[^a-zA-Z])"
regex_'3c'3c'2e'2a'3e'3e'3d = compileRegex "<<.*>>="
regex_'25'5cs'2aBEGIN'2e'2a'24 = compileRegex "%\\s*BEGIN.*$"
regex_'25'5cs'2aEND'2e'2a'24 = compileRegex "%\\s*END.*$"
regex_'5cs'2a'40'5cs'2a = compileRegex "\\s*@\\s*"
regex_'5c'5b'5b'5e'5c'5d'5d'2a'5c'5d = compileRegex "\\[[^\\]]*\\]"
regex_'5ba'2dzA'2dZ'5d'2b'28'5c'2b'3f'7c'5c'2a'7b0'2c3'7d'29 = compileRegex "[a-zA-Z]+(\\+?|\\*{0,3})"
regex_'5b'5ea'2dzA'2dZ'5d = compileRegex "[^a-zA-Z]"
regex_'5ba'2dzA'2dZ'5d'2b'5c'2a'3f = compileRegex "[a-zA-Z]+\\*?"
regex_'5cs'2a'5c'7b'5cs'2a'5c'5c'5ba'2dzA'2dZ'5d'2b'5cs'2a'5c'7d'28'5c'5b'5cd'5c'5d'28'5c'5b'5b'5e'5c'5d'5d'2a'5c'5d'29'3f'29'3f'5c'7b = compileRegex "\\s*\\{\\s*\\\\[a-zA-Z]+\\s*\\}(\\[\\d\\](\\[[^\\]]*\\])?)?\\{"
regex_'5cs'2a'5c'5c'5ba'2dzA'2dZ'5d'2b'5b'5e'5c'7b'5d'2a'5c'7b = compileRegex "\\s*\\\\[a-zA-Z]+[^\\{]*\\{"
regex_'5c'5c'2e = compileRegex "\\\\."
regex_'28Verb'7cverb'7clstinline'29'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 = compileRegex "(Verb|verb|lstinline)(?=[^a-zA-Z])"
regex_'5ba'2dzA'2dZ'40'5d'2b'28'5c'2b'3f'7c'5c'2a'7b0'2c3'7d'29 = compileRegex "[a-zA-Z@]+(\\+?|\\*{0,3})"
regex_'5cs'2a'5c'7b'5cs'2a = compileRegex "\\s*\\{\\s*"
regex_'5cs'2a'5c'5b'5cs'2a = compileRegex "\\s*\\[\\s*"
regex_'5b'5e'5c'5b'5c'7b'5d'2b = compileRegex "[^\\[\\{]+"
regex_'5cs'2a'5c'5d'5cs'2a = compileRegex "\\s*\\]\\s*"
regex_'5cs'2a'5c'7d'5cs'2a = compileRegex "\\s*\\}\\s*"
regex_'5cs'2a'5c'28'5cs'2a = compileRegex "\\s*\\(\\s*"
regex_'5cs'2a'5c'29'5cs'2a = compileRegex "\\s*\\)\\s*"
regex_'5cS = compileRegex "\\S"
regex_'5ba'2dzA'2dZ'5d = compileRegex "[a-zA-Z]"
regex_'5cs'2b = compileRegex "\\s+"
regex_'5ba'2dzA'2dZ'5d'2b'28'5c'2a'29'3f = compileRegex "[a-zA-Z]+(\\*)?"
regex_'28lstlisting'7c'28B'7cL'29'3fVerbatim'29 = compileRegex "(lstlisting|(B|L)?Verbatim)"
regex_'28verbatim'7cboxedverbatim'29 = compileRegex "(verbatim|boxedverbatim)"
regex_comment = compileRegex "comment"
regex_'28alignat'7cxalignat'7cxxalignat'29 = compileRegex "(alignat|xalignat|xxalignat)"
regex_'28equation'7cdisplaymath'7ceqnarray'7csubeqnarray'7cmath'7cmultline'7cgather'7calign'7cflalign'7cIEEEeqnarray'7cIEEEeqnarraybox'7csmallmatrix'7cpmatrix'7cbmatrix'7cBmatrix'7cvmatrix'7cVmatrix'29 = compileRegex "(equation|displaymath|eqnarray|subeqnarray|math|multline|gather|align|flalign|IEEEeqnarray|IEEEeqnarraybox|smallmatrix|pmatrix|bmatrix|Bmatrix|vmatrix|Vmatrix)"
regex_'28tabularx'7ctabular'7csupertabular'7cmpsupertabular'7cxtabular'7cmpxtabular'7clongtable'29 = compileRegex "(tabularx|tabular|supertabular|mpsupertabular|xtabular|mpxtabular|longtable)"
regex_'5b'5ea'2dzA'2dZ'5cxd7'5d = compileRegex "[^a-zA-Z\\xd7]"
regex_'5ba'2dzA'2dZ'5d'2b = compileRegex "[a-zA-Z]+"
regex_'5c'5cend'28'3f'3d'5cs'2a'5c'7b'28verbatim'7clstlisting'7cboxedverbatim'7c'28B'7cL'29'3fVerbatim'29'5c'2a'3f'5c'7d'29 = compileRegex "\\\\end(?=\\s*\\{(verbatim|lstlisting|boxedverbatim|(B|L)?Verbatim)\\*?\\})"
regex_'5cs'2a'5c'7b = compileRegex "\\s*\\{"
regex_'28verbatim'7clstlisting'7cboxedverbatim'7c'28B'7cL'29'3fVerbatim'29'5c'2a'3f = compileRegex "(verbatim|lstlisting|boxedverbatim|(B|L)?Verbatim)\\*?"
regex_'5c'5cend'28'3f'3d'5cs'2a'5c'7bcomment'5c'2a'3f'5c'7d'29 = compileRegex "\\\\end(?=\\s*\\{comment\\*?\\})"
regex_comment'5c'2a'3f = compileRegex "comment\\*?"
regex_'5c'7d'5c'7b'5b'5e'5c'7d'5d'2a'5c'7d = compileRegex "\\}\\{[^\\}]*\\}"
regex_'5c'2a'28'3f'3d'5c'7d'29 = compileRegex "\\*(?=\\})"
regex_'5c'2a'5b'5e'5c'7d'5d'2a = compileRegex "\\*[^\\}]*"
regex_'5b'5ea'2dzA'2dZ'5cxd7'5d'5b'5e'5c'7d'5d'2a = compileRegex "[^a-zA-Z\\xd7][^\\}]*"
regex_'5c'5c'28text'7cintertext'7cmbox'29'5cs'2a'28'3f'3d'5c'7b'29 = compileRegex "\\\\(text|intertext|mbox)\\s*(?=\\{)"
regex_'28equation'7cdisplaymath'7ceqnarray'7csubeqnarray'7cmath'7cmultline'7cgather'7calign'7cflalign'7calignat'7cxalignat'7cxxalignat'7cIEEEeqnarray'7cIEEEeqnarraybox'7csmallmatrix'7cpmatrix'7cbmatrix'7cBmatrix'7cvmatrix'7cVmatrix'29'5c'2a'3f = compileRegex "(equation|displaymath|eqnarray|subeqnarray|math|multline|gather|align|flalign|alignat|xalignat|xxalignat|IEEEeqnarray|IEEEeqnarraybox|smallmatrix|pmatrix|bmatrix|Bmatrix|vmatrix|Vmatrix)\\*?"
regex_'5c'5cend'28'3f'3d'5cs'2a'5c'7b'28tabularx'7ctabular'7csupertabular'7cmpsupertabular'7cxtabular'7cmpxtabular'7clongtable'29'5c'2a'3f'5c'7d'29 = compileRegex "\\\\end(?=\\s*\\{(tabularx|tabular|supertabular|mpsupertabular|xtabular|mpxtabular|longtable)\\*?\\})"
regex_'2e = compileRegex "."
regex_'28tabularx'7ctabular'7csupertabular'7cmpsupertabular'7cxtabular'7cmpxtabular'7clongtable'29'5c'2a'3f = compileRegex "(tabularx|tabular|supertabular|mpsupertabular|xtabular|mpxtabular|longtable)\\*?"
regex_'5c'5c'28begin'7cend'29'5cs'2a'5c'7b'28equation'7cdisplaymath'7ceqnarray'7csubeqnarray'7cmath'7cmultline'7cgather'7calign'7cflalign'7calignat'7cxalignat'7cxxalignat'7cIEEEeqnarray'29'5c'2a'3f'5c'7d = compileRegex "\\\\(begin|end)\\s*\\{(equation|displaymath|eqnarray|subeqnarray|math|multline|gather|align|flalign|alignat|xalignat|xxalignat|IEEEeqnarray)\\*?\\}"
regex_'5c'24'2e'2a'5c'24 = compileRegex "\\$.*\\$"
regex_'28FIXME'7cTODO'29'3a'3f = compileRegex "(FIXME|TODO):?"

defaultAttributes = [("Normal Text","Normal Text"),("NoWeb","Normal Text"),("Sectioning","Normal Text"),("SectioningInside","Structure Text"),("SectioningContrSeq","Keyword"),("SectioningMathMode","Structure Math"),("SectioningMathContrSeq","Structure Keyword Mathmode"),("Footnoting","Normal Text"),("FootnotingInside","Normal Text"),("FootnotingMathMode","Math"),("NewCommand","Normal Text"),("DefCommand","Normal Text"),("CommandParameterStart","Normal Text"),("CommandParameter","Normal Text"),("ContrSeq","Keyword"),("ToEndOfLine","Normal Text"),("Verb","Verbatim"),("VerbEnd","Verbatim"),("Label","Normal Text"),("LabelOption","Normal Text"),("LabelParameter","Environment"),("FancyLabel","Normal Text"),("FancyLabelParameter","Environment"),("FancyLabelRoundBrackets","Normal Text"),("FindEndEnvironment","Normal Text"),("EndEnvironment","Environment"),("EndLatexEnv","Environment"),("FindBeginEnvironment","Normal Text"),("BeginEnvironment","Environment"),("LatexEnv","Environment"),("VerbatimEnv","Environment"),("VerbatimEnvParam","Normal Text"),("Verbatim","Verbatim"),("VerbFindEnd","Normal Text"),("CommentEnv","Environment"),("BlockComment","Comment"),("CommFindEnd","Normal Text"),("MathEnv","Environment"),("MathEnvParam","Normal Text"),("EnvCommon","Environment"),("MathModeEnv","Math"),("MathFindEnd","Normal Text"),("TabEnv","Environment"),("Tab","Tab"),("Column Separator","Column Separator"),("TabFindEnd","Normal Text"),("MathMode","Math"),("MathModeDisplay","Math"),("MathModeEquation","Math"),("MathModeEnsure","Math"),("MathModeCommon","Math"),("MathContrSeq","Keyword Mathmode"),("MathModeText","Normal Text"),("MathModeTextParameterStart","Normal Text"),("MathModeTextParameter","Normal Text"),("Multiline Comment","Comment"),("Comment","Comment")]

parseRules "Normal Text" = 
  do (attr, result) <- (((pRegExpr regex_'5c'5cbegin'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute "Structure") >>~ pushContext "FindBeginEnvironment")
                        <|>
                        ((pRegExpr regex_'5c'5cend'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute "Structure") >>~ pushContext "FindEndEnvironment")
                        <|>
                        ((pRegExpr regex_'5c'5c'28cite'7cparencite'7cautocite'7cAutocite'7ccitetitle'29'5c'2a'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute "Structure") >>~ pushContext "Label")
                        <|>
                        ((pRegExpr regex_'5c'5c'28cites'7cCites'7cparencites'7cParencites'7cautocites'7cAutocites'7csupercites'7cfootcites'7cFootcites'29'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute "Structure") >>~ pushContext "FancyLabel")
                        <|>
                        ((pRegExpr regex_'5c'5c'28cite'7cnocite'7cCite'7cparencite'7cParencite'7cfootcite'7cFootcite'7ctextcite'7cTextcite'7csupercite'7cautocite'7cAutocite'7cciteauthor'7cCiteauthor'7ccitetitle'7cciteyear'7cciteurl'7cnocite'7cfullcite'7cfootfullcite'29'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute "Structure") >>~ pushContext "Label")
                        <|>
                        ((pRegExpr regex_'5c'5c'28subref'5c'2a'3f'7ccref'5c'2a'3f'7clabel'7cpageref'7cautoref'7cref'7cvpageref'7cvref'7cpagecite'7ceqref'29'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute "Structure") >>~ pushContext "Label")
                        <|>
                        ((pRegExpr regex_'5c'5c'28part'7cchapter'7csection'7csubsection'7csubsubsection'7cparagraph'7csubparagraph'29'5c'2a'3f'5cs'2a'28'3f'3d'5b'5c'7b'5c'5b'5d'29 >>= withAttribute "Structure") >>~ pushContext "Sectioning")
                        <|>
                        ((pRegExpr regex_'5c'5c'28footnote'29'5c'2a'3f'5cs'2a'28'3f'3d'5b'5c'7b'5c'5b'5d'29 >>= withAttribute "Keyword") >>~ pushContext "Footnoting")
                        <|>
                        ((pRegExpr regex_'5c'5c'28renewcommand'7cprovidenewcommand'7cnewcommand'29'5c'2a'3f'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute "Keyword") >>~ pushContext "NewCommand")
                        <|>
                        ((pRegExpr regex_'5c'5c'28e'7cg'7cx'29'3fdef'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute "Keyword") >>~ pushContext "DefCommand")
                        <|>
                        ((pRegExpr regex_'3c'3c'2e'2a'3e'3e'3d >>= withAttribute "Normal Text") >>~ pushContext "NoWeb")
                        <|>
                        ((pString False "\\(" >>= withAttribute "Math") >>~ pushContext "MathMode")
                        <|>
                        ((pString False "\\[" >>= withAttribute "Math") >>~ pushContext "MathModeEquation")
                        <|>
                        ((pString False "\\iffalse" >>= withAttribute "Comment") >>~ pushContext "Multiline Comment")
                        <|>
                        ((pString False "\\ensuremath{" >>= withAttribute "Math") >>~ pushContext "MathModeEnsure")
                        <|>
                        ((pDetectChar False '\\' >>= withAttribute "Keyword") >>~ pushContext "ContrSeq")
                        <|>
                        ((pString False "$$" >>= withAttribute "Math") >>~ pushContext "MathModeDisplay")
                        <|>
                        ((pDetectChar False '$' >>= withAttribute "Math") >>~ pushContext "MathMode")
                        <|>
                        ((pFirstNonSpace >> pRegExpr regex_'25'5cs'2aBEGIN'2e'2a'24 >>= withAttribute "Region Marker"))
                        <|>
                        ((pFirstNonSpace >> pRegExpr regex_'25'5cs'2aEND'2e'2a'24 >>= withAttribute "Region Marker"))
                        <|>
                        ((pDetectChar False '%' >>= withAttribute "Comment") >>~ pushContext "Comment")
                        <|>
                        ((pDetectChar False '\215' >>= withAttribute "Bullet")))
     return (attr, result)

parseRules "NoWeb" = 
  do (attr, result) <- ((pColumn 0 >> pRegExpr regex_'5cs'2a'40'5cs'2a >>= withAttribute "Normal Text") >>~ (popContext))
     return (attr, result)

parseRules "Sectioning" = 
  do (attr, result) <- (((pRegExpr regex_'5c'5b'5b'5e'5c'5d'5d'2a'5c'5d >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False ' ' >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '{' >>= withAttribute "Normal Text") >>~ pushContext "SectioningInside")
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ (popContext))
                        <|>
                        ((pDetectChar False '%' >>= withAttribute "Comment") >>~ pushContext "Comment")
                        <|>
                        ((popContext) >> return ([], "")))
     return (attr, result)

parseRules "SectioningInside" = 
  do (attr, result) <- (((pDetectChar False '{' >>= withAttribute "Normal Text") >>~ pushContext "SectioningInside")
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ (popContext))
                        <|>
                        ((pString False "\\(" >>= withAttribute "Structure Math") >>~ pushContext "SectioningMathMode")
                        <|>
                        ((pDetectChar False '\\' >>= withAttribute "Structure Keyword") >>~ pushContext "SectioningContrSeq")
                        <|>
                        ((pDetectChar False '$' >>= withAttribute "Structure Math") >>~ pushContext "SectioningMathMode")
                        <|>
                        ((pDetectChar False '%' >>= withAttribute "Comment") >>~ pushContext "Comment")
                        <|>
                        ((pDetectChar False '\215' >>= withAttribute "Bullet")))
     return (attr, result)

parseRules "SectioningContrSeq" = 
  do (attr, result) <- (((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pRegExpr regex_'5ba'2dzA'2dZ'5d'2b'28'5c'2b'3f'7c'5c'2a'7b0'2c3'7d'29 >>= withAttribute "Structure Keyword") >>~ (popContext))
                        <|>
                        ((pRegExpr regex_'5b'5ea'2dzA'2dZ'5d >>= withAttribute "Structure Keyword") >>~ (popContext)))
     return (attr, result)

parseRules "SectioningMathMode" = 
  do (attr, result) <- (((pString False "$$" >>= withAttribute "Error"))
                        <|>
                        ((pDetectChar False '$' >>= withAttribute "Structure Math") >>~ (popContext))
                        <|>
                        ((pDetect2Chars False '\\' ')' >>= withAttribute "Structure Math") >>~ (popContext))
                        <|>
                        ((pDetect2Chars False '\\' ']' >>= withAttribute "Error"))
                        <|>
                        ((pDetectChar False '\\' >>= withAttribute "Structure Keyword Mathmode") >>~ pushContext "SectioningMathContrSeq")
                        <|>
                        ((pDetectChar False '%' >>= withAttribute "Comment") >>~ pushContext "Comment")
                        <|>
                        ((pDetectChar False '\215' >>= withAttribute "Bullet")))
     return (attr, result)

parseRules "SectioningMathContrSeq" = 
  do (attr, result) <- (((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pRegExpr regex_'5ba'2dzA'2dZ'5d'2b'5c'2a'3f >>= withAttribute "Structure Keyword Mathmode") >>~ (popContext))
                        <|>
                        ((pRegExpr regex_'5b'5ea'2dzA'2dZ'5d >>= withAttribute "Structure Keyword Mathmode") >>~ (popContext)))
     return (attr, result)

parseRules "Footnoting" = 
  do (attr, result) <- (((pRegExpr regex_'5c'5b'5b'5e'5c'5d'5d'2a'5c'5d >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False ' ' >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '{' >>= withAttribute "Normal Text") >>~ pushContext "FootnotingInside")
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ (popContext))
                        <|>
                        ((pDetectChar False '%' >>= withAttribute "Comment") >>~ pushContext "Comment")
                        <|>
                        ((popContext) >> return ([], "")))
     return (attr, result)

parseRules "FootnotingInside" = 
  do (attr, result) <- (((pDetectChar False '{' >>= withAttribute "Normal Text") >>~ pushContext "FootnotingInside")
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ (popContext))
                        <|>
                        ((pString False "\\(" >>= withAttribute "Math") >>~ pushContext "FootnotingMathMode")
                        <|>
                        ((pDetectChar False '$' >>= withAttribute "Math") >>~ pushContext "FootnotingMathMode")
                        <|>
                        ((parseRules "Normal Text")))
     return (attr, result)

parseRules "FootnotingMathMode" = 
  do (attr, result) <- (((pString False "$$" >>= withAttribute "Error"))
                        <|>
                        ((pDetectChar False '$' >>= withAttribute "Math") >>~ (popContext))
                        <|>
                        ((pDetect2Chars False '\\' ')' >>= withAttribute "Math") >>~ (popContext))
                        <|>
                        ((pDetect2Chars False '\\' ']' >>= withAttribute "Error"))
                        <|>
                        ((parseRules "MathMode")))
     return (attr, result)

parseRules "NewCommand" = 
  do (attr, result) <- (((pRegExpr regex_'5cs'2a'5c'7b'5cs'2a'5c'5c'5ba'2dzA'2dZ'5d'2b'5cs'2a'5c'7d'28'5c'5b'5cd'5c'5d'28'5c'5b'5b'5e'5c'5d'5d'2a'5c'5d'29'3f'29'3f'5c'7b >>= withAttribute "Normal Text") >>~ pushContext "CommandParameterStart")
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Error") >>~ (popContext))
                        <|>
                        ((popContext) >> return ([], "")))
     return (attr, result)

parseRules "DefCommand" = 
  do (attr, result) <- (((pRegExpr regex_'5cs'2a'5c'5c'5ba'2dzA'2dZ'5d'2b'5b'5e'5c'7b'5d'2a'5c'7b >>= withAttribute "Normal Text") >>~ pushContext "CommandParameterStart")
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Error") >>~ (popContext))
                        <|>
                        ((popContext) >> return ([], "")))
     return (attr, result)

parseRules "CommandParameterStart" = 
  do (attr, result) <- (((pDetectChar False '{' >>= withAttribute "Normal Text") >>~ pushContext "CommandParameter")
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ (popContext >> popContext))
                        <|>
                        ((pRegExpr regex_'5c'5c'2e >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '%' >>= withAttribute "Comment") >>~ pushContext "Comment"))
     return (attr, result)

parseRules "CommandParameter" = 
  do (attr, result) <- (((pDetectChar False '{' >>= withAttribute "Normal Text") >>~ pushContext "CommandParameter")
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ (popContext))
                        <|>
                        ((pRegExpr regex_'5c'5c'2e >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '%' >>= withAttribute "Comment") >>~ pushContext "Comment"))
     return (attr, result)

parseRules "ContrSeq" = 
  do (attr, result) <- (((pString False "verb*" >>= withAttribute "Keyword") >>~ pushContext "Verb")
                        <|>
                        ((pRegExpr regex_'28Verb'7cverb'7clstinline'29'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute "Keyword") >>~ pushContext "Verb")
                        <|>
                        ((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pRegExpr regex_'5ba'2dzA'2dZ'40'5d'2b'28'5c'2b'3f'7c'5c'2a'7b0'2c3'7d'29 >>= withAttribute "Keyword") >>~ (popContext))
                        <|>
                        ((pRegExpr regex_'5b'5ea'2dzA'2dZ'5d >>= withAttribute "Keyword") >>~ (popContext)))
     return (attr, result)

parseRules "ToEndOfLine" = 
  pzero

parseRules "Verb" = 
  do (attr, result) <- ((pRegExprDynamic "(.)" >>= withAttribute "Normal Text") >>~ pushContext "VerbEnd")
     return (attr, result)

parseRules "VerbEnd" = 
  do (attr, result) <- (((pString True "%1" >>= withAttribute "Normal Text") >>~ (popContext >> popContext >> popContext))
                        <|>
                        ((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pRegExprDynamic "[^%1\\xd7]*" >>= withAttribute "Verbatim")))
     return (attr, result)

parseRules "Label" = 
  do (attr, result) <- (((pRegExpr regex_'5cs'2a'5c'7b'5cs'2a >>= withAttribute "Normal Text") >>~ pushContext "LabelParameter")
                        <|>
                        ((pRegExpr regex_'5cs'2a'5c'5b'5cs'2a >>= withAttribute "Normal Text") >>~ pushContext "LabelOption")
                        <|>
                        ((pRegExpr regex_'5b'5e'5c'5b'5c'7b'5d'2b >>= withAttribute "Error")))
     return (attr, result)

parseRules "LabelOption" = 
  do (attr, result) <- (((pString False "\\(" >>= withAttribute "Math") >>~ pushContext "MathMode")
                        <|>
                        ((pDetectChar False '\\' >>= withAttribute "Keyword") >>~ pushContext "ContrSeq")
                        <|>
                        ((pDetectChar False '$' >>= withAttribute "Math") >>~ pushContext "MathMode")
                        <|>
                        ((pDetectChar False '%' >>= withAttribute "Comment") >>~ pushContext "Comment")
                        <|>
                        ((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pRegExpr regex_'5cs'2a'5c'5d'5cs'2a >>= withAttribute "Normal Text") >>~ (popContext)))
     return (attr, result)

parseRules "LabelParameter" = 
  do (attr, result) <- (((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pRegExpr regex_'5cs'2a'5c'7d'5cs'2a >>= withAttribute "Normal Text") >>~ (popContext >> popContext)))
     return (attr, result)

parseRules "FancyLabel" = 
  do (attr, result) <- (((pRegExpr regex_'5cs'2a'5c'7b'5cs'2a >>= withAttribute "Normal Text") >>~ pushContext "FancyLabelParameter")
                        <|>
                        ((pRegExpr regex_'5cs'2a'5c'5b'5cs'2a >>= withAttribute "Normal Text") >>~ pushContext "LabelOption")
                        <|>
                        ((pRegExpr regex_'5cs'2a'5c'28'5cs'2a >>= withAttribute "Normal Text") >>~ pushContext "FancyLabelRoundBrackets")
                        <|>
                        ((popContext) >> return ([], "")))
     return (attr, result)

parseRules "FancyLabelParameter" = 
  do (attr, result) <- (((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pRegExpr regex_'5cs'2a'5c'7d'5cs'2a >>= withAttribute "Normal Text") >>~ (popContext)))
     return (attr, result)

parseRules "FancyLabelRoundBrackets" = 
  do (attr, result) <- (((pString False "\\(" >>= withAttribute "Math") >>~ pushContext "MathMode")
                        <|>
                        ((pDetectChar False '\\' >>= withAttribute "Keyword") >>~ pushContext "ContrSeq")
                        <|>
                        ((pDetectChar False '$' >>= withAttribute "Math") >>~ pushContext "MathMode")
                        <|>
                        ((pDetectChar False '%' >>= withAttribute "Comment") >>~ pushContext "Comment")
                        <|>
                        ((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pRegExpr regex_'5cs'2a'5c'29'5cs'2a >>= withAttribute "Normal Text") >>~ (popContext)))
     return (attr, result)

parseRules "FindEndEnvironment" = 
  do (attr, result) <- (((pDetectChar False '{' >>= withAttribute "Normal Text") >>~ pushContext "EndEnvironment")
                        <|>
                        ((pRegExpr regex_'5cS >>= withAttribute "Normal Text") >>~ (popContext)))
     return (attr, result)

parseRules "EndEnvironment" = 
  do (attr, result) <- (((pRegExpr regex_'5ba'2dzA'2dZ'5d >>= withAttribute "Environment") >>~ pushContext "EndLatexEnv")
                        <|>
                        ((pRegExpr regex_'5cs'2b >>= withAttribute "Error") >>~ (popContext))
                        <|>
                        ((pRegExpr regex_'5b'5ea'2dzA'2dZ'5d >>= withAttribute "Error") >>~ (popContext)))
     return (attr, result)

parseRules "EndLatexEnv" = 
  do (attr, result) <- (((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ (popContext >> popContext >> popContext))
                        <|>
                        ((pRegExpr regex_'5ba'2dzA'2dZ'5d'2b'28'5c'2a'29'3f >>= withAttribute "Environment"))
                        <|>
                        ((pRegExpr regex_'5cs'2b >>= withAttribute "Error"))
                        <|>
                        ((pRegExpr regex_'5ba'2dzA'2dZ'5d >>= withAttribute "Error") >>~ (popContext >> popContext >> popContext)))
     return (attr, result)

parseRules "FindBeginEnvironment" = 
  do (attr, result) <- (((pDetectChar False '{' >>= withAttribute "Normal Text") >>~ pushContext "BeginEnvironment")
                        <|>
                        ((pRegExpr regex_'5cS >>= withAttribute "Normal Text") >>~ (popContext)))
     return (attr, result)

parseRules "BeginEnvironment" = 
  do (attr, result) <- (((pRegExpr regex_'28lstlisting'7c'28B'7cL'29'3fVerbatim'29 >>= withAttribute "Environment") >>~ pushContext "VerbatimEnvParam")
                        <|>
                        ((pRegExpr regex_'28verbatim'7cboxedverbatim'29 >>= withAttribute "Environment") >>~ pushContext "VerbatimEnv")
                        <|>
                        ((pRegExpr regex_comment >>= withAttribute "Environment") >>~ pushContext "CommentEnv")
                        <|>
                        ((pRegExpr regex_'28alignat'7cxalignat'7cxxalignat'29 >>= withAttribute "Environment") >>~ pushContext "MathEnvParam")
                        <|>
                        ((pRegExpr regex_'28equation'7cdisplaymath'7ceqnarray'7csubeqnarray'7cmath'7cmultline'7cgather'7calign'7cflalign'7cIEEEeqnarray'7cIEEEeqnarraybox'7csmallmatrix'7cpmatrix'7cbmatrix'7cBmatrix'7cvmatrix'7cVmatrix'29 >>= withAttribute "Environment") >>~ pushContext "MathEnv")
                        <|>
                        ((pRegExpr regex_'28tabularx'7ctabular'7csupertabular'7cmpsupertabular'7cxtabular'7cmpxtabular'7clongtable'29 >>= withAttribute "Environment") >>~ pushContext "TabEnv")
                        <|>
                        ((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pRegExpr regex_'5ba'2dzA'2dZ'5d >>= withAttribute "Environment") >>~ pushContext "LatexEnv")
                        <|>
                        ((pRegExpr regex_'5cs'2b >>= withAttribute "Error") >>~ (popContext))
                        <|>
                        ((pRegExpr regex_'5b'5ea'2dzA'2dZ'5cxd7'5d >>= withAttribute "Error") >>~ (popContext)))
     return (attr, result)

parseRules "LatexEnv" = 
  do (attr, result) <- (((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ (popContext >> popContext >> popContext))
                        <|>
                        ((pRegExpr regex_'5ba'2dzA'2dZ'5d'2b >>= withAttribute "Environment"))
                        <|>
                        ((pRegExpr regex_'5cs'2b >>= withAttribute "Error"))
                        <|>
                        ((parseRules "EnvCommon")))
     return (attr, result)

parseRules "VerbatimEnv" = 
  do (attr, result) <- (((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ pushContext "Verbatim")
                        <|>
                        ((lookAhead (pRegExpr regex_'5ba'2dzA'2dZ'5d) >> return ([],"") ) >>~ (popContext))
                        <|>
                        ((parseRules "EnvCommon"))
                        <|>
                        ((popContext >> popContext >> popContext) >> return ([], "")))
     return (attr, result)

parseRules "VerbatimEnvParam" = 
  do (attr, result) <- (((pDetect2Chars False '}' '[' >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ pushContext "Verbatim")
                        <|>
                        ((pDetectChar False ']' >>= withAttribute "Normal Text") >>~ pushContext "Verbatim"))
     return (attr, result)

parseRules "Verbatim" = 
  do (attr, result) <- (((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pRegExpr regex_'5c'5cend'28'3f'3d'5cs'2a'5c'7b'28verbatim'7clstlisting'7cboxedverbatim'7c'28B'7cL'29'3fVerbatim'29'5c'2a'3f'5c'7d'29 >>= withAttribute "Structure") >>~ pushContext "VerbFindEnd"))
     return (attr, result)

parseRules "VerbFindEnd" = 
  do (attr, result) <- (((pRegExpr regex_'5cs'2a'5c'7b >>= withAttribute "Normal Text"))
                        <|>
                        ((pRegExpr regex_'28verbatim'7clstlisting'7cboxedverbatim'7c'28B'7cL'29'3fVerbatim'29'5c'2a'3f >>= withAttribute "Environment"))
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ (popContext >> popContext >> popContext >> popContext >> popContext))
                        <|>
                        ((popContext) >> return ([], "")))
     return (attr, result)

parseRules "CommentEnv" = 
  do (attr, result) <- (((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ pushContext "BlockComment")
                        <|>
                        ((lookAhead (pRegExpr regex_'5ba'2dzA'2dZ'5d) >> return ([],"") ) >>~ (popContext))
                        <|>
                        ((parseRules "EnvCommon"))
                        <|>
                        ((popContext >> popContext >> popContext) >> return ([], "")))
     return (attr, result)

parseRules "BlockComment" = 
  do (attr, result) <- (((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pRegExpr regex_'5c'5cend'28'3f'3d'5cs'2a'5c'7bcomment'5c'2a'3f'5c'7d'29 >>= withAttribute "Structure") >>~ pushContext "CommFindEnd"))
     return (attr, result)

parseRules "CommFindEnd" = 
  do (attr, result) <- (((pRegExpr regex_'5cs'2a'5c'7b >>= withAttribute "Normal Text"))
                        <|>
                        ((pRegExpr regex_comment'5c'2a'3f >>= withAttribute "Environment"))
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ (popContext >> popContext >> popContext >> popContext >> popContext))
                        <|>
                        ((popContext) >> return ([], "")))
     return (attr, result)

parseRules "MathEnv" = 
  do (attr, result) <- (((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ pushContext "MathModeEnv")
                        <|>
                        ((lookAhead (pRegExpr regex_'5ba'2dzA'2dZ'5d) >> return ([],"") ) >>~ (popContext))
                        <|>
                        ((parseRules "EnvCommon")))
     return (attr, result)

parseRules "MathEnvParam" = 
  do (attr, result) <- (((pRegExpr regex_'5c'7d'5c'7b'5b'5e'5c'7d'5d'2a'5c'7d >>= withAttribute "Normal Text") >>~ pushContext "MathModeEnv")
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ pushContext "MathModeEnv")
                        <|>
                        ((lookAhead (pRegExpr regex_'5ba'2dzA'2dZ'5d) >> return ([],"") ) >>~ (popContext))
                        <|>
                        ((parseRules "EnvCommon")))
     return (attr, result)

parseRules "EnvCommon" = 
  do (attr, result) <- (((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pRegExpr regex_'5c'2a'28'3f'3d'5c'7d'29 >>= withAttribute "Environment"))
                        <|>
                        ((pRegExpr regex_'5c'2a'5b'5e'5c'7d'5d'2a >>= withAttribute "Error") >>~ (popContext >> popContext >> popContext))
                        <|>
                        ((pRegExpr regex_'5b'5ea'2dzA'2dZ'5cxd7'5d'5b'5e'5c'7d'5d'2a >>= withAttribute "Error") >>~ (popContext >> popContext >> popContext)))
     return (attr, result)

parseRules "MathModeEnv" = 
  do (attr, result) <- (((pRegExpr regex_'5c'5cbegin'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute "Structure") >>~ pushContext "FindBeginEnvironment")
                        <|>
                        ((pRegExpr regex_'5c'5cend'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute "Structure") >>~ pushContext "MathFindEnd")
                        <|>
                        ((pString False "\\(" >>= withAttribute "Error"))
                        <|>
                        ((pString False "\\[" >>= withAttribute "Error"))
                        <|>
                        ((pString False "\\)" >>= withAttribute "Error"))
                        <|>
                        ((pString False "\\]" >>= withAttribute "Error"))
                        <|>
                        ((pRegExpr regex_'5c'5c'28text'7cintertext'7cmbox'29'5cs'2a'28'3f'3d'5c'7b'29 >>= withAttribute "Keyword Mathmode") >>~ pushContext "MathModeText")
                        <|>
                        ((pDetectChar False '\\' >>= withAttribute "Keyword Mathmode") >>~ pushContext "MathContrSeq")
                        <|>
                        ((pString False "$$" >>= withAttribute "Error"))
                        <|>
                        ((pDetectChar False '$' >>= withAttribute "Error"))
                        <|>
                        ((pDetectChar False '%' >>= withAttribute "Comment") >>~ pushContext "Comment")
                        <|>
                        ((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pFirstNonSpace >> pRegExpr regex_'25'5cs'2aBEGIN'2e'2a'24 >>= withAttribute "Region Marker"))
                        <|>
                        ((pFirstNonSpace >> pRegExpr regex_'25'5cs'2aEND'2e'2a'24 >>= withAttribute "Region Marker")))
     return (attr, result)

parseRules "MathFindEnd" = 
  do (attr, result) <- (((pRegExpr regex_'5cs'2a'5c'7b >>= withAttribute "Normal Text"))
                        <|>
                        ((pRegExpr regex_'28equation'7cdisplaymath'7ceqnarray'7csubeqnarray'7cmath'7cmultline'7cgather'7calign'7cflalign'7calignat'7cxalignat'7cxxalignat'7cIEEEeqnarray'7cIEEEeqnarraybox'7csmallmatrix'7cpmatrix'7cbmatrix'7cBmatrix'7cvmatrix'7cVmatrix'29'5c'2a'3f >>= withAttribute "Environment"))
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ (popContext >> popContext >> popContext >> popContext >> popContext))
                        <|>
                        ((popContext) >> return ([], "")))
     return (attr, result)

parseRules "TabEnv" = 
  do (attr, result) <- (((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ pushContext "Tab")
                        <|>
                        ((lookAhead (pRegExpr regex_'5ba'2dzA'2dZ'5d) >> return ([],"") ) >>~ (popContext))
                        <|>
                        ((parseRules "EnvCommon"))
                        <|>
                        ((popContext >> popContext >> popContext) >> return ([], "")))
     return (attr, result)

parseRules "Tab" = 
  do (attr, result) <- (((pDetectChar False '&' >>= withAttribute "Ampersand"))
                        <|>
                        ((pString False "@{" >>= withAttribute "Column Separator") >>~ pushContext "Column Separator")
                        <|>
                        ((pRegExpr regex_'5c'5cend'28'3f'3d'5cs'2a'5c'7b'28tabularx'7ctabular'7csupertabular'7cmpsupertabular'7cxtabular'7cmpxtabular'7clongtable'29'5c'2a'3f'5c'7d'29 >>= withAttribute "Structure") >>~ pushContext "TabFindEnd")
                        <|>
                        ((parseRules "Normal Text")))
     return (attr, result)

parseRules "Column Separator" = 
  do (attr, result) <- (((pDetectChar False '{' >>= withAttribute "Column Separator") >>~ pushContext "Column Separator")
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Column Separator") >>~ (popContext))
                        <|>
                        ((pRegExpr regex_'2e >>= withAttribute "Column Separator")))
     return (attr, result)

parseRules "TabFindEnd" = 
  do (attr, result) <- (((pRegExpr regex_'5cs'2a'5c'7b >>= withAttribute "Normal Text"))
                        <|>
                        ((pRegExpr regex_'28tabularx'7ctabular'7csupertabular'7cmpsupertabular'7cxtabular'7cmpxtabular'7clongtable'29'5c'2a'3f >>= withAttribute "Environment"))
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ (popContext >> popContext >> popContext >> popContext >> popContext))
                        <|>
                        ((popContext) >> return ([], "")))
     return (attr, result)

parseRules "MathMode" = 
  do (attr, result) <- (((pString False "$$" >>= withAttribute "Error"))
                        <|>
                        ((pDetectChar False '$' >>= withAttribute "Math") >>~ (popContext))
                        <|>
                        ((pDetect2Chars False '\\' ')' >>= withAttribute "Math") >>~ (popContext))
                        <|>
                        ((pDetect2Chars False '\\' ']' >>= withAttribute "Error"))
                        <|>
                        ((parseRules "MathModeCommon")))
     return (attr, result)

parseRules "MathModeDisplay" = 
  do (attr, result) <- (((pString False "$$" >>= withAttribute "Math") >>~ (popContext))
                        <|>
                        ((pDetectChar False '$' >>= withAttribute "Error"))
                        <|>
                        ((pDetect2Chars False '\\' ']' >>= withAttribute "Error"))
                        <|>
                        ((pDetect2Chars False '\\' ')' >>= withAttribute "Error"))
                        <|>
                        ((parseRules "MathModeCommon")))
     return (attr, result)

parseRules "MathModeEquation" = 
  do (attr, result) <- (((pDetect2Chars False '\\' ']' >>= withAttribute "Math") >>~ (popContext))
                        <|>
                        ((pString False "$$" >>= withAttribute "Error"))
                        <|>
                        ((pDetectChar False '$' >>= withAttribute "Error"))
                        <|>
                        ((pDetect2Chars False '\\' ')' >>= withAttribute "Error"))
                        <|>
                        ((parseRules "MathModeCommon")))
     return (attr, result)

parseRules "MathModeEnsure" = 
  do (attr, result) <- (((pDetectChar False '{' >>= withAttribute "Math") >>~ pushContext "MathModeEnsure")
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Math") >>~ (popContext))
                        <|>
                        ((parseRules "MathModeCommon")))
     return (attr, result)

parseRules "MathModeCommon" = 
  do (attr, result) <- (((pRegExpr regex_'5c'5c'28begin'7cend'29'5cs'2a'5c'7b'28equation'7cdisplaymath'7ceqnarray'7csubeqnarray'7cmath'7cmultline'7cgather'7calign'7cflalign'7calignat'7cxalignat'7cxxalignat'7cIEEEeqnarray'29'5c'2a'3f'5c'7d >>= withAttribute "Error"))
                        <|>
                        ((pRegExpr regex_'5c'5cbegin'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute "Keyword Mathmode"))
                        <|>
                        ((pRegExpr regex_'5c'5cend'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute "Keyword Mathmode"))
                        <|>
                        ((pRegExpr regex_'5c'5c'28text'7cintertext'7cmbox'29'5cs'2a'28'3f'3d'5c'7b'29 >>= withAttribute "Keyword Mathmode") >>~ pushContext "MathModeText")
                        <|>
                        ((pDetectChar False '\\' >>= withAttribute "Keyword Mathmode") >>~ pushContext "MathContrSeq")
                        <|>
                        ((pDetectChar False '%' >>= withAttribute "Comment") >>~ pushContext "Comment")
                        <|>
                        ((pFirstNonSpace >> pRegExpr regex_'25'5cs'2aBEGIN'2e'2a'24 >>= withAttribute "Region Marker"))
                        <|>
                        ((pFirstNonSpace >> pRegExpr regex_'25'5cs'2aEND'2e'2a'24 >>= withAttribute "Region Marker"))
                        <|>
                        ((pDetectChar False '\215' >>= withAttribute "Bullet")))
     return (attr, result)

parseRules "MathContrSeq" = 
  do (attr, result) <- (((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pRegExpr regex_'5ba'2dzA'2dZ'5d'2b'5c'2a'3f >>= withAttribute "Keyword Mathmode") >>~ (popContext))
                        <|>
                        ((pRegExpr regex_'5b'5ea'2dzA'2dZ'5d >>= withAttribute "Keyword Mathmode") >>~ (popContext)))
     return (attr, result)

parseRules "MathModeText" = 
  do (attr, result) <- ((pDetectChar False '{' >>= withAttribute "Normal Text") >>~ pushContext "MathModeTextParameterStart")
     return (attr, result)

parseRules "MathModeTextParameterStart" = 
  do (attr, result) <- (((pRegExpr regex_'5c'5c'2e >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pRegExpr regex_'5c'24'2e'2a'5c'24 >>= withAttribute "Math"))
                        <|>
                        ((pDetectChar False '{' >>= withAttribute "Normal Text") >>~ pushContext "MathModeTextParameter")
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ (popContext >> popContext))
                        <|>
                        ((pDetectChar False '%' >>= withAttribute "Comment") >>~ pushContext "Comment"))
     return (attr, result)

parseRules "MathModeTextParameter" = 
  do (attr, result) <- (((pRegExpr regex_'5c'5c'2e >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '{' >>= withAttribute "Normal Text") >>~ pushContext "MathModeTextParameter")
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ (popContext))
                        <|>
                        ((pDetectChar False '\215' >>= withAttribute "Bullet"))
                        <|>
                        ((pDetectChar False '%' >>= withAttribute "Comment") >>~ pushContext "Comment"))
     return (attr, result)

parseRules "Multiline Comment" = 
  do (attr, result) <- (((pString False "\\fi" >>= withAttribute "Comment") >>~ (popContext))
                        <|>
                        ((pString False "\\else" >>= withAttribute "Comment") >>~ (popContext)))
     return (attr, result)

parseRules "Comment" = 
  do (attr, result) <- (((pRegExpr regex_'28FIXME'7cTODO'29'3a'3f >>= withAttribute "Alert"))
                        <|>
                        ((pString False "\\KileResetHL" >>= withAttribute "Comment") >>~ pushContext "Normal Text")
                        <|>
                        ((pString False "\\KateResetHL" >>= withAttribute "Comment") >>~ pushContext "Normal Text"))
     return (attr, result)

parseRules "" = parseRules "Normal Text"

parseRules x = fail $ "Unknown context" ++ x