{-# LANGUAGE OverloadedStrings #-} module Skylighting.Syntax.Asp (syntax) where import Skylighting.Types import Data.Map import Skylighting.Regex import qualified Data.Set syntax :: Syntax syntax = Syntax { sName = "ASP" , sFilename = "asp.xml" , sShortname = "Asp" , sContexts = fromList [ ( "asp_onelinecomment" , Context { cName = "asp_onelinecomment" , cSyntax = "ASP" , cRules = [ Rule { rMatcher = StringDetect "%>" , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "aspsource" , Context { cName = "aspsource" , cSyntax = "ASP" , cRules = [ Rule { rMatcher = StringDetect "%>" , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "<\\s*\\/\\s*script\\s*>" , reCompiled = Just (compileRegex False "<\\s*\\/\\s*script\\s*>") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = DetectChar '\'' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "ASP" , "asp_onelinecomment" ) ] } , Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "ASP" , "doublequotestring" ) ] } , Rule { rMatcher = DetectChar '\'' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "ASP" , "singlequotestring" ) ] } , Rule { rMatcher = DetectChar '&' , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "" , reCompiled = Just (compileRegex True "") , reCaseSensitive = True } , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "[0123456789]*\\.\\.\\.[0123456789]*" , reCompiled = Just (compileRegex True "[0123456789]*\\.\\.\\.[0123456789]*") , reCaseSensitive = True } , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = HlCOct , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = HlCHex , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Float , rAttribute = FloatTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Int , rAttribute = DecValTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = AnyChar ";()}{:,[]" , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet True []) , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\belseif\\b" , reCompiled = Just (compileRegex False "\\belseif\\b") , reCaseSensitive = False } , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\belse\\b" , reCompiled = Just (compileRegex False "\\belse\\b") , reCaseSensitive = False } , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bif\\b" , reCompiled = Just (compileRegex False "\\bif\\b") , reCaseSensitive = False } , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend if\\b" , reCompiled = Just (compileRegex False "\\bend if\\b") , reCaseSensitive = False } , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bexit function\\b" , reCompiled = Just (compileRegex False "\\bexit function\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bfunction\\b" , reCompiled = Just (compileRegex False "\\bfunction\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend function\\b" , reCompiled = Just (compileRegex False "\\bend function\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bexit sub\\b" , reCompiled = Just (compileRegex False "\\bexit sub\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bsub\\b" , reCompiled = Just (compileRegex False "\\bsub\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend sub\\b" , reCompiled = Just (compileRegex False "\\bend sub\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bclass\\b" , reCompiled = Just (compileRegex False "\\bclass\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend class\\b" , reCompiled = Just (compileRegex False "\\bend class\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bexit do\\b" , reCompiled = Just (compileRegex False "\\bexit do\\b") , reCaseSensitive = False } , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bdo(\\s+(while))?\\b" , reCompiled = Just (compileRegex False "\\bdo(\\s+(while))?\\b") , reCaseSensitive = False } , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bloop\\b" , reCompiled = Just (compileRegex False "\\bloop\\b") , reCaseSensitive = False } , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bexit while\\b" , reCompiled = Just (compileRegex False "\\bexit while\\b") , reCaseSensitive = False } , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bwhile\\b" , reCompiled = Just (compileRegex False "\\bwhile\\b") , reCaseSensitive = False } , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bwend\\b" , reCompiled = Just (compileRegex False "\\bwend\\b") , reCaseSensitive = False } , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bexit for\\b" , reCompiled = Just (compileRegex False "\\bexit for\\b") , reCaseSensitive = False } , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bfor\\b" , reCompiled = Just (compileRegex False "\\bfor\\b") , reCaseSensitive = False } , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bnext\\b" , reCompiled = Just (compileRegex False "\\bnext\\b") , reCaseSensitive = False } , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bselect case\\b" , reCompiled = Just (compileRegex False "\\bselect case\\b") , reCaseSensitive = False } , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend select\\b" , reCompiled = Just (compileRegex False "\\bend select\\b") , reCaseSensitive = False } , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "and" , "call" , "class" , "close" , "const" , "dim" , "eof" , "erase" , "execute" , "false" , "function" , "me" , "movenext" , "new" , "not" , "nothing" , "open" , "or" , "preserve" , "private" , "public" , "randomize" , "redim" , "set" , "sub" , "true" , "with" , "xor" ]) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "case" , "continue" , "do" , "each" , "else" , "elseif" , "end if" , "end select" , "exit" , "for" , "if" , "in" , "loop" , "next" , "select" , "then" , "to" , "until" , "wend" , "while" ]) , rAttribute = ControlFlowTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "abs" , "Add" , "AddFolders" , "array" , "asc" , "atn" , "BuildPath" , "cbool" , "cbyte" , "ccur" , "cdate" , "cdbl" , "chr" , "cint" , "Clear" , "clng" , "Close" , "cookies" , "Copy" , "CopyFile" , "CopyFolder" , "cos" , "CreateFolder" , "createobject" , "CreateTextFile" , "csng" , "cstr" , "date" , "dateadd" , "DateDiff" , "DatePart" , "DateSerial" , "DateValue" , "Day" , "Delete" , "DeleteFile" , "DeleteFolder" , "DriveExists" , "end" , "Exists" , "Exp" , "FileExists" , "Filter" , "Fix" , "FolderExists" , "form" , "FormatCurrency" , "FormatDateTime" , "FormatNumber" , "FormatPercent" , "GetAbsolutePathName" , "GetBaseName" , "GetDrive" , "GetDriveName" , "GetExtensionName" , "GetFile" , "GetFileName" , "GetFolder" , "GetObject" , "GetParentFolderName" , "GetSpecialFolder" , "GetTempName" , "Hex" , "Hour" , "InputBox" , "InStr" , "InStrRev" , "Int" , "IsArray" , "IsDate" , "IsEmpty" , "IsNull" , "IsNumeric" , "IsObject" , "item" , "Items" , "Join" , "Keys" , "LBound" , "LCase" , "Left" , "Len" , "LoadPicture" , "Log" , "LTrim" , "Mid" , "Minute" , "Month" , "MonthName" , "Move" , "MoveFile" , "MoveFolder" , "MsgBox" , "Now" , "Oct" , "OpenAsTextStream" , "OpenTextFile" , "querystring" , "Raise" , "Read" , "ReadAll" , "ReadLine" , "redirect" , "Remove" , "RemoveAll" , "Replace" , "request" , "response" , "RGB" , "Right" , "Rnd" , "Round" , "RTrim" , "ScriptEngine" , "ScriptEngineBuildVersion" , "ScriptEngineMajorVersion" , "ScriptEngineMinorVersion" , "Second" , "server" , "servervariables" , "session" , "Sgn" , "Sin" , "Skip" , "SkipLine" , "Space" , "Split" , "Sqr" , "StrComp" , "String" , "StrReverse" , "Tan" , "Time" , "Timer" , "TimeSerial" , "TimeValue" , "Trim" , "TypeName" , "UBound" , "UCase" , "VarType" , "Weekday" , "WeekdayName" , "write" , "WriteBlankLines" , "WriteLine" , "Year" ]) , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "doublequotestring" , Context { cName = "doublequotestring" , cSyntax = "ASP" , cRules = [ Rule { rMatcher = Detect2Chars '"' '"' , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\\\[0-7]{1,3}" , reCompiled = Just (compileRegex True "\\\\[0-7]{1,3}") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\\\x[0-9A-Fa-f]{1,2}" , reCompiled = Just (compileRegex True "\\\\x[0-9A-Fa-f]{1,2}") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "htmlcomment" , Context { cName = "htmlcomment" , cSyntax = "ASP" , cRules = [ Rule { rMatcher = StringDetect "<%" , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "ASP" , "aspsource" ) ] } , Rule { rMatcher = StringDetect "<%" , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "ASP" , "aspsource" ) ] } , Rule { rMatcher = StringDetect "-->" , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "\\s*=\\s*" , reCompiled = Just (compileRegex True "\\s*=\\s*") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "ASP" , "identifiers" ) ] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "htmltag" , Context { cName = "htmltag" , cSyntax = "ASP" , cRules = [ Rule { rMatcher = Detect2Chars '/' '>' , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = DetectChar '>' , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = StringDetect "<%" , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "ASP" , "aspsource" ) ] } , Rule { rMatcher = StringDetect "<%" , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "ASP" , "aspsource" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\s*=\\s*" , reCompiled = Just (compileRegex True "\\s*=\\s*") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "ASP" , "identifiers" ) ] } ] , cAttribute = OtherTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "identifiers" , Context { cName = "identifiers" , cSyntax = "ASP" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "\\s*#?[a-zA-Z0-9]*" , reCompiled = Just (compileRegex True "\\s*#?[a-zA-Z0-9]*") , reCaseSensitive = True } , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = DetectChar '\'' , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "ASP" , "types1" ) ] } , Rule { rMatcher = DetectChar '"' , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "ASP" , "types2" ) ] } ] , cAttribute = OtherTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "nosource" , Context { cName = "nosource" , cSyntax = "ASP" , cRules = [ Rule { rMatcher = StringDetect "<%" , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "ASP" , "aspsource" ) ] } , Rule { rMatcher = RegExpr RE { reString = "<\\s*script\\s*language=\"VBScript\"[^>]*>" , reCompiled = Just (compileRegex False "<\\s*script\\s*language=\"VBScript\"[^>]*>") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "ASP" , "aspsource" ) ] } , Rule { rMatcher = RegExpr RE { reString = "<\\s*script(\\s|>)" , reCompiled = Just (compileRegex False "<\\s*script(\\s|>)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "ASP" , "scripts" ) ] } , Rule { rMatcher = RegExpr RE { reString = "<\\s*\\/?\\s*[a-zA-Z_:][a-zA-Z0-9._:-]*" , reCompiled = Just (compileRegex True "<\\s*\\/?\\s*[a-zA-Z_:][a-zA-Z0-9._:-]*") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "ASP" , "htmltag" ) ] } , Rule { rMatcher = StringDetect "