module Text.Highlighting.Kate.Syntax.Latex
(highlight, parseExpression, syntaxName, syntaxExtensions)
where
import Text.Highlighting.Kate.Types
import Text.Highlighting.Kate.Common
import Text.ParserCombinators.Parsec hiding (State)
import Data.Map (fromList)
import Control.Monad.State
import Data.Char (isSpace)
import Data.Maybe (fromMaybe)
syntaxName :: String
syntaxName = "LaTeX"
syntaxExtensions :: String
syntaxExtensions = "*.tex;*.ltx;*.dtx;*.sty;*.cls;*.bbx;*.cbx;*.lbx;"
highlight :: String -> [SourceLine]
highlight input = evalState (mapM parseSourceLine $ lines input) startingState
parseSourceLine :: String -> State SyntaxState SourceLine
parseSourceLine = mkParseSourceLine parseExpressionInternal pEndLine
parseExpression :: KateParser Token
parseExpression = do
st <- getState
let oldLang = synStLanguage st
setState $ st { synStLanguage = "LaTeX" }
context <- currentContext <|> (pushContext "Normal Text" >> currentContext)
result <- parseRules context
optional $ eof >> pEndLine
updateState $ \st -> st { synStLanguage = oldLang }
return result
startingState = SyntaxState {synStContexts = fromList [("LaTeX",["Normal Text"])], synStLanguage = "LaTeX", synStLineNumber = 0, synStPrevChar = '\n', synStPrevNonspace = False, synStCaseSensitive = True, synStKeywordCaseSensitive = True, synStCaptures = []}
pEndLine = do
updateState $ \st -> st{ synStPrevNonspace = False }
context <- currentContext
case context of
"Normal Text" -> return ()
"NoWeb" -> return ()
"Sectioning" -> return ()
"SectioningInside" -> return ()
"SectioningContrSeq" -> (popContext) >> pEndLine
"SectioningMathMode" -> return ()
"SectioningMathContrSeq" -> (popContext) >> pEndLine
"Footnoting" -> return ()
"FootnotingInside" -> return ()
"FootnotingMathMode" -> return ()
"NewCommand" -> return ()
"DefCommand" -> return ()
"CommandParameterStart" -> return ()
"CommandParameter" -> return ()
"ContrSeq" -> (popContext) >> pEndLine
"ToEndOfLine" -> (popContext) >> pEndLine
"Verb" -> (popContext >> popContext) >> pEndLine
"VerbEnd" -> (popContext >> popContext >> popContext) >> pEndLine
"Label" -> return ()
"LabelOption" -> return ()
"LabelParameter" -> return ()
"FancyLabel" -> return ()
"FancyLabelParameter" -> return ()
"FancyLabelRoundBrackets" -> return ()
"FindEndEnvironment" -> return ()
"EndEnvironment" -> return ()
"EndLatexEnv" -> return ()
"FindBeginEnvironment" -> return ()
"BeginEnvironment" -> return ()
"LatexEnv" -> return ()
"VerbatimEnv" -> return ()
"VerbatimEnvParam" -> return ()
"Verbatim" -> return ()
"VerbFindEnd" -> (popContext) >> pEndLine
"CommentEnv" -> return ()
"BlockComment" -> return ()
"CommFindEnd" -> (popContext) >> pEndLine
"MathEnv" -> return ()
"MathEnvParam" -> return ()
"EnvCommon" -> return ()
"MathModeEnv" -> return ()
"MathFindEnd" -> (popContext) >> pEndLine
"TabEnv" -> return ()
"Tab" -> return ()
"Column Separator" -> return ()
"TabFindEnd" -> (popContext) >> pEndLine
"MathMode" -> return ()
"MathModeDisplay" -> return ()
"MathModeEquation" -> return ()
"MathModeEnsure" -> return ()
"MathModeCommon" -> return ()
"MathContrSeq" -> (popContext) >> pEndLine
"MathModeText" -> return ()
"MathModeTextParameterStart" -> return ()
"MathModeTextParameter" -> return ()
"Multiline Comment" -> return ()
"Comment" -> (popContext) >> pEndLine
_ -> return ()
withAttribute attr txt = do
when (null txt) $ fail "Parser matched no text"
updateState $ \st -> st { synStPrevChar = last txt
, synStPrevNonspace = synStPrevNonspace st || not (all isSpace txt) }
return (attr, txt)
parseExpressionInternal = do
context <- currentContext
parseRules context <|> (pDefault >>= withAttribute (fromMaybe NormalTok $ 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",NormalTok),("NoWeb",NormalTok),("Sectioning",NormalTok),("SectioningInside",NormalTok),("SectioningContrSeq",NormalTok),("SectioningMathMode",NormalTok),("SectioningMathContrSeq",NormalTok),("Footnoting",NormalTok),("FootnotingInside",NormalTok),("FootnotingMathMode",NormalTok),("NewCommand",NormalTok),("DefCommand",NormalTok),("CommandParameterStart",NormalTok),("CommandParameter",NormalTok),("ContrSeq",NormalTok),("ToEndOfLine",NormalTok),("Verb",NormalTok),("VerbEnd",NormalTok),("Label",NormalTok),("LabelOption",NormalTok),("LabelParameter",NormalTok),("FancyLabel",NormalTok),("FancyLabelParameter",NormalTok),("FancyLabelRoundBrackets",NormalTok),("FindEndEnvironment",NormalTok),("EndEnvironment",NormalTok),("EndLatexEnv",NormalTok),("FindBeginEnvironment",NormalTok),("BeginEnvironment",NormalTok),("LatexEnv",NormalTok),("VerbatimEnv",NormalTok),("VerbatimEnvParam",NormalTok),("Verbatim",NormalTok),("VerbFindEnd",NormalTok),("CommentEnv",NormalTok),("BlockComment",CommentTok),("CommFindEnd",NormalTok),("MathEnv",NormalTok),("MathEnvParam",NormalTok),("EnvCommon",NormalTok),("MathModeEnv",NormalTok),("MathFindEnd",NormalTok),("TabEnv",NormalTok),("Tab",NormalTok),("Column Separator",NormalTok),("TabFindEnd",NormalTok),("MathMode",NormalTok),("MathModeDisplay",NormalTok),("MathModeEquation",NormalTok),("MathModeEnsure",NormalTok),("MathModeCommon",NormalTok),("MathContrSeq",NormalTok),("MathModeText",NormalTok),("MathModeTextParameterStart",NormalTok),("MathModeTextParameter",NormalTok),("Multiline Comment",CommentTok),("Comment",CommentTok)]
parseRules "Normal Text" =
(((pRegExpr regex_'5c'5cbegin'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute NormalTok) >>~ pushContext "FindBeginEnvironment")
<|>
((pRegExpr regex_'5c'5cend'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute NormalTok) >>~ pushContext "FindEndEnvironment")
<|>
((pRegExpr regex_'5c'5c'28cite'7cparencite'7cautocite'7cAutocite'7ccitetitle'29'5c'2a'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute NormalTok) >>~ 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 NormalTok) >>~ 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 NormalTok) >>~ 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 NormalTok) >>~ 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 NormalTok) >>~ pushContext "Sectioning")
<|>
((pRegExpr regex_'5c'5c'28footnote'29'5c'2a'3f'5cs'2a'28'3f'3d'5b'5c'7b'5c'5b'5d'29 >>= withAttribute NormalTok) >>~ pushContext "Footnoting")
<|>
((pRegExpr regex_'5c'5c'28renewcommand'7cprovidenewcommand'7cnewcommand'29'5c'2a'3f'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute NormalTok) >>~ pushContext "NewCommand")
<|>
((pRegExpr regex_'5c'5c'28e'7cg'7cx'29'3fdef'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute NormalTok) >>~ pushContext "DefCommand")
<|>
((pRegExpr regex_'3c'3c'2e'2a'3e'3e'3d >>= withAttribute NormalTok) >>~ pushContext "NoWeb")
<|>
((pString False "\\(" >>= withAttribute NormalTok) >>~ pushContext "MathMode")
<|>
((pString False "\\[" >>= withAttribute NormalTok) >>~ pushContext "MathModeEquation")
<|>
((pString False "\\iffalse" >>= withAttribute CommentTok) >>~ pushContext "Multiline Comment")
<|>
((pString False "\\ensuremath{" >>= withAttribute NormalTok) >>~ pushContext "MathModeEnsure")
<|>
((pDetectChar False '\\' >>= withAttribute NormalTok) >>~ pushContext "ContrSeq")
<|>
((pString False "$$" >>= withAttribute NormalTok) >>~ pushContext "MathModeDisplay")
<|>
((pDetectChar False '$' >>= withAttribute NormalTok) >>~ pushContext "MathMode")
<|>
((pFirstNonSpace >> pRegExpr regex_'25'5cs'2aBEGIN'2e'2a'24 >>= withAttribute RegionMarkerTok))
<|>
((pFirstNonSpace >> pRegExpr regex_'25'5cs'2aEND'2e'2a'24 >>= withAttribute RegionMarkerTok))
<|>
((pDetectChar False '%' >>= withAttribute CommentTok) >>~ pushContext "Comment")
<|>
((pDetectChar False '\215' >>= withAttribute NormalTok)))
parseRules "NoWeb" =
((pColumn 0 >> pRegExpr regex_'5cs'2a'40'5cs'2a >>= withAttribute NormalTok) >>~ (popContext))
parseRules "Sectioning" =
(((pRegExpr regex_'5c'5b'5b'5e'5c'5d'5d'2a'5c'5d >>= withAttribute NormalTok))
<|>
((pDetectChar False ' ' >>= withAttribute NormalTok))
<|>
((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "SectioningInside")
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pDetectChar False '%' >>= withAttribute CommentTok) >>~ pushContext "Comment")
<|>
((popContext) >> currentContext >>= parseRules))
parseRules "SectioningInside" =
(((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "SectioningInside")
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pString False "\\(" >>= withAttribute NormalTok) >>~ pushContext "SectioningMathMode")
<|>
((pDetectChar False '\\' >>= withAttribute NormalTok) >>~ pushContext "SectioningContrSeq")
<|>
((pDetectChar False '$' >>= withAttribute NormalTok) >>~ pushContext "SectioningMathMode")
<|>
((pDetectChar False '%' >>= withAttribute CommentTok) >>~ pushContext "Comment")
<|>
((pDetectChar False '\215' >>= withAttribute NormalTok)))
parseRules "SectioningContrSeq" =
(((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5ba'2dzA'2dZ'5d'2b'28'5c'2b'3f'7c'5c'2a'7b0'2c3'7d'29 >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pRegExpr regex_'5b'5ea'2dzA'2dZ'5d >>= withAttribute NormalTok) >>~ (popContext)))
parseRules "SectioningMathMode" =
(((pString False "$$" >>= withAttribute AlertTok))
<|>
((pDetectChar False '$' >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pDetect2Chars False '\\' ')' >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pDetect2Chars False '\\' ']' >>= withAttribute AlertTok))
<|>
((pDetectChar False '\\' >>= withAttribute NormalTok) >>~ pushContext "SectioningMathContrSeq")
<|>
((pDetectChar False '%' >>= withAttribute CommentTok) >>~ pushContext "Comment")
<|>
((pDetectChar False '\215' >>= withAttribute NormalTok)))
parseRules "SectioningMathContrSeq" =
(((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5ba'2dzA'2dZ'5d'2b'5c'2a'3f >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pRegExpr regex_'5b'5ea'2dzA'2dZ'5d >>= withAttribute NormalTok) >>~ (popContext)))
parseRules "Footnoting" =
(((pRegExpr regex_'5c'5b'5b'5e'5c'5d'5d'2a'5c'5d >>= withAttribute NormalTok))
<|>
((pDetectChar False ' ' >>= withAttribute NormalTok))
<|>
((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "FootnotingInside")
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pDetectChar False '%' >>= withAttribute CommentTok) >>~ pushContext "Comment")
<|>
((popContext) >> currentContext >>= parseRules))
parseRules "FootnotingInside" =
(((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "FootnotingInside")
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pString False "\\(" >>= withAttribute NormalTok) >>~ pushContext "FootnotingMathMode")
<|>
((pDetectChar False '$' >>= withAttribute NormalTok) >>~ pushContext "FootnotingMathMode")
<|>
((parseRules "Normal Text")))
parseRules "FootnotingMathMode" =
(((pString False "$$" >>= withAttribute AlertTok))
<|>
((pDetectChar False '$' >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pDetect2Chars False '\\' ')' >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pDetect2Chars False '\\' ']' >>= withAttribute AlertTok))
<|>
((parseRules "MathMode")))
parseRules "NewCommand" =
(((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 NormalTok) >>~ pushContext "CommandParameterStart")
<|>
((pDetectChar False '}' >>= withAttribute AlertTok) >>~ (popContext))
<|>
((popContext) >> currentContext >>= parseRules))
parseRules "DefCommand" =
(((pRegExpr regex_'5cs'2a'5c'5c'5ba'2dzA'2dZ'5d'2b'5b'5e'5c'7b'5d'2a'5c'7b >>= withAttribute NormalTok) >>~ pushContext "CommandParameterStart")
<|>
((pDetectChar False '}' >>= withAttribute AlertTok) >>~ (popContext))
<|>
((popContext) >> currentContext >>= parseRules))
parseRules "CommandParameterStart" =
(((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "CommandParameter")
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext >> popContext))
<|>
((pRegExpr regex_'5c'5c'2e >>= withAttribute NormalTok))
<|>
((pDetectChar False '%' >>= withAttribute CommentTok) >>~ pushContext "Comment"))
parseRules "CommandParameter" =
(((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "CommandParameter")
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pRegExpr regex_'5c'5c'2e >>= withAttribute NormalTok))
<|>
((pDetectChar False '%' >>= withAttribute CommentTok) >>~ pushContext "Comment"))
parseRules "ContrSeq" =
(((pString False "verb*" >>= withAttribute NormalTok) >>~ pushContext "Verb")
<|>
((pRegExpr regex_'28Verb'7cverb'7clstinline'29'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute NormalTok) >>~ pushContext "Verb")
<|>
((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5ba'2dzA'2dZ'40'5d'2b'28'5c'2b'3f'7c'5c'2a'7b0'2c3'7d'29 >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pRegExpr regex_'5b'5ea'2dzA'2dZ'5d >>= withAttribute NormalTok) >>~ (popContext)))
parseRules "ToEndOfLine" =
pzero
parseRules "Verb" =
((pRegExprDynamic "(.)" >>= withAttribute NormalTok) >>~ pushContext "VerbEnd")
parseRules "VerbEnd" =
(((pString True "%1" >>= withAttribute NormalTok) >>~ (popContext >> popContext >> popContext))
<|>
((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((pRegExprDynamic "[^%1\\xd7]*" >>= withAttribute NormalTok)))
parseRules "Label" =
(((pRegExpr regex_'5cs'2a'5c'7b'5cs'2a >>= withAttribute NormalTok) >>~ pushContext "LabelParameter")
<|>
((pRegExpr regex_'5cs'2a'5c'5b'5cs'2a >>= withAttribute NormalTok) >>~ pushContext "LabelOption")
<|>
((pRegExpr regex_'5b'5e'5c'5b'5c'7b'5d'2b >>= withAttribute AlertTok)))
parseRules "LabelOption" =
(((pString False "\\(" >>= withAttribute NormalTok) >>~ pushContext "MathMode")
<|>
((pDetectChar False '\\' >>= withAttribute NormalTok) >>~ pushContext "ContrSeq")
<|>
((pDetectChar False '$' >>= withAttribute NormalTok) >>~ pushContext "MathMode")
<|>
((pDetectChar False '%' >>= withAttribute CommentTok) >>~ pushContext "Comment")
<|>
((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5cs'2a'5c'5d'5cs'2a >>= withAttribute NormalTok) >>~ (popContext)))
parseRules "LabelParameter" =
(((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5cs'2a'5c'7d'5cs'2a >>= withAttribute NormalTok) >>~ (popContext >> popContext)))
parseRules "FancyLabel" =
(((pRegExpr regex_'5cs'2a'5c'7b'5cs'2a >>= withAttribute NormalTok) >>~ pushContext "FancyLabelParameter")
<|>
((pRegExpr regex_'5cs'2a'5c'5b'5cs'2a >>= withAttribute NormalTok) >>~ pushContext "LabelOption")
<|>
((pRegExpr regex_'5cs'2a'5c'28'5cs'2a >>= withAttribute NormalTok) >>~ pushContext "FancyLabelRoundBrackets")
<|>
((popContext) >> currentContext >>= parseRules))
parseRules "FancyLabelParameter" =
(((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5cs'2a'5c'7d'5cs'2a >>= withAttribute NormalTok) >>~ (popContext)))
parseRules "FancyLabelRoundBrackets" =
(((pString False "\\(" >>= withAttribute NormalTok) >>~ pushContext "MathMode")
<|>
((pDetectChar False '\\' >>= withAttribute NormalTok) >>~ pushContext "ContrSeq")
<|>
((pDetectChar False '$' >>= withAttribute NormalTok) >>~ pushContext "MathMode")
<|>
((pDetectChar False '%' >>= withAttribute CommentTok) >>~ pushContext "Comment")
<|>
((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5cs'2a'5c'29'5cs'2a >>= withAttribute NormalTok) >>~ (popContext)))
parseRules "FindEndEnvironment" =
(((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "EndEnvironment")
<|>
((pRegExpr regex_'5cS >>= withAttribute NormalTok) >>~ (popContext)))
parseRules "EndEnvironment" =
(((pRegExpr regex_'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok) >>~ pushContext "EndLatexEnv")
<|>
((pRegExpr regex_'5cs'2b >>= withAttribute AlertTok) >>~ (popContext))
<|>
((pRegExpr regex_'5b'5ea'2dzA'2dZ'5d >>= withAttribute AlertTok) >>~ (popContext)))
parseRules "EndLatexEnv" =
(((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext >> popContext >> popContext))
<|>
((pRegExpr regex_'5ba'2dzA'2dZ'5d'2b'28'5c'2a'29'3f >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5cs'2b >>= withAttribute AlertTok))
<|>
((pRegExpr regex_'5ba'2dzA'2dZ'5d >>= withAttribute AlertTok) >>~ (popContext >> popContext >> popContext)))
parseRules "FindBeginEnvironment" =
(((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "BeginEnvironment")
<|>
((pRegExpr regex_'5cS >>= withAttribute NormalTok) >>~ (popContext)))
parseRules "BeginEnvironment" =
(((pRegExpr regex_'28lstlisting'7c'28B'7cL'29'3fVerbatim'29 >>= withAttribute NormalTok) >>~ pushContext "VerbatimEnvParam")
<|>
((pRegExpr regex_'28verbatim'7cboxedverbatim'29 >>= withAttribute NormalTok) >>~ pushContext "VerbatimEnv")
<|>
((pRegExpr regex_comment >>= withAttribute NormalTok) >>~ pushContext "CommentEnv")
<|>
((pRegExpr regex_'28alignat'7cxalignat'7cxxalignat'29 >>= withAttribute NormalTok) >>~ pushContext "MathEnvParam")
<|>
((pRegExpr regex_'28equation'7cdisplaymath'7ceqnarray'7csubeqnarray'7cmath'7cmultline'7cgather'7calign'7cflalign'7cIEEEeqnarray'7cIEEEeqnarraybox'7csmallmatrix'7cpmatrix'7cbmatrix'7cBmatrix'7cvmatrix'7cVmatrix'29 >>= withAttribute NormalTok) >>~ pushContext "MathEnv")
<|>
((pRegExpr regex_'28tabularx'7ctabular'7csupertabular'7cmpsupertabular'7cxtabular'7cmpxtabular'7clongtable'29 >>= withAttribute NormalTok) >>~ pushContext "TabEnv")
<|>
((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok) >>~ pushContext "LatexEnv")
<|>
((pRegExpr regex_'5cs'2b >>= withAttribute AlertTok) >>~ (popContext))
<|>
((pRegExpr regex_'5b'5ea'2dzA'2dZ'5cxd7'5d >>= withAttribute AlertTok) >>~ (popContext)))
parseRules "LatexEnv" =
(((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext >> popContext >> popContext))
<|>
((pRegExpr regex_'5ba'2dzA'2dZ'5d'2b >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5cs'2b >>= withAttribute AlertTok))
<|>
((parseRules "EnvCommon")))
parseRules "VerbatimEnv" =
(((pDetectChar False '}' >>= withAttribute NormalTok) >>~ pushContext "Verbatim")
<|>
((lookAhead (pRegExpr regex_'5ba'2dzA'2dZ'5d) >> (popContext) >> currentContext >>= parseRules))
<|>
((parseRules "EnvCommon"))
<|>
((popContext >> popContext >> popContext) >> currentContext >>= parseRules))
parseRules "VerbatimEnvParam" =
(((pDetect2Chars False '}' '[' >>= withAttribute NormalTok))
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ pushContext "Verbatim")
<|>
((pDetectChar False ']' >>= withAttribute NormalTok) >>~ pushContext "Verbatim"))
parseRules "Verbatim" =
(((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((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 NormalTok) >>~ pushContext "VerbFindEnd"))
parseRules "VerbFindEnd" =
(((pRegExpr regex_'5cs'2a'5c'7b >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'28verbatim'7clstlisting'7cboxedverbatim'7c'28B'7cL'29'3fVerbatim'29'5c'2a'3f >>= withAttribute NormalTok))
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext >> popContext >> popContext >> popContext >> popContext))
<|>
((popContext) >> currentContext >>= parseRules))
parseRules "CommentEnv" =
(((pDetectChar False '}' >>= withAttribute NormalTok) >>~ pushContext "BlockComment")
<|>
((lookAhead (pRegExpr regex_'5ba'2dzA'2dZ'5d) >> (popContext) >> currentContext >>= parseRules))
<|>
((parseRules "EnvCommon"))
<|>
((popContext >> popContext >> popContext) >> currentContext >>= parseRules))
parseRules "BlockComment" =
(((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5c'5cend'28'3f'3d'5cs'2a'5c'7bcomment'5c'2a'3f'5c'7d'29 >>= withAttribute NormalTok) >>~ pushContext "CommFindEnd"))
parseRules "CommFindEnd" =
(((pRegExpr regex_'5cs'2a'5c'7b >>= withAttribute NormalTok))
<|>
((pRegExpr regex_comment'5c'2a'3f >>= withAttribute NormalTok))
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext >> popContext >> popContext >> popContext >> popContext))
<|>
((popContext) >> currentContext >>= parseRules))
parseRules "MathEnv" =
(((pDetectChar False '}' >>= withAttribute NormalTok) >>~ pushContext "MathModeEnv")
<|>
((lookAhead (pRegExpr regex_'5ba'2dzA'2dZ'5d) >> (popContext) >> currentContext >>= parseRules))
<|>
((parseRules "EnvCommon")))
parseRules "MathEnvParam" =
(((pRegExpr regex_'5c'7d'5c'7b'5b'5e'5c'7d'5d'2a'5c'7d >>= withAttribute NormalTok) >>~ pushContext "MathModeEnv")
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ pushContext "MathModeEnv")
<|>
((lookAhead (pRegExpr regex_'5ba'2dzA'2dZ'5d) >> (popContext) >> currentContext >>= parseRules))
<|>
((parseRules "EnvCommon")))
parseRules "EnvCommon" =
(((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5c'2a'28'3f'3d'5c'7d'29 >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5c'2a'5b'5e'5c'7d'5d'2a >>= withAttribute AlertTok) >>~ (popContext >> popContext >> popContext))
<|>
((pRegExpr regex_'5b'5ea'2dzA'2dZ'5cxd7'5d'5b'5e'5c'7d'5d'2a >>= withAttribute AlertTok) >>~ (popContext >> popContext >> popContext)))
parseRules "MathModeEnv" =
(((pRegExpr regex_'5c'5cbegin'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute NormalTok) >>~ pushContext "FindBeginEnvironment")
<|>
((pRegExpr regex_'5c'5cend'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute NormalTok) >>~ pushContext "MathFindEnd")
<|>
((pString False "\\(" >>= withAttribute AlertTok))
<|>
((pString False "\\[" >>= withAttribute AlertTok))
<|>
((pString False "\\)" >>= withAttribute AlertTok))
<|>
((pString False "\\]" >>= withAttribute AlertTok))
<|>
((pRegExpr regex_'5c'5c'28text'7cintertext'7cmbox'29'5cs'2a'28'3f'3d'5c'7b'29 >>= withAttribute NormalTok) >>~ pushContext "MathModeText")
<|>
((pDetectChar False '\\' >>= withAttribute NormalTok) >>~ pushContext "MathContrSeq")
<|>
((pString False "$$" >>= withAttribute AlertTok))
<|>
((pDetectChar False '$' >>= withAttribute AlertTok))
<|>
((pDetectChar False '%' >>= withAttribute CommentTok) >>~ pushContext "Comment")
<|>
((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((pFirstNonSpace >> pRegExpr regex_'25'5cs'2aBEGIN'2e'2a'24 >>= withAttribute RegionMarkerTok))
<|>
((pFirstNonSpace >> pRegExpr regex_'25'5cs'2aEND'2e'2a'24 >>= withAttribute RegionMarkerTok)))
parseRules "MathFindEnd" =
(((pRegExpr regex_'5cs'2a'5c'7b >>= withAttribute NormalTok))
<|>
((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 NormalTok))
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext >> popContext >> popContext >> popContext >> popContext))
<|>
((popContext) >> currentContext >>= parseRules))
parseRules "TabEnv" =
(((pDetectChar False '}' >>= withAttribute NormalTok) >>~ pushContext "Tab")
<|>
((lookAhead (pRegExpr regex_'5ba'2dzA'2dZ'5d) >> (popContext) >> currentContext >>= parseRules))
<|>
((parseRules "EnvCommon"))
<|>
((popContext >> popContext >> popContext) >> currentContext >>= parseRules))
parseRules "Tab" =
(((pDetectChar False '&' >>= withAttribute NormalTok))
<|>
((pString False "@{" >>= withAttribute NormalTok) >>~ 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 NormalTok) >>~ pushContext "TabFindEnd")
<|>
((parseRules "Normal Text")))
parseRules "Column Separator" =
(((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "Column Separator")
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pRegExpr regex_'2e >>= withAttribute NormalTok)))
parseRules "TabFindEnd" =
(((pRegExpr regex_'5cs'2a'5c'7b >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'28tabularx'7ctabular'7csupertabular'7cmpsupertabular'7cxtabular'7cmpxtabular'7clongtable'29'5c'2a'3f >>= withAttribute NormalTok))
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext >> popContext >> popContext >> popContext >> popContext))
<|>
((popContext) >> currentContext >>= parseRules))
parseRules "MathMode" =
(((pString False "$$" >>= withAttribute AlertTok))
<|>
((pDetectChar False '$' >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pDetect2Chars False '\\' ')' >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pDetect2Chars False '\\' ']' >>= withAttribute AlertTok))
<|>
((parseRules "MathModeCommon")))
parseRules "MathModeDisplay" =
(((pString False "$$" >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pDetectChar False '$' >>= withAttribute AlertTok))
<|>
((pDetect2Chars False '\\' ']' >>= withAttribute AlertTok))
<|>
((pDetect2Chars False '\\' ')' >>= withAttribute AlertTok))
<|>
((parseRules "MathModeCommon")))
parseRules "MathModeEquation" =
(((pDetect2Chars False '\\' ']' >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pString False "$$" >>= withAttribute AlertTok))
<|>
((pDetectChar False '$' >>= withAttribute AlertTok))
<|>
((pDetect2Chars False '\\' ')' >>= withAttribute AlertTok))
<|>
((parseRules "MathModeCommon")))
parseRules "MathModeEnsure" =
(((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "MathModeEnsure")
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext))
<|>
((parseRules "MathModeCommon")))
parseRules "MathModeCommon" =
(((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 AlertTok))
<|>
((pRegExpr regex_'5c'5cbegin'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5c'5cend'28'3f'3d'5b'5ea'2dzA'2dZ'5d'29 >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5c'5c'28text'7cintertext'7cmbox'29'5cs'2a'28'3f'3d'5c'7b'29 >>= withAttribute NormalTok) >>~ pushContext "MathModeText")
<|>
((pDetectChar False '\\' >>= withAttribute NormalTok) >>~ pushContext "MathContrSeq")
<|>
((pDetectChar False '%' >>= withAttribute CommentTok) >>~ pushContext "Comment")
<|>
((pFirstNonSpace >> pRegExpr regex_'25'5cs'2aBEGIN'2e'2a'24 >>= withAttribute RegionMarkerTok))
<|>
((pFirstNonSpace >> pRegExpr regex_'25'5cs'2aEND'2e'2a'24 >>= withAttribute RegionMarkerTok))
<|>
((pDetectChar False '\215' >>= withAttribute NormalTok)))
parseRules "MathContrSeq" =
(((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5ba'2dzA'2dZ'5d'2b'5c'2a'3f >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pRegExpr regex_'5b'5ea'2dzA'2dZ'5d >>= withAttribute NormalTok) >>~ (popContext)))
parseRules "MathModeText" =
((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "MathModeTextParameterStart")
parseRules "MathModeTextParameterStart" =
(((pRegExpr regex_'5c'5c'2e >>= withAttribute NormalTok))
<|>
((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'5c'24'2e'2a'5c'24 >>= withAttribute NormalTok))
<|>
((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "MathModeTextParameter")
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext >> popContext))
<|>
((pDetectChar False '%' >>= withAttribute CommentTok) >>~ pushContext "Comment"))
parseRules "MathModeTextParameter" =
(((pRegExpr regex_'5c'5c'2e >>= withAttribute NormalTok))
<|>
((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "MathModeTextParameter")
<|>
((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext))
<|>
((pDetectChar False '\215' >>= withAttribute NormalTok))
<|>
((pDetectChar False '%' >>= withAttribute CommentTok) >>~ pushContext "Comment"))
parseRules "Multiline Comment" =
(((pString False "\\fi" >>= withAttribute CommentTok) >>~ (popContext))
<|>
((pString False "\\else" >>= withAttribute CommentTok) >>~ (popContext)))
parseRules "Comment" =
(((pRegExpr regex_'28FIXME'7cTODO'29'3a'3f >>= withAttribute AlertTok))
<|>
((pString False "\\KileResetHL" >>= withAttribute CommentTok) >>~ pushContext "Normal Text")
<|>
((pString False "\\KateResetHL" >>= withAttribute CommentTok) >>~ pushContext "Normal Text"))
parseRules "" = parseRules "Normal Text"
parseRules x = fail $ "Unknown context" ++ x