{- This module was generated from data in the Kate syntax highlighting file rhtml.xml, version 1.01, by Richard Dale rdale@foton.es -} module Text.Highlighting.Kate.Syntax.Rhtml (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 = "Ruby/Rails/RHTML" -- | Filename extensions for this language. syntaxExtensions :: String syntaxExtensions = "*.rhtml;*.html.erb" -- | 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 = [("Ruby/Rails/RHTML","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 ("Ruby/Rails/RHTML","Start") -> return () ("Ruby/Rails/RHTML","FindHTML") -> return () ("Ruby/Rails/RHTML","FindEntityRefs") -> return () ("Ruby/Rails/RHTML","FindPEntityRefs") -> return () ("Ruby/Rails/RHTML","FindAttributes") -> return () ("Ruby/Rails/RHTML","FindDTDRules") -> return () ("Ruby/Rails/RHTML","Comment") -> return () ("Ruby/Rails/RHTML","CDATA") -> return () ("Ruby/Rails/RHTML","PI") -> return () ("Ruby/Rails/RHTML","Doctype") -> return () ("Ruby/Rails/RHTML","Doctype Internal Subset") -> return () ("Ruby/Rails/RHTML","Doctype Markupdecl") -> return () ("Ruby/Rails/RHTML","Doctype Markupdecl DQ") -> return () ("Ruby/Rails/RHTML","Doctype Markupdecl SQ") -> return () ("Ruby/Rails/RHTML","El Open") -> return () ("Ruby/Rails/RHTML","El Close") -> return () ("Ruby/Rails/RHTML","El Close 2") -> return () ("Ruby/Rails/RHTML","El Close 3") -> return () ("Ruby/Rails/RHTML","CSS") -> return () ("Ruby/Rails/RHTML","CSS content") -> return () ("Ruby/Rails/RHTML","JS") -> return () ("Ruby/Rails/RHTML","JS content") -> return () ("Ruby/Rails/RHTML","JS comment close") -> (popContext) >> pEndLine ("Ruby/Rails/RHTML","Value") -> return () ("Ruby/Rails/RHTML","Value NQ") -> (popContext >> popContext) >> pEndLine ("Ruby/Rails/RHTML","Value DQ") -> return () ("Ruby/Rails/RHTML","Value SQ") -> return () ("Ruby/Rails/RHTML","rubysourceline") -> (popContext) >> pEndLine ("Ruby/Rails/RHTML","rubysource") -> return () ("Ruby/Rails/RHTML","Line Continue") -> (popContext) >> pEndLine ("Ruby/Rails/RHTML","Quoted String") -> return () ("Ruby/Rails/RHTML","Apostrophed String") -> return () ("Ruby/Rails/RHTML","Command String") -> return () ("Ruby/Rails/RHTML","Embedded documentation") -> return () ("Ruby/Rails/RHTML","RegEx 1") -> return () ("Ruby/Rails/RHTML","Subst") -> return () ("Ruby/Rails/RHTML","Short Subst") -> (popContext) >> pEndLine ("Ruby/Rails/RHTML","Member Access") -> (popContext) >> pEndLine ("Ruby/Rails/RHTML","Comment Line") -> (popContext) >> pEndLine ("Ruby/Rails/RHTML","General Comment") -> (popContext) >> pEndLine ("Ruby/Rails/RHTML","RDoc Label") -> (popContext) >> pEndLine ("Ruby/Rails/RHTML","find_heredoc") -> (popContext) >> pEndLine ("Ruby/Rails/RHTML","find_indented_heredoc") -> (popContext) >> pEndLine ("Ruby/Rails/RHTML","indented_heredoc") -> return () ("Ruby/Rails/RHTML","apostrophed_indented_heredoc") -> return () ("Ruby/Rails/RHTML","normal_heredoc") -> return () ("Ruby/Rails/RHTML","apostrophed_normal_heredoc") -> return () ("Ruby/Rails/RHTML","heredoc_rules") -> return () ("Ruby/Rails/RHTML","find_gdl_input") -> (popContext) >> pEndLine ("Ruby/Rails/RHTML","gdl_dq_string_1") -> return () ("Ruby/Rails/RHTML","gdl_dq_string_1_nested") -> return () ("Ruby/Rails/RHTML","gdl_dq_string_2") -> return () ("Ruby/Rails/RHTML","gdl_dq_string_2_nested") -> return () ("Ruby/Rails/RHTML","gdl_dq_string_3") -> return () ("Ruby/Rails/RHTML","gdl_dq_string_3_nested") -> return () ("Ruby/Rails/RHTML","gdl_dq_string_4") -> return () ("Ruby/Rails/RHTML","gdl_dq_string_4_nested") -> return () ("Ruby/Rails/RHTML","gdl_dq_string_5") -> return () ("Ruby/Rails/RHTML","dq_string_rules") -> return () ("Ruby/Rails/RHTML","gdl_token_array_1") -> return () ("Ruby/Rails/RHTML","gdl_token_array_1_nested") -> return () ("Ruby/Rails/RHTML","gdl_token_array_2") -> return () ("Ruby/Rails/RHTML","gdl_token_array_2_nested") -> return () ("Ruby/Rails/RHTML","gdl_token_array_3") -> return () ("Ruby/Rails/RHTML","gdl_token_array_3_nested") -> return () ("Ruby/Rails/RHTML","gdl_token_array_4") -> return () ("Ruby/Rails/RHTML","gdl_token_array_4_nested") -> return () ("Ruby/Rails/RHTML","gdl_token_array_5") -> return () ("Ruby/Rails/RHTML","token_array_rules") -> return () ("Ruby/Rails/RHTML","gdl_apostrophed_1") -> return () ("Ruby/Rails/RHTML","gdl_apostrophed_1_nested") -> return () ("Ruby/Rails/RHTML","gdl_apostrophed_2") -> return () ("Ruby/Rails/RHTML","gdl_apostrophed_2_nested") -> return () ("Ruby/Rails/RHTML","gdl_apostrophed_3") -> return () ("Ruby/Rails/RHTML","gdl_apostrophed_3_nested") -> return () ("Ruby/Rails/RHTML","gdl_apostrophed_4") -> return () ("Ruby/Rails/RHTML","gdl_apostrophed_4_nested") -> return () ("Ruby/Rails/RHTML","gdl_apostrophed_5") -> return () ("Ruby/Rails/RHTML","apostrophed_rules") -> return () ("Ruby/Rails/RHTML","gdl_shell_command_1") -> return () ("Ruby/Rails/RHTML","gdl_shell_command_1_nested") -> return () ("Ruby/Rails/RHTML","gdl_shell_command_2") -> return () ("Ruby/Rails/RHTML","gdl_shell_command_2_nested") -> return () ("Ruby/Rails/RHTML","gdl_shell_command_3") -> return () ("Ruby/Rails/RHTML","gdl_shell_command_3_nested") -> return () ("Ruby/Rails/RHTML","gdl_shell_command_4") -> return () ("Ruby/Rails/RHTML","gdl_shell_command_4_nested") -> return () ("Ruby/Rails/RHTML","gdl_shell_command_5") -> return () ("Ruby/Rails/RHTML","shell_command_rules") -> return () ("Ruby/Rails/RHTML","gdl_regexpr_1") -> return () ("Ruby/Rails/RHTML","gdl_regexpr_1_nested") -> return () ("Ruby/Rails/RHTML","gdl_regexpr_2") -> return () ("Ruby/Rails/RHTML","gdl_regexpr_2_nested") -> return () ("Ruby/Rails/RHTML","gdl_regexpr_3") -> return () ("Ruby/Rails/RHTML","gdl_regexpr_3_nested") -> return () ("Ruby/Rails/RHTML","gdl_regexpr_4") -> return () ("Ruby/Rails/RHTML","gdl_regexpr_4_nested") -> return () ("Ruby/Rails/RHTML","gdl_regexpr_5") -> return () ("Ruby/Rails/RHTML","regexpr_rules") -> return () ("Ruby/Rails/RHTML","DATA") -> 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_keywords = Set.fromList $ words $ "BEGIN END and begin break case defined? do else elsif end ensure for if in include next not or redo rescue retry return then unless until when while yield" list_access'2dcontrol = Set.fromList $ words $ "private_class_method private protected public_class_method public" list_attribute'2ddefinitions = Set.fromList $ words $ "attr_reader attr_writer attr_accessor" list_definitions = Set.fromList $ words $ "alias module class def undef" list_pseudo'2dvariables = Set.fromList $ words $ "self super nil false true caller __FILE__ __LINE__" list_default'2dglobals = Set.fromList $ words $ "$stdout $defout $stderr $deferr $stdin" list_kernel'2dmethods = Set.fromList $ words $ "abort at_exit autoload autoload? binding block_given? callcc caller catch chomp chomp! chop chop! eval exec exit exit! fail fork format getc gets global_variables gsub gsub! iterator? lambda load local_variables loop method_missing open p print printf proc putc puts raise rand readline readlines require scan select set_trace_func sleep split sprintf srand sub sub! syscall system test throw trace_var trap untrace_var warn auto_complete_field auto_complete_result auto_discovery_link_tag auto_link benchmark button_to cache capture check_box check_box_tag collection_select concat content_for content_tag country_options_for_select country_select current_page? date_select datetime_select debug define_javascript_functions distance_of_time_in_words distance_of_time_in_words_to_now draggable_element drop_receiving_element end_form_tag error_message_on error_messages_for escape_javascript evaluate_remote_response excerpt file_field file_field_tag finish_upload_status form form_remote_tag form_tag form_tag_with_upload_progress h hidden_field hidden_field_tag highlight human_size image_path image_submit_tag image_tag input javascript_include_tag javascript_path javascript_tag link_image_to link_to link_to_function link_to_if link_to_image link_to_remote link_to_unless link_to_unless_current mail_to markdown number_to_currency number_to_human_size number_to_percentage number_to_phone number_with_delimiter number_with_precision observe_field observe_form option_groups_from_collection_for_select options_for_select options_from_collection_for_select pagination_links password_field password_field_tag periodically_call_remote pluralize radio_button radio_button_tag register_template_handler render render_file render_template sanitize select select_date select_datetime select_day select_hour select_minute select_month select_second select_tag select_time select_year simple_format sortable_element start_form_tag strip_links stylesheet_link_tag stylesheet_path submit_tag submit_to_remote tag text_area text_area_tag text_field text_field_tag text_field_with_auto_complete textilize textilize_without_paragraph time_ago_in_words time_zone_options_for_select time_zone_select truncate update_element_function upload_progress_status upload_progress_text upload_progress_update_bar_js upload_status_progress_bar_tag upload_status_tag upload_status_text_tag url_for visual_effect word_wrap" list_attention = Set.fromList $ words $ "TODO FIXME NOTE" regex_'3c'25'3d'3f = compileRegex "<%=?" 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]" regex_'2d'3f'25'3e = compileRegex "-?%>" regex_'5f'5fEND'5f'5f'24 = compileRegex "__END__$" regex_'23'21'5c'2f'2e'2a = compileRegex "#!\\/.*" regex_'28'5c'3d'7c'5c'28'7c'5c'5b'7c'5c'7b'29'5cs'2a'28if'7cunless'7cwhile'7cuntil'29'5cb = compileRegex "(\\=|\\(|\\[|\\{)\\s*(if|unless|while|until)\\b" regex_'28while'7cuntil'29'5cb'28'3f'21'2e'2a'5cbdo'5cb'29 = compileRegex "(while|until)\\b(?!.*\\bdo\\b)" regex_'5c'3b'5cs'2a'28while'7cuntil'29'5cb'28'3f'21'2e'2a'5cbdo'5cb'29 = compileRegex "\\;\\s*(while|until)\\b(?!.*\\bdo\\b)" regex_'28if'7cunless'29'5cb = compileRegex "(if|unless)\\b" regex_'5c'3b'5cs'2a'28if'7cunless'29'5cb = compileRegex "\\;\\s*(if|unless)\\b" regex_'5cbclass'5cb = compileRegex "\\bclass\\b" regex_'5cbmodule'5cb = compileRegex "\\bmodule\\b" regex_'5cbbegin'5cb = compileRegex "\\bbegin\\b" regex_'5cbfor'5cb'28'3f'21'2e'2a'5cbdo'5cb'29 = compileRegex "\\bfor\\b(?!.*\\bdo\\b)" regex_'5cbcase'5cb = compileRegex "\\bcase\\b" regex_'5cbdo'5cb = compileRegex "\\bdo\\b" regex_'5cbdef'5cb = compileRegex "\\bdef\\b" regex_'5cbend'5cb = compileRegex "\\bend\\b" regex_'28'5cb'7c'5e'5cs'2a'29'28else'7celsif'7crescue'7censure'29'28'5cs'2b'7c'24'29 = compileRegex "(\\b|^\\s*)(else|elsif|rescue|ensure)(\\s+|$)" regex_'5c'2e'5b'5fa'2dz'5d'5b'5fa'2dzA'2dZ0'2d9'5d'2a'28'5c'3f'7c'5c'21'7c'5cb'29 = compileRegex "\\.[_a-z][_a-zA-Z0-9]*(\\?|\\!|\\b)" regex_'5cs'5c'3f'28'5c'5cM'5c'2d'29'3f'28'5c'5cC'5c'2d'29'3f'5c'5c'3f'5cS = compileRegex "\\s\\?(\\\\M\\-)?(\\\\C\\-)?\\\\?\\S" regex_'5c'24'5ba'2dzA'2dZ'5f0'2d9'5d'2b = compileRegex "\\$[a-zA-Z_0-9]+" regex_'5c'24'5c'2d'5ba'2dzA'2dz'5f'5d'5cb = compileRegex "\\$\\-[a-zA-z_]\\b" regex_'5c'24'5b'5cd'5f'2a'60'5c'21'3a'3f'27'2f'5c'5c'5c'2d'5c'26'5d = compileRegex "\\$[\\d_*`\\!:?'/\\\\\\-\\&]" regex_'5cb'5b'5fA'2dZ'5d'2b'5bA'2dZ'5f0'2d9'5d'2b'5cb = compileRegex "\\b[_A-Z]+[A-Z_0-9]+\\b" regex_'5cb'5bA'2dZ'5d'2b'5f'2a'28'5b0'2d9'5d'7c'5ba'2dz'5d'29'5b'5fa'2dzA'2dZ0'2d9'5d'2a'5cb = compileRegex "\\b[A-Z]+_*([0-9]|[a-z])[_a-zA-Z0-9]*\\b" regex_'5cb'5c'2d'3f0'5bxX'5d'5b'5f0'2d9a'2dfA'2dF'5d'2b = compileRegex "\\b\\-?0[xX][_0-9a-fA-F]+" regex_'5cb'5c'2d'3f0'5bbB'5d'5b'5f01'5d'2b = compileRegex "\\b\\-?0[bB][_01]+" regex_'5cb'5c'2d'3f0'5b1'2d7'5d'5b'5f0'2d7'5d'2a = compileRegex "\\b\\-?0[1-7][_0-7]*" regex_'5cb'5c'2d'3f'5b0'2d9'5d'5b0'2d9'5f'5d'2a'5c'2e'5b0'2d9'5d'5b0'2d9'5f'5d'2a'28'5beE'5d'5c'2d'3f'5b1'2d9'5d'5b0'2d9'5d'2a'28'5c'2e'5b0'2d9'5d'2a'29'3f'29'3f = compileRegex "\\b\\-?[0-9][0-9_]*\\.[0-9][0-9_]*([eE]\\-?[1-9][0-9]*(\\.[0-9]*)?)?" regex_'5cb'5c'2d'3f'5b1'2d9'5d'5b0'2d9'5f'5d'2a'5cb = compileRegex "\\b\\-?[1-9][0-9_]*\\b" regex_'5cs'2a'3c'3c'2d'28'3f'3d'5cw'2b'7c'5b'22'27'5d'29 = compileRegex "\\s*<<-(?=\\w+|[\"'])" regex_'5cs'2a'3c'3c'28'3f'3d'5cw'2b'7c'5b'22'27'5d'29 = compileRegex "\\s*<<(?=\\w+|[\"'])" regex_'5cs'5b'5c'3f'5c'3a'5c'25'2f'5d'5cs = compileRegex "\\s[\\?\\:\\%/]\\s" regex_'5b'7c'26'3c'3e'5c'5e'5c'2b'2a'7e'5c'2d'3d'5d'2b = compileRegex "[|&<>\\^\\+*~\\-=]+" regex_'5cs'21 = compileRegex "\\s!" regex_'2f'3d'5cs = compileRegex "/=\\s" regex_'3a'5ba'2dzA'2dZ'5f'5d'5ba'2dzA'2dZ0'2d9'5f'5d'2a = compileRegex ":[a-zA-Z_][a-zA-Z0-9_]*" regex_'23'5cs'2aBEGIN'2e'2a'24 = compileRegex "#\\s*BEGIN.*$" regex_'23'5cs'2aEND'2e'2a'24 = compileRegex "#\\s*END.*$" regex_'23 = compileRegex "#" regex_'5cs'23 = compileRegex "\\s#" regex_'5b'5c'5b'5c'5d'5d'2b = compileRegex "[\\[\\]]+" regex_'40'5ba'2dzA'2dZ'5f0'2d9'5d'2b = compileRegex "@[a-zA-Z_0-9]+" regex_'40'40'5ba'2dzA'2dZ'5f0'2d9'5d'2b = compileRegex "@@[a-zA-Z_0-9]+" regex_'5cs'2a'5b'25'5d'28'3f'3d'5bQqxw'5d'3f'5b'5e'5cs'3e'5d'29 = compileRegex "\\s*[%](?=[Qqxw]?[^\\s>])" regex_'5c'5c'5c'22 = compileRegex "\\\\\\\"" regex_'23'40'7b1'2c2'7d = compileRegex "#@{1,2}" regex_'5c'5c'5c'27 = compileRegex "\\\\\\'" regex_'5c'5c'5c'60 = compileRegex "\\\\\\`" regex_'5c'5c'5c'2f = compileRegex "\\\\\\/" regex_'5b'5e'5c'5c'5d'24 = compileRegex "[^\\\\]$" regex_'2f'5buiomxn'5d'2a = compileRegex "/[uiomxn]*" regex_'5cw'28'3f'21'5cw'29 = compileRegex "\\w(?!\\w)" regex_'5c'2e'3f'5b'5fa'2dz'5d'5cw'2a'28'5c'3f'7c'5c'21'29'3f'28'3f'3d'5b'5e'5cw'5cd'5c'2e'5c'3a'5d'29 = compileRegex "\\.?[_a-z]\\w*(\\?|\\!)?(?=[^\\w\\d\\.\\:])" regex_'5c'2e'3f'5b'5fa'2dz'5d'5cw'2a'28'5c'3f'7c'5c'21'29'3f = compileRegex "\\.?[_a-z]\\w*(\\?|\\!)?" regex_'5bA'2dZ'5d'2b'5f'2a'28'5cd'7c'5ba'2dz'5d'29'5cw'2a'28'3f'3d'5b'5e'5cw'5cd'5c'2e'5c'3a'5d'29 = compileRegex "[A-Z]+_*(\\d|[a-z])\\w*(?=[^\\w\\d\\.\\:])" regex_'5bA'2dZ'5d'2b'5f'2a'28'5b0'2d9'5d'7c'5ba'2dz'5d'29'5cw'2a = compileRegex "[A-Z]+_*([0-9]|[a-z])\\w*" regex_'5b'5fA'2dZ'5d'5b'5fA'2dZ0'2d9'5d'2a'28'3f'3d'5b'5e'5cw'5cd'5c'2e'5c'3a'5d'29 = compileRegex "[_A-Z][_A-Z0-9]*(?=[^\\w\\d\\.\\:])" regex_'5b'5fA'2dZ'5d'5b'5fA'2dZ0'2d9'5d'2a = compileRegex "[_A-Z][_A-Z0-9]*" regex_'5cW = compileRegex "\\W" regex_'5cw'5c'3a'5c'3a'5cs = compileRegex "\\w\\:\\:\\s" regex_'27'28'5cw'2b'29'27 = compileRegex "'(\\w+)'" regex_'22'3f'28'5cw'2b'29'22'3f = compileRegex "\"?(\\w+)\"?" regex_w'5c'28 = compileRegex "w\\(" regex_w'5c'7b = compileRegex "w\\{" regex_w'5c'5b = compileRegex "w\\[" regex_w'3c = compileRegex "w<" regex_w'28'5b'5e'5cs'5cw'5d'29 = compileRegex "w([^\\s\\w])" regex_q'5c'28 = compileRegex "q\\(" regex_q'5c'7b = compileRegex "q\\{" regex_q'5c'5b = compileRegex "q\\[" regex_q'3c = compileRegex "q<" regex_q'28'5b'5e'5cs'5cw'5d'29 = compileRegex "q([^\\s\\w])" regex_x'5c'28 = compileRegex "x\\(" regex_x'5c'7b = compileRegex "x\\{" regex_x'5c'5b = compileRegex "x\\[" regex_x'3c = compileRegex "x<" regex_x'28'5b'5e'5cs'5cw'5d'29 = compileRegex "x([^\\s\\w])" regex_r'5c'28 = compileRegex "r\\(" regex_r'5c'7b = compileRegex "r\\{" regex_r'5c'5b = compileRegex "r\\[" regex_r'3c = compileRegex "r<" regex_r'28'5b'5e'5cs'5cw'5d'29 = compileRegex "r([^\\s\\w])" regex_Q'3f'5c'28 = compileRegex "Q?\\(" regex_Q'3f'5c'7b = compileRegex "Q?\\{" regex_Q'3f'5c'5b = compileRegex "Q?\\[" regex_Q'3f'3c = compileRegex "Q?<" regex_Q'3f'28'5b'5e'5cs'5cw'5d'29 = compileRegex "Q?([^\\s\\w])" regex_'5c'29'5buiomxn'5d'2a = compileRegex "\\)[uiomxn]*" regex_'5c'7d'5buiomxn'5d'2a = compileRegex "\\}[uiomxn]*" regex_'5c'5d'5buiomxn'5d'2a = compileRegex "\\][uiomxn]*" regex_'3e'5buiomxn'5d'2a = compileRegex ">[uiomxn]*" parseRules ("Ruby/Rails/RHTML","Start") = (((parseRules ("Ruby/Rails/RHTML","FindHTML"))) <|> (currentContext >>= \x -> guard (x == ("Ruby/Rails/RHTML","Start")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Ruby/Rails/RHTML","FindHTML") = (((pDetectSpaces >>= withAttribute NormalTok)) <|> ((pDetectIdentifier >>= withAttribute NormalTok)) <|> ((pRegExpr regex_'3c'25'3d'3f >>= withAttribute KeywordTok) >>~ pushContext ("Ruby/Rails/RHTML","rubysource")) <|> ((pString False "%" >>= withAttribute KeywordTok) >>~ pushContext ("Ruby/Rails/RHTML","rubysourceline")) <|> ((pString False "" >>= withAttribute CommentTok) >>~ (popContext)) <|> ((pRegExpr regex_'2d'28'2d'28'3f'21'2d'3e'29'29'2b >>= withAttribute ErrorTok)) <|> (currentContext >>= \x -> guard (x == ("Ruby/Rails/RHTML","Comment")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Ruby/Rails/RHTML","CDATA") = (((pDetectSpaces >>= withAttribute NormalTok)) <|> ((pDetectIdentifier >>= withAttribute NormalTok)) <|> ((pString False "]]>" >>= withAttribute BaseNTok) >>~ (popContext)) <|> ((pString False "]]>" >>= withAttribute DecValTok)) <|> (currentContext >>= \x -> guard (x == ("Ruby/Rails/RHTML","CDATA")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Ruby/Rails/RHTML","PI") = (((pDetect2Chars False '?' '>' >>= withAttribute KeywordTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby/Rails/RHTML","PI")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Ruby/Rails/RHTML","Doctype") = (((pDetectChar False '>' >>= withAttribute DataTypeTok) >>~ (popContext)) <|> ((pDetectChar False '[' >>= withAttribute DataTypeTok) >>~ pushContext ("Ruby/Rails/RHTML","Doctype Internal Subset")) <|> (currentContext >>= \x -> guard (x == ("Ruby/Rails/RHTML","Doctype")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Ruby/Rails/RHTML","Doctype Internal Subset") = (((pDetectChar False ']' >>= withAttribute DataTypeTok) >>~ (popContext)) <|> ((parseRules ("Ruby/Rails/RHTML","FindDTDRules"))) <|> ((pString False "