{- This module was generated from data in the Kate syntax highlighting file doxygen.xml, version 1.33, by Dominik Haumann (dhdev@gmx.de) -} module Text.Highlighting.Kate.Syntax.Doxygen (highlight, parseExpression, syntaxName, syntaxExtensions) where import Text.Highlighting.Kate.Types import Text.Highlighting.Kate.Common import qualified Text.Highlighting.Kate.Syntax.Alert 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 = "Doxygen" -- | Filename extensions for this language. syntaxExtensions :: String syntaxExtensions = "*.dox;*.doxygen" -- | 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 -- | Parse an expression using appropriate local context. parseExpression :: KateParser Token parseExpression = do (lang,cont) <- currentContext result <- parseRules (lang,cont) optional $ do eof updateState $ \st -> st{ synStPrevChar = '\n' } pEndLine return result startingState = SyntaxState {synStContexts = [("Doxygen","Normal")], synStLineNumber = 0, synStPrevChar = '\n', synStPrevNonspace = False, synStCaseSensitive = True, synStKeywordCaseSensitive = False, synStCaptures = []} pEndLine = do updateState $ \st -> st{ synStPrevNonspace = False } context <- currentContext contexts <- synStContexts `fmap` getState if length contexts >= 2 then case context of ("Doxygen","Normal") -> return () ("Doxygen","LineComment") -> (popContext) >> pEndLine ("Doxygen","BlockComment") -> return () ("Doxygen","ML_TagWord") -> (popContext) >> pEndLine ("Doxygen","ML_TagParam") -> (popContext) >> pEndLine ("Doxygen","ML_TagWordWord") -> (popContext) >> pEndLine ("Doxygen","ML_Tag2ndWord") -> (popContext >> popContext) >> pEndLine ("Doxygen","ML_TagString") -> (popContext) >> pEndLine ("Doxygen","ML_TagWordString") -> (popContext) >> pEndLine ("Doxygen","ML_htmltag") -> return () ("Doxygen","ML_htmlcomment") -> return () ("Doxygen","ML_identifiers") -> return () ("Doxygen","ML_types1") -> return () ("Doxygen","ML_types2") -> return () ("Doxygen","SL_TagWord") -> (popContext) >> pEndLine ("Doxygen","SL_TagParam") -> (popContext) >> pEndLine ("Doxygen","SL_TagWordWord") -> (popContext) >> pEndLine ("Doxygen","SL_Tag2ndWord") -> (popContext >> popContext) >> pEndLine ("Doxygen","SL_TagString") -> (popContext) >> pEndLine ("Doxygen","SL_TagWordString") -> (popContext) >> pEndLine ("Doxygen","SL_htmltag") -> (popContext) >> pEndLine ("Doxygen","SL_htmlcomment") -> (popContext) >> pEndLine ("Doxygen","SL_identifiers") -> (popContext) >> pEndLine ("Doxygen","SL_types1") -> (popContext) >> pEndLine ("Doxygen","SL_types2") -> (popContext) >> pEndLine ("Doxygen","SL_DetectEnv") -> (popContext) >> pEndLine ("Doxygen","SL_DetectComment") -> (popContext) >> pEndLine ("Doxygen","Code") -> return () ("Doxygen","Verbatim") -> return () ("Doxygen","Formula") -> return () ("Doxygen","Msc") -> return () ("Doxygen","Dot") -> 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_TagOnly = Set.fromList $ words $ "\\arg @arg \\author @author \\authors @authors \\brief @brief \\bug @bug \\callgraph @callgraph \\callergraph @callergraph \\date @date \\deprecated @deprecated \\details @details \\else @else \\endcond @endcond \\endhtmlonly @endhtmlonly \\endif @endif \\enditernal @enditernal \\endlatexonly @endlatexonly \\endlink @endlink \\endmanonly @endmanonly \\endrtfonly @endrtfonly \\endxmlonly @endxmlonly \\f[ @f[ \\f] @f] \\f$ @f$ \\hideinitializer @hideinitializer \\htmlonly @htmlonly \\internal @internal \\invariant @invariant \\latexonly @latexonly \\li @li \\manonly @manonly \\n @n \\nosubgrouping @nosubgrouping \\only @only \\post @post \\pre @pre \\private @pivate \\privatesection @pivatesection \\protected @protected \\protectedsection @protectedsection \\public @public \\publicsection @publicsection \\remarks @remarks \\return @return \\returns @returns \\result @result \\rtfonly @rtfonly \\sa @sa \\see @see \\short @short \\showinitializer @showinitializer \\since @since \\tableofcontents @tableofcontents \\test @test \\version @version \\xmlonly @xmlonly \\# @# \\$ @$ \\% @% \\& @& \\> @> \\< @< \\\" @\" \\:: @:: \\@ @@ \\\\ @\\ \\~ @~" list_TagWord = Set.fromList $ words $ "\\a @a \\anchor @anchor \\b @b \\c @c \\cond @cond \\copybrief @copybrief \\copydetails @copydetails \\copydoc @copydoc \\def @def \\dir @dir \\dontinclude @dontinclude \\e @e \\elseif @elseif \\em @em \\enum @enum \\example @example \\exception @exception \\exceptions @exceptions \\extends @extends \\file @file \\htmlinclude @htmlinclude \\if @if \\ifnot @ifnot \\implements @implements \\include @include \\includelineno @includelineno \\link @link \\memberof @memberof \\namespace @namespace \\p @p \\package @package \\property @property \\relatedalso @relatedalso \\relatesalso @relatesalso \\related @related \\relates @relates \\retval @retval \\throw @throw \\throws @throws \\verbinclude @verbinclude \\version @version \\xrefitem @xrefitem" list_TagParam = Set.fromList $ words $ "\\param @param \\tparam @tparam" list_TagWordWord = Set.fromList $ words $ "\\image @image" list_TagWordString = Set.fromList $ words $ "\\addtogroup @addtogroup \\category @category \\class @class \\dotfile @dotfile \\defgroup @defgroup \\interface @interface \\headerfile @headerfile \\mscfile @mscfile \\page @page \\paragraph @paragraph \\protocol @prtocol \\ref @ref \\section @section \\snippet @snippet \\struct @struct \\subpage @subpage \\subsection @subsection \\subsubsection @subsubsection \\union @union \\weakgroup @weakgroup" list_TagString = Set.fromList $ words $ "\\addindex @addindex \\copyright @copyright \\fn @fn \\ingroup @ingroup \\line @line \\mainpage @mainpage \\name @name \\overload @overload \\par @par \\skip @skip \\skipline @skipline \\typedef @typedef \\until @until \\var @var" list_Note = Set.fromList $ words $ "\\note @note" list_Warning = Set.fromList $ words $ "\\warning @warning" list_Attention = Set.fromList $ words $ "\\attention @attention" list_Todo = Set.fromList $ words $ "\\todo @todo" regex_'2f'2f'28'21'7c'28'2f'28'3f'3d'5b'5e'2f'5d'7c'24'29'29'29'3c'3f = compileRegex "//(!|(/(?=[^/]|$))))" regex_'5cS'28'3f'3d'28'5b'5d'5b'2c'3f'3b'28'29'5d'7c'5c'2e'24'7c'5c'2e'3f'5cs'29'29 = compileRegex "\\S(?=([][,?;()]|\\.$|\\.?\\s))" regex_'5cS = compileRegex "\\S" regex_'2e = compileRegex "." regex_'5cs'2a'3d'5cs'2a = compileRegex "\\s*=\\s*" regex_'5cs'2a'23'3f'5ba'2dzA'2dZ0'2d9'5d'2a = compileRegex "\\s*#?[a-zA-Z0-9]*" regex_'5b'40'5c'5c'5dcode'5cb = compileRegex "[@\\\\]code\\b" regex_'5b'40'5c'5c'5dverbatim'5cb = compileRegex "[@\\\\]verbatim\\b" regex_'5b'40'5c'5c'5df'5c'5b = compileRegex "[@\\\\]f\\[" regex_'5b'40'5c'5c'5dmsc'5cb = compileRegex "[@\\\\]msc\\b" regex_'5b'40'5c'5c'5ddot'5cb = compileRegex "[@\\\\]dot\\b" regex_'26'5bA'2dZa'2dz'5d'2b'3b = compileRegex "&[A-Za-z]+;" regex_'5b'40'5c'5c'5dendcode'5cb = compileRegex "[@\\\\]endcode\\b" regex_'5b'40'5c'5c'5dendverbatim'5cb = compileRegex "[@\\\\]endverbatim\\b" regex_'5b'40'5c'5c'5df'5c'5d = compileRegex "[@\\\\]f\\]" regex_'5b'40'5c'5c'5dendmsc'5cb = compileRegex "[@\\\\]endmsc\\b" regex_'5b'40'5c'5c'5denddot'5cb = compileRegex "[@\\\\]enddot\\b" parseRules ("Doxygen","Normal") = (((pRegExpr regex_'2f'2f'28'21'7c'28'2f'28'3f'3d'5b'5e'2f'5d'7c'24'29'29'29'3c'3f >>= withAttribute CommentTok) >>~ pushContext ("Doxygen","LineComment")) <|> ((pRegExpr regex_'2f'5c'2a'28'5c'2a'5b'5e'2a'2f'5d'7c'21'7c'5b'2a'21'5d'3c'7c'5c'2a'24'29 >>= withAttribute CommentTok) >>~ pushContext ("Doxygen","BlockComment")) <|> ((pRegExpr regex_'2f'2f'5cs'2a'40'5c'7b'5cs'2a'24 >>= withAttribute RegionMarkerTok)) <|> ((pRegExpr regex_'2f'2f'5cs'2a'40'5c'7d'5cs'2a'24 >>= withAttribute RegionMarkerTok)) <|> ((pRegExpr regex_'2f'5c'2a'5cs'2a'40'5c'7b'5cs'2a'5c'2a'2f >>= withAttribute RegionMarkerTok)) <|> ((pRegExpr regex_'2f'5c'2a'5cs'2a'40'5c'7d'5cs'2a'5c'2a'2f >>= withAttribute RegionMarkerTok)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","Normal")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Doxygen","LineComment") = (((pLineContinue >>= withAttribute CommentTok)) <|> ((pDetectSpaces >>= withAttribute CommentTok)) <|> ((Text.Highlighting.Kate.Syntax.Alert.parseExpression >>= ((withAttribute CommentTok) . snd))) <|> ((parseRules ("Doxygen","SL_DetectEnv"))) <|> ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}" list_TagOnly >>= withAttribute KeywordTok)) <|> ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}" list_TagWord >>= withAttribute KeywordTok) >>~ pushContext ("Doxygen","SL_TagWord")) <|> ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}" list_TagParam >>= withAttribute KeywordTok) >>~ pushContext ("Doxygen","SL_TagParam")) <|> ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}" list_TagWordWord >>= withAttribute KeywordTok) >>~ pushContext ("Doxygen","SL_TagWordWord")) <|> ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}" list_TagString >>= withAttribute KeywordTok) >>~ pushContext ("Doxygen","SL_TagString")) <|> ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}" list_TagWordString >>= withAttribute KeywordTok) >>~ pushContext ("Doxygen","SL_TagWordString")) <|> ((pRegExpr regex_'5b'40'5c'5c'5d'5b'5e'40'5c'5c_'5ct'5d'2b >>= withAttribute NormalTok)) <|> ((pDetectIdentifier >>= withAttribute CommentTok)) <|> ((pString False "" >>= withAttribute CommentTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","ML_htmlcomment")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Doxygen","ML_identifiers") = (((lookAhead (pDetect2Chars False '*' '/') >> (popContext) >> currentContext >>= parseRules)) <|> ((pRegExpr regex_'5cs'2a'23'3f'5ba'2dzA'2dZ0'2d9'5d'2a >>= withAttribute NormalTok) >>~ (popContext)) <|> ((pDetectChar False '\'' >>= withAttribute DataTypeTok) >>~ pushContext ("Doxygen","ML_types1")) <|> ((pDetectChar False '"' >>= withAttribute DataTypeTok) >>~ pushContext ("Doxygen","ML_types2")) <|> (currentContext >>= \x -> guard (x == ("Doxygen","ML_identifiers")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Doxygen","ML_types1") = (((lookAhead (pDetect2Chars False '*' '/') >> (popContext) >> currentContext >>= parseRules)) <|> ((pDetectChar False '\'' >>= withAttribute DataTypeTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","ML_types1")) >> pDefault >>= withAttribute DataTypeTok)) parseRules ("Doxygen","ML_types2") = (((lookAhead (pDetect2Chars False '*' '/') >> (popContext) >> currentContext >>= parseRules)) <|> ((pDetectChar False '"' >>= withAttribute DataTypeTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","ML_types2")) >> pDefault >>= withAttribute DataTypeTok)) parseRules ("Doxygen","SL_TagWord") = (((pDetectSpaces >>= withAttribute CommentTok)) <|> ((lookAhead (pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}" list_TagWord) >> (popContext) >> currentContext >>= parseRules)) <|> ((pRegExpr regex_'5cS'28'3f'3d'28'5b'5d'5b'2c'3f'3b'28'29'5d'7c'5c'2e'24'7c'5c'2e'3f'5cs'29'29 >>= withAttribute KeywordTok) >>~ (popContext)) <|> ((pRegExpr regex_'5cS >>= withAttribute KeywordTok)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","SL_TagWord")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Doxygen","SL_TagParam") = (((pDetectSpaces >>= withAttribute CommentTok)) <|> ((pString False "[in]" >>= withAttribute KeywordTok) >>~ pushContext ("Doxygen","SL_Tag2ndWord")) <|> ((pString False "[out]" >>= withAttribute KeywordTok) >>~ pushContext ("Doxygen","SL_Tag2ndWord")) <|> ((pString False "[in,out]" >>= withAttribute KeywordTok) >>~ pushContext ("Doxygen","SL_Tag2ndWord")) <|> ((pRegExpr regex_'5cS'28'3f'3d'28'5b'5d'5b'2c'3f'3b'28'29'5d'7c'5c'2e'24'7c'5c'2e'3f'5cs'29'29 >>= withAttribute KeywordTok) >>~ (popContext)) <|> ((pRegExpr regex_'5cS >>= withAttribute KeywordTok)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","SL_TagParam")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Doxygen","SL_TagWordWord") = (((pDetectSpaces >>= withAttribute CommentTok)) <|> ((pRegExpr regex_'5cS'28'3f'3d'28'5b'5d'5b'2c'3f'3b'28'29'5d'7c'5c'2e'24'7c'5c'2e'3f'5cs'29'29 >>= withAttribute KeywordTok) >>~ pushContext ("Doxygen","SL_Tag2ndWord")) <|> ((pRegExpr regex_'5cS >>= withAttribute KeywordTok)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","SL_TagWordWord")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Doxygen","SL_Tag2ndWord") = (((pDetectSpaces >>= withAttribute CommentTok)) <|> ((pRegExpr regex_'5cS'28'3f'3d'28'5b'5d'5b'2c'3f'3b'28'29'5d'7c'5c'2e'24'7c'5c'2e'3f'5cs'29'29 >>= withAttribute KeywordTok) >>~ (popContext >> popContext)) <|> ((pRegExpr regex_'5cS >>= withAttribute KeywordTok)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","SL_Tag2ndWord")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Doxygen","SL_TagString") = (((pDetectSpaces >>= withAttribute CommentTok)) <|> ((pString False "" >>= withAttribute CommentTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","SL_htmlcomment")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Doxygen","SL_identifiers") = (((pRegExpr regex_'5cs'2a'23'3f'5ba'2dzA'2dZ0'2d9'5d'2a >>= withAttribute NormalTok) >>~ (popContext)) <|> ((pDetectChar False '\'' >>= withAttribute DataTypeTok) >>~ pushContext ("Doxygen","SL_types1")) <|> ((pDetectChar False '"' >>= withAttribute DataTypeTok) >>~ pushContext ("Doxygen","SL_types2")) <|> (currentContext >>= \x -> guard (x == ("Doxygen","SL_identifiers")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Doxygen","SL_types1") = (((pDetectChar False '\'' >>= withAttribute DataTypeTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","SL_types1")) >> pDefault >>= withAttribute DataTypeTok)) parseRules ("Doxygen","SL_types2") = (((pDetectChar False '"' >>= withAttribute DataTypeTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","SL_types2")) >> pDefault >>= withAttribute DataTypeTok)) parseRules ("Doxygen","SL_DetectEnv") = (((pRegExpr regex_'5b'40'5c'5c'5dcode'5cb >>= withAttribute KeywordTok) >>~ pushContext ("Doxygen","Code")) <|> ((pRegExpr regex_'5b'40'5c'5c'5dverbatim'5cb >>= withAttribute KeywordTok) >>~ pushContext ("Doxygen","Verbatim")) <|> ((pRegExpr regex_'5b'40'5c'5c'5df'5c'5b >>= withAttribute KeywordTok) >>~ pushContext ("Doxygen","Formula")) <|> ((pRegExpr regex_'5b'40'5c'5c'5dmsc'5cb >>= withAttribute KeywordTok) >>~ pushContext ("Doxygen","Msc")) <|> ((pRegExpr regex_'5b'40'5c'5c'5ddot'5cb >>= withAttribute KeywordTok) >>~ pushContext ("Doxygen","Dot")) <|> ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}" list_Note >>= withAttribute KeywordTok)) <|> ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}" list_Warning >>= withAttribute KeywordTok)) <|> ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}" list_Attention >>= withAttribute KeywordTok)) <|> ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}" list_Todo >>= withAttribute KeywordTok)) <|> ((pRegExpr regex_'26'5bA'2dZa'2dz'5d'2b'3b >>= withAttribute OtherTok)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","SL_DetectEnv")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Doxygen","SL_DetectComment") = (((pDetect2Chars False '*' '/' >>= withAttribute CommentTok) >>~ (popContext >> popContext)) <|> ((pDetectChar False '*' >>= withAttribute CommentTok)) <|> ((pString False "///" >>= withAttribute CommentTok)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","SL_DetectComment")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Doxygen","Code") = (((parseRules ("Doxygen","SL_DetectComment"))) <|> ((pRegExpr regex_'5b'40'5c'5c'5dendcode'5cb >>= withAttribute KeywordTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","Code")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Doxygen","Verbatim") = (((parseRules ("Doxygen","SL_DetectComment"))) <|> ((pRegExpr regex_'5b'40'5c'5c'5dendverbatim'5cb >>= withAttribute KeywordTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","Verbatim")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Doxygen","Formula") = (((parseRules ("Doxygen","SL_DetectComment"))) <|> ((pRegExpr regex_'5b'40'5c'5c'5df'5c'5d >>= withAttribute KeywordTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","Formula")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Doxygen","Msc") = (((parseRules ("Doxygen","SL_DetectComment"))) <|> ((pRegExpr regex_'5b'40'5c'5c'5dendmsc'5cb >>= withAttribute KeywordTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","Msc")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Doxygen","Dot") = (((parseRules ("Doxygen","SL_DetectComment"))) <|> ((pRegExpr regex_'5b'40'5c'5c'5denddot'5cb >>= withAttribute KeywordTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Doxygen","Dot")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Alerts", _) = Text.Highlighting.Kate.Syntax.Alert.parseExpression parseRules x = parseRules ("Doxygen","Normal") <|> fail ("Unknown context" ++ show x)