{-# LANGUAGE OverloadedStrings #-} module Skylighting.Syntax.Monobasic (syntax) where import Skylighting.Types import Data.Map import Skylighting.Regex import qualified Data.Set syntax :: Syntax syntax = Syntax { sName = "MonoBasic" , sFilename = "monobasic.xml" , sShortname = "Monobasic" , sContexts = fromList [ ( "Comment" , Context { cName = "Comment" , cSyntax = "MonoBasic" , cRules = [] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Normal" , Context { cName = "Normal" , cSyntax = "MonoBasic" , cRules = [ Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "AddHandler" , "And" , "AndAlso" , "As" , "ByRef" , "ByVal" , "Call" , "Catch" , "Const" , "Declare" , "Default" , "Delegate" , "Dim" , "Else" , "Error" , "Event" , "Explicit" , "False" , "Finaly" , "Friend" , "Goto" , "Imports" , "Inherits" , "Me" , "MustInherit" , "MustOverride" , "MyBase" , "MyClass" , "New" , "Not" , "Nothing" , "NotInheritable" , "NotOverridable" , "On" , "Option" , "Optional" , "Or" , "OrElse" , "Overloads" , "Overrides" , "ParamArray" , "Private" , "Protected" , "Public" , "RaiseEvent" , "ReadOnly" , "Redim" , "Resume" , "Return" , "Shadows" , "Shared" , "Step" , "Strict" , "Then" , "Throw" , "To" , "True" , "When" , "WithEvents" , "WriteOnly" , "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 [ "Boolean" , "Byte" , "Char" , "Date" , "DateTime" , "Decimal" , "Double" , "Exception" , "Guid" , "Int16" , "Int32" , "Int64" , "Integer" , "IntPtr" , "Long" , "Object" , "ParamArray" , "Single" , "String" , "TimeSpan" ]) , rAttribute = DataTypeTok , 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 = [ Push ( "MonoBasic" , "String" ) ] } , Rule { rMatcher = DetectChar '\'' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "MonoBasic" , "Comment" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\b(Namespace)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(Namespace)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "End.Namespace.*$" , reCompiled = Just (compileRegex False "End.Namespace.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(Module)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(Module)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "End.Module.*$" , reCompiled = Just (compileRegex False "End.Module.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(Class)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(Class)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "End.Class.*$" , reCompiled = Just (compileRegex False "End.Class.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(Interface)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(Interface)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "End.Interface.*$" , reCompiled = Just (compileRegex False "End.Interface.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(Structure)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(Structure)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "End.Structure.*$" , reCompiled = Just (compileRegex False "End.Structure.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(Enum)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(Enum)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "End.Enum.*$" , reCompiled = Just (compileRegex False "End.Enum.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(Property)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(Property)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "End.Property.*$" , reCompiled = Just (compileRegex False "End.Property.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(Get)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(Get)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "End.Get.*$" , reCompiled = Just (compileRegex False "End.Get.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(Set)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(Set)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "End.Set.*$" , reCompiled = Just (compileRegex False "End.Set.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(Sub)([.\\s]|$)" , reCompiled = Just (compileRegex False "\\b(Sub)([.\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "End.Sub.*$" , reCompiled = Just (compileRegex False "End.Sub.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "Exit.Sub.*$" , reCompiled = Just (compileRegex False "Exit.Sub.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(Function)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(Function)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "End.Function.*$" , reCompiled = Just (compileRegex False "End.Function.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "Exit.Function.*$" , reCompiled = Just (compileRegex False "Exit.Function.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(Try)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(Try)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "End.Try.*$" , reCompiled = Just (compileRegex False "End.Try.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(If)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(If)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "End.If.*$" , reCompiled = Just (compileRegex False "End.If.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "Select.Case.*$" , reCompiled = Just (compileRegex False "Select.Case.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "End.Select.*$" , reCompiled = Just (compileRegex False "End.Select.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(For)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(For)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(Next)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(Next)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(Do)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(Do)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(Loop)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(Loop)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(While)([\\s]|$)" , reCompiled = Just (compileRegex False "\\b(While)([\\s]|$)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "End.While.*$" , reCompiled = Just (compileRegex False "End.While.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "Exit.While.*$" , reCompiled = Just (compileRegex False "Exit.While.*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "#Region.*$" , reCompiled = Just (compileRegex False "#Region.*$") , reCaseSensitive = False } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "#End.Region.*$" , reCompiled = Just (compileRegex False "#End.Region.*$") , reCaseSensitive = False } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "#If.*$" , reCompiled = Just (compileRegex False "#If.*$") , reCaseSensitive = False } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "#End.If.*$" , reCompiled = Just (compileRegex False "#End.If.*$") , reCaseSensitive = False } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "String" , Context { cName = "String" , cSyntax = "MonoBasic" , cRules = [ Rule { rMatcher = LineContinue , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = HlCStringChar , rAttribute = NormalTok , 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 = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) ] , sAuthor = "Davide Bettio (davide.bettio@kdemail.net)" , sVersion = "2" , sLicense = "GPL" , sExtensions = [ "*.vb" ] , sStartingContext = "Normal" }