{-# LANGUAGE OverloadedStrings #-} module Skylighting.Syntax.Sgml (syntax) where import Skylighting.Types syntax :: Syntax syntax = read $! "Syntax {sName = \"SGML\", sFilename = \"sgml.xml\", sShortname = \"Sgml\", sContexts = fromList [(\"Attribute\",Context {cName = \"Attribute\", cSyntax = \"SGML\", 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 = RegExpr (RE {reString = \"\\\\s*=\\\\s*\", reCaseSensitive = True}), rAttribute = NormalTok, rIncludeAttribute = False, rDynamic = False, rCaseSensitive = True, rChildren = [], rLookahead = False, rFirstNonspace = False, rColumn = Nothing, rContextSwitch = [Push (\"SGML\",\"Value\")]}], cAttribute = OtherTok, cLineEmptyContext = [], cLineEndContext = [], cLineBeginContext = [], cFallthrough = False, cFallthroughContext = [], cDynamic = False}),(\"Comment\",Context {cName = \"Comment\", cSyntax = \"SGML\", cRules = [Rule {rMatcher = StringDetect \"-->\", rAttribute = CommentTok, rIncludeAttribute = False, rDynamic = False, rCaseSensitive = True, rChildren = [], rLookahead = False, rFirstNonspace = False, rColumn = Nothing, rContextSwitch = [Pop]}], cAttribute = CommentTok, cLineEmptyContext = [], cLineEndContext = [], cLineBeginContext = [], cFallthrough = False, cFallthroughContext = [], cDynamic = False}),(\"Normal Text\",Context {cName = \"Normal Text\", cSyntax = \"SGML\", cRules = [Rule {rMatcher = StringDetect \"