{- 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.Definitions 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 import Control.Monad (when) import Data.Map (fromList) import Data.Maybe (fromMaybe, maybeToList) -- | 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 -> 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 = "HTML" } context <- currentContext <|> (pushContext "Start" >> 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 [("HTML",["Start"])], synStLanguage = "HTML", 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 "Start" -> return () >> pHandleEndLine "FindHTML" -> return () >> pHandleEndLine "FindEntityRefs" -> return () >> pHandleEndLine "FindPEntityRefs" -> return () >> pHandleEndLine "FindAttributes" -> return () >> pHandleEndLine "FindDTDRules" -> return () >> pHandleEndLine "Comment" -> return () >> pHandleEndLine "CDATA" -> return () >> pHandleEndLine "PI" -> return () >> pHandleEndLine "Doctype" -> return () >> pHandleEndLine "Doctype Internal Subset" -> return () >> pHandleEndLine "Doctype Markupdecl" -> return () >> pHandleEndLine "Doctype Markupdecl DQ" -> return () >> pHandleEndLine "Doctype Markupdecl SQ" -> return () >> pHandleEndLine "El Open" -> return () >> pHandleEndLine "El Close" -> return () >> pHandleEndLine "El Close 2" -> return () >> pHandleEndLine "El Close 3" -> return () >> pHandleEndLine "CSS" -> return () >> pHandleEndLine "CSS content" -> return () >> pHandleEndLine "JS" -> return () >> pHandleEndLine "JS content" -> return () >> pHandleEndLine "JS comment close" -> (popContext) >> pEndLine "Value" -> return () >> pHandleEndLine "Value NQ" -> (popContext >> popContext) >> pEndLine "Value DQ" -> return () >> pHandleEndLine "Value SQ" -> return () >> pHandleEndLine _ -> 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"),("CDATA","bn"),("Processing Instruction","kw"),("Doctype","dt"),("Element","kw"),("Attribute","ot"),("Value","st"),("EntityRef","dv"),("PEntityRef","dv"),("Error","er")] parseExpressionInternal = do context <- currentContext parseRules context <|> (pDefault >>= withAttribute (fromMaybe "" $ 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","Normal Text"),("FindHTML","Normal Text"),("FindEntityRefs","Other Text"),("FindPEntityRefs","Other Text"),("FindAttributes","Other Text"),("FindDTDRules","Other Text"),("Comment","Comment"),("CDATA","Other Text"),("PI","Other Text"),("Doctype","Other Text"),("Doctype Internal Subset","Other Text"),("Doctype Markupdecl","Other Text"),("Doctype Markupdecl DQ","Value"),("Doctype Markupdecl SQ","Value"),("El Open","Other Text"),("El Close","Other Text"),("El Close 2","Other Text"),("El Close 3","Other Text"),("CSS","Other Text"),("CSS content","Other Text"),("JS","Other Text"),("JS content","Other Text"),("JS comment close","Comment"),("Value","Other Text"),("Value NQ","Other Text"),("Value DQ","Value"),("Value SQ","Value")] parseRules "Start" = do (attr, result) <- ((parseRules "FindHTML")) return (attr, result) parseRules "FindHTML" = do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text")) <|> ((pDetectIdentifier >>= withAttribute "Normal Text")) <|> ((pString False "" >>= withAttribute "Comment") >>~ (popContext)) <|> ((pRegExpr regex_'2d'28'2d'28'3f'21'2d'3e'29'29'2b >>= withAttribute "Error"))) return (attr, result) parseRules "CDATA" = do (attr, result) <- (((pDetectSpaces >>= withAttribute "Other Text")) <|> ((pDetectIdentifier >>= withAttribute "Other Text")) <|> ((pString False "]]>" >>= withAttribute "CDATA") >>~ (popContext)) <|> ((pString False "]]>" >>= withAttribute "EntityRef"))) return (attr, result) parseRules "PI" = do (attr, result) <- ((pDetect2Chars False '?' '>' >>= withAttribute "Processing Instruction") >>~ (popContext)) return (attr, result) parseRules "Doctype" = do (attr, result) <- (((pDetectChar False '>' >>= withAttribute "Doctype") >>~ (popContext)) <|> ((pDetectChar False '[' >>= withAttribute "Doctype") >>~ pushContext "Doctype Internal Subset")) return (attr, result) parseRules "Doctype Internal Subset" = do (attr, result) <- (((pDetectChar False ']' >>= withAttribute "Doctype") >>~ (popContext)) <|> ((parseRules "FindDTDRules")) <|> ((pString False "