{- This module was generated from data in the Kate syntax highlighting file djangotemplate.xml, version 1.3, by Matthew Marshall (matthew@matthewmarshall.org) -} module Text.Highlighting.Kate.Syntax.Djangotemplate (highlight, parseExpression, syntaxName, syntaxExtensions) where import Text.Highlighting.Kate.Types import Text.Highlighting.Kate.Common import qualified Text.Highlighting.Kate.Syntax.Alert import qualified Text.Highlighting.Kate.Syntax.Css import qualified Text.Highlighting.Kate.Syntax.Javascript import Text.ParserCombinators.Parsec hiding (State) import Control.Monad.State import Data.Char (isSpace) import qualified Data.Set as Set -- | Full name of language. syntaxName :: String syntaxName = "Django HTML Template" -- | Filename extensions for this language. syntaxExtensions :: String syntaxExtensions = "*.htm;*.html" -- | Highlight source code using this syntax definition. highlight :: String -> [SourceLine] highlight input = evalState (mapM parseSourceLine $ lines input) startingState parseSourceLine :: String -> State SyntaxState SourceLine parseSourceLine = mkParseSourceLine (parseExpression Nothing) -- | Parse an expression using appropriate local context. parseExpression :: Maybe (String,String) -> KateParser Token parseExpression mbcontext = do (lang,cont) <- maybe currentContext return mbcontext result <- parseRules (lang,cont) optional $ do eof updateState $ \st -> st{ synStPrevChar = '\n' } pEndLine return result startingState = SyntaxState {synStContexts = [("Django HTML Template","Start")], synStLineNumber = 0, synStPrevChar = '\n', synStPrevNonspace = False, synStCaseSensitive = True, synStKeywordCaseSensitive = True, synStCaptures = []} pEndLine = do updateState $ \st -> st{ synStPrevNonspace = False } context <- currentContext contexts <- synStContexts `fmap` getState if length contexts >= 2 then case context of ("Django HTML Template","Start") -> return () ("Django HTML Template","In Block") -> return () ("Django HTML Template","FindTemplate") -> return () ("Django HTML Template","Template Comment") -> return () ("Django HTML Template","Template Var") -> return () ("Django HTML Template","Template Filter") -> return () ("Django HTML Template","Template Tag") -> return () ("Django HTML Template","Found Block Tag") -> return () ("Django HTML Template","In Block Tag") -> return () ("Django HTML Template","Non Matching Tag") -> return () ("Django HTML Template","In Template Tag") -> return () ("Django HTML Template","Single A-string") -> return () ("Django HTML Template","Single Q-string") -> return () ("Django HTML Template","FindHTML") -> return () ("Django HTML Template","FindEntityRefs") -> return () ("Django HTML Template","FindPEntityRefs") -> return () ("Django HTML Template","FindAttributes") -> return () ("Django HTML Template","FindDTDRules") -> return () ("Django HTML Template","Comment") -> return () ("Django HTML Template","CDATA") -> return () ("Django HTML Template","PI") -> return () ("Django HTML Template","Doctype") -> return () ("Django HTML Template","Doctype Internal Subset") -> return () ("Django HTML Template","Doctype Markupdecl") -> return () ("Django HTML Template","Doctype Markupdecl DQ") -> return () ("Django HTML Template","Doctype Markupdecl SQ") -> return () ("Django HTML Template","El Open") -> return () ("Django HTML Template","El Close") -> return () ("Django HTML Template","El Close 2") -> return () ("Django HTML Template","El Close 3") -> return () ("Django HTML Template","CSS") -> return () ("Django HTML Template","CSS content") -> return () ("Django HTML Template","JS") -> return () ("Django HTML Template","JS content") -> return () ("Django HTML Template","JS comment close") -> (popContext) >> pEndLine ("Django HTML Template","Value") -> return () ("Django HTML Template","Value NQ") -> (popContext >> popContext) >> pEndLine ("Django HTML Template","Value DQ") -> return () ("Django HTML Template","Value SQ") -> return () _ -> return () else 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) list_blocktags = Set.fromList $ words $ "for block if ifequal ifnotequal ifchanged blocktrans spaceless autoescape" list_endblocktags = Set.fromList $ words $ "endfor endblock endif endifequal endifnotequal endifchanged endblocktrans endspaceless endautoescape" regex_'5c'7b'25'5cs'2aend'5ba'2dz'5d'2b'5cs'2a'25'5c'7d = compileRegex "\\{%\\s*end[a-z]+\\s*%\\}" regex_'5c'7b'25'5cs'2acomment'5cs'2a'25'5c'7d = compileRegex "\\{%\\s*comment\\s*%\\}" regex_'5c'7b'25'5cs'2aendcomment'5cs'2a'25'5c'7d = compileRegex "\\{%\\s*endcomment\\s*%\\}" regex_'28'5bA'2dZa'2dz'5f'3a'5d'5b'5cw'2e'3a'5f'2d'5d'2a'29 = compileRegex "([A-Za-z_:][\\w.:_-]*)" regex_'3c'21DOCTYPE'5cs'2b = compileRegex "))+" regex_'5cS = compileRegex "\\S" regex_'3c'2fstyle'5cb = compileRegex ")" regex_'5b'5e'2f'3e'3c'22'27'5cs'5d = compileRegex "[^/><\"'\\s]" parseRules ("Django HTML Template","Start") = (((pRegExpr regex_'5c'7b'25'5cs'2aend'5ba'2dz'5d'2b'5cs'2a'25'5c'7d >>= withAttribute ErrorTok)) <|> ((parseRules ("Django HTML Template","FindTemplate"))) <|> ((parseRules ("Django HTML Template","FindHTML"))) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","Start")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Django HTML Template","In Block") = (((lookAhead (pRegExpr regex_'5c'7b'25'5cs'2aend'5ba'2dz'5d'2b'5cs'2a'25'5c'7d) >> (popContext) >> currentContext >>= parseRules)) <|> ((parseRules ("Django HTML Template","FindTemplate"))) <|> ((parseRules ("Django HTML Template","FindHTML"))) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","In Block")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Django HTML Template","FindTemplate") = (((pRegExpr regex_'5c'7b'25'5cs'2acomment'5cs'2a'25'5c'7d >>= withAttribute CommentTok) >>~ pushContext ("Django HTML Template","Template Comment")) <|> ((pDetect2Chars False '{' '{' >>= withAttribute FunctionTok) >>~ pushContext ("Django HTML Template","Template Var")) <|> ((pDetect2Chars False '{' '%' >>= withAttribute FunctionTok) >>~ pushContext ("Django HTML Template","Template Tag")) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","FindTemplate")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Django HTML Template","Template Comment") = (((pRegExpr regex_'5c'7b'25'5cs'2aendcomment'5cs'2a'25'5c'7d >>= withAttribute CommentTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","Template Comment")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Django HTML Template","Template Var") = (((pDetect2Chars False '}' '}' >>= withAttribute FunctionTok) >>~ (popContext)) <|> ((pDetectChar False '|' >>= withAttribute OtherTok) >>~ pushContext ("Django HTML Template","Template Filter")) <|> ((pDetect2Chars False '{' '{' >>= withAttribute ErrorTok)) <|> ((pDetect2Chars False '{' '%' >>= withAttribute ErrorTok)) <|> ((pDetect2Chars False '%' '}' >>= withAttribute ErrorTok)) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","Template Var")) >> pDefault >>= withAttribute FunctionTok)) parseRules ("Django HTML Template","Template Filter") = (((pDetect2Chars False '}' '}' >>= withAttribute FunctionTok) >>~ (popContext >> popContext)) <|> ((pDetectChar False '\'' >>= withAttribute StringTok) >>~ pushContext ("Django HTML Template","Single A-string")) <|> ((pDetectChar False '"' >>= withAttribute StringTok) >>~ pushContext ("Django HTML Template","Single Q-string")) <|> ((pDetect2Chars False '{' '{' >>= withAttribute ErrorTok)) <|> ((pDetect2Chars False '{' '%' >>= withAttribute ErrorTok)) <|> ((pDetect2Chars False '%' '}' >>= withAttribute ErrorTok)) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","Template Filter")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Django HTML Template","Template Tag") = (((lookAhead (pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_blocktags) >> pushContext ("Django HTML Template","Found Block Tag") >> currentContext >>= parseRules)) <|> ((pDetectIdentifier >>= withAttribute FunctionTok) >>~ pushContext ("Django HTML Template","In Template Tag")) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","Template Tag")) >> pDefault >>= withAttribute FunctionTok)) parseRules ("Django HTML Template","Found Block Tag") = (((pRegExpr regex_'28'5bA'2dZa'2dz'5f'3a'5d'5b'5cw'2e'3a'5f'2d'5d'2a'29 >>= withAttribute FunctionTok) >>~ pushContext ("Django HTML Template","In Block Tag")) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","Found Block Tag")) >> pDefault >>= withAttribute FunctionTok)) parseRules ("Django HTML Template","In Block Tag") = (((pRegExprDynamic "\\{%\\s*end%1\\s*%\\}" >>= withAttribute FunctionTok) >>~ (popContext >> popContext >> popContext)) <|> ((lookAhead (pRegExpr regex_'5c'7b'25'5cs'2aend'5ba'2dz'5d'2b'5cs'2a'25'5c'7d) >> pushContext ("Django HTML Template","Non Matching Tag") >> currentContext >>= parseRules)) <|> ((pDetect2Chars False '%' '}' >>= withAttribute FunctionTok) >>~ pushContext ("Django HTML Template","In Block")) <|> ((parseRules ("Django HTML Template","In Template Tag"))) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","In Block Tag")) >> pDefault >>= withAttribute FunctionTok)) parseRules ("Django HTML Template","Non Matching Tag") = (((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_endblocktags >>= withAttribute ErrorTok) >>~ (popContext)) <|> ((pDetectIdentifier >>= withAttribute FunctionTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","Non Matching Tag")) >> pDefault >>= withAttribute FunctionTok)) parseRules ("Django HTML Template","In Template Tag") = (((pDetect2Chars False '%' '}' >>= withAttribute FunctionTok) >>~ (popContext >> popContext)) <|> ((pDetectChar False '\'' >>= withAttribute StringTok) >>~ pushContext ("Django HTML Template","Single A-string")) <|> ((pDetectChar False '"' >>= withAttribute StringTok) >>~ pushContext ("Django HTML Template","Single Q-string")) <|> ((pDetect2Chars False '{' '{' >>= withAttribute ErrorTok)) <|> ((pDetect2Chars False '{' '%' >>= withAttribute ErrorTok)) <|> ((pDetect2Chars False '}' '}' >>= withAttribute ErrorTok)) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","In Template Tag")) >> pDefault >>= withAttribute FunctionTok)) parseRules ("Django HTML Template","Single A-string") = (((pHlCStringChar >>= withAttribute StringTok)) <|> ((pDetectChar False '\'' >>= withAttribute StringTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","Single A-string")) >> pDefault >>= withAttribute StringTok)) parseRules ("Django HTML Template","Single Q-string") = (((pHlCStringChar >>= withAttribute StringTok)) <|> ((pDetectChar False '"' >>= withAttribute StringTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","Single Q-string")) >> pDefault >>= withAttribute StringTok)) parseRules ("Django HTML Template","FindHTML") = (((pDetectSpaces >>= withAttribute NormalTok)) <|> ((pDetectIdentifier >>= withAttribute NormalTok)) <|> ((pString False "" >>= withAttribute CommentTok) >>~ (popContext)) <|> ((pRegExpr regex_'2d'28'2d'28'3f'21'2d'3e'29'29'2b >>= withAttribute ErrorTok)) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","Comment")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Django HTML Template","CDATA") = (((pDetectSpaces >>= withAttribute NormalTok)) <|> ((pDetectIdentifier >>= withAttribute NormalTok)) <|> ((pString False "]]>" >>= withAttribute BaseNTok) >>~ (popContext)) <|> ((pString False "]]>" >>= withAttribute DecValTok)) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","CDATA")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Django HTML Template","PI") = (((pDetect2Chars False '?' '>' >>= withAttribute KeywordTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","PI")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Django HTML Template","Doctype") = (((pDetectChar False '>' >>= withAttribute DataTypeTok) >>~ (popContext)) <|> ((pDetectChar False '[' >>= withAttribute DataTypeTok) >>~ pushContext ("Django HTML Template","Doctype Internal Subset")) <|> (currentContext >>= \x -> guard (x == ("Django HTML Template","Doctype")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Django HTML Template","Doctype Internal Subset") = (((pDetectChar False ']' >>= withAttribute DataTypeTok) >>~ (popContext)) <|> ((parseRules ("Django HTML Template","FindDTDRules"))) <|> ((pString False "