{- This module was generated from data in the Kate syntax highlighting file html.xml, version 1.99, by Wilbert Berendsen (wilbert@kde.nl) -} module Text.Highlighting.Kate.Syntax.Html (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 Data.Map (fromList) import Control.Monad.State import Data.Char (isSpace) import Data.Maybe (fromMaybe) -- | Full name of language. syntaxName :: String syntaxName = "HTML" -- | Filename extensions for this language. syntaxExtensions :: String syntaxExtensions = "*.htm;*.html;*.shtml;*.shtm" -- | 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 parseExpressionInternal pEndLine -- | Parse an expression using appropriate local context. parseExpression :: KateParser Token parseExpression = do st <- getState let oldLang = synStLanguage st setState $ st { synStLanguage = "HTML" } context <- currentContext <|> (pushContext "Start" >> currentContext) result <- parseRules context optional $ eof >> pEndLine updateState $ \st -> st { synStLanguage = oldLang } return result startingState = SyntaxState {synStContexts = fromList [("HTML",["Start"])], synStLanguage = "HTML", synStLineNumber = 0, synStPrevChar = '\n', synStPrevNonspace = False, synStCaseSensitive = True, synStKeywordCaseSensitive = True, synStCaptures = []} pEndLine = do updateState $ \st -> st{ synStPrevNonspace = False } context <- currentContext case context of "Start" -> return () "FindHTML" -> return () "FindEntityRefs" -> return () "FindPEntityRefs" -> return () "FindAttributes" -> return () "FindDTDRules" -> return () "Comment" -> return () "CDATA" -> return () "PI" -> return () "Doctype" -> return () "Doctype Internal Subset" -> return () "Doctype Markupdecl" -> return () "Doctype Markupdecl DQ" -> return () "Doctype Markupdecl SQ" -> return () "El Open" -> return () "El Close" -> return () "El Close 2" -> return () "El Close 3" -> return () "CSS" -> return () "CSS content" -> return () "JS" -> return () "JS content" -> return () "JS comment close" -> (popContext) >> pEndLine "Value" -> return () "Value NQ" -> (popContext >> popContext) >> pEndLine "Value DQ" -> return () "Value SQ" -> return () _ -> 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_'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]" defaultAttributes = [("Start",NormalTok),("FindHTML",NormalTok),("FindEntityRefs",NormalTok),("FindPEntityRefs",NormalTok),("FindAttributes",NormalTok),("FindDTDRules",NormalTok),("Comment",CommentTok),("CDATA",NormalTok),("PI",NormalTok),("Doctype",NormalTok),("Doctype Internal Subset",NormalTok),("Doctype Markupdecl",NormalTok),("Doctype Markupdecl DQ",StringTok),("Doctype Markupdecl SQ",StringTok),("El Open",NormalTok),("El Close",NormalTok),("El Close 2",NormalTok),("El Close 3",NormalTok),("CSS",NormalTok),("CSS content",NormalTok),("JS",NormalTok),("JS content",NormalTok),("JS comment close",CommentTok),("Value",NormalTok),("Value NQ",NormalTok),("Value DQ",StringTok),("Value SQ",StringTok)] parseRules "Start" = ((parseRules "FindHTML")) parseRules "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))) parseRules "CDATA" = (((pDetectSpaces >>= withAttribute NormalTok)) <|> ((pDetectIdentifier >>= withAttribute NormalTok)) <|> ((pString False "]]>" >>= withAttribute BaseNTok) >>~ (popContext)) <|> ((pString False "]]>" >>= withAttribute DecValTok))) parseRules "PI" = ((pDetect2Chars False '?' '>' >>= withAttribute KeywordTok) >>~ (popContext)) parseRules "Doctype" = (((pDetectChar False '>' >>= withAttribute DataTypeTok) >>~ (popContext)) <|> ((pDetectChar False '[' >>= withAttribute DataTypeTok) >>~ pushContext "Doctype Internal Subset")) parseRules "Doctype Internal Subset" = (((pDetectChar False ']' >>= withAttribute DataTypeTok) >>~ (popContext)) <|> ((parseRules "FindDTDRules")) <|> ((pString False "