{-# LANGUAGE OverloadedStrings #-} module Skylighting.Syntax.Clojure (syntax) where import Skylighting.Types import Data.Map import Skylighting.Regex import qualified Data.Set syntax :: Syntax syntax = Syntax { sName = "Clojure" , sFilename = "clojure.xml" , sShortname = "Clojure" , sContexts = fromList [ ( "Default" , Context { cName = "Default" , cSyntax = "Clojure" , cRules = [ Rule { rMatcher = RegExpr RE { reString = ";.*$" , reCompiled = Just (compileRegex True ";.*$") , reCaseSensitive = True } , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars '#' '_' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "[@~]\\S+" , reCompiled = Just (compileRegex True "[@~]\\S+") , reCaseSensitive = True } , rAttribute = AttributeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "::?[a-zA-Z0-9\\-]+" , reCompiled = Just (compileRegex True "::?[a-zA-Z0-9\\-]+") , reCaseSensitive = True } , rAttribute = AttributeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars '#' '{' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars '^' '{' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '{' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '}' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '[' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar ']' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars '#' '\'' , rAttribute = VariableTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n %&(),.;[]^{|}~" } (makeWordSet True [ "*" , "+" , "-" , "->" , "->>" , "." , ".." , "/" , "<" , "<=" , "=" , "==" , ">" , ">=" , "accessor" , "aclone" , "add-classpath" , "add-watcher" , "agent" , "agent-errors" , "aget" , "alength" , "alias" , "all-ns" , "alter" , "alter-meta!" , "alter-var-root" , "amap" , "ancestors" , "and" , "append-child" , "apply" , "apply-template" , "are" , "areduce" , "array-map" , "aset" , "aset-boolean" , "aset-byte" , "aset-char" , "aset-double" , "aset-float" , "aset-int" , "aset-long" , "aset-short" , "assert" , "assert-any" , "assert-expr" , "assert-predicate" , "assoc" , "assoc!" , "assoc-in" , "associative?" , "atom" , "atom?" , "attrs" , "await" , "await-for" , "await1" , "bases" , "bean" , "bigdec" , "bigint" , "binding" , "bit-and" , "bit-and-not" , "bit-clear" , "bit-flip" , "bit-not" , "bit-or" , "bit-set" , "bit-shift-left" , "bit-shift-right" , "bit-test" , "bit-xor" , "boolean" , "boolean-array" , "booleans" , "bound-fn" , "bound-fn*" , "branch?" , "butlast" , "byte" , "byte-array" , "bytes" , "case" , "cast" , "catch" , "char" , "char-array" , "char-escape-string" , "char-name-string" , "char?" , "chars" , "children" , "chunk" , "chunk-append" , "chunk-buffer" , "chunk-cons" , "chunk-first" , "chunk-next" , "chunk-rest" , "chunked-seq?" , "class" , "class?" , "clear-agent-errors" , "clojure-version" , "coll?" , "collection-tag" , "comment" , "commute" , "comp" , "comparator" , "compare" , "compare-and-set!" , "compile" , "complement" , "compose-fixtures" , "concat" , "cond" , "condp" , "conj" , "conj!" , "cons" , "constantly" , "construct-proxy" , "contains?" , "content" , "content-handler" , "count" , "counted?" , "create-ns" , "create-struct" , "cycle" , "dec" , "decimal?" , "declare" , "delay" , "delay?" , "deliver" , "deref" , "derive" , "descendants" , "destructure" , "difference" , "disj" , "disj!" , "dissoc" , "dissoc!" , "distinct" , "distinct?" , "do" , "do-template" , "doall" , "doc" , "dorun" , "doseq" , "dosync" , "dotimes" , "doto" , "double" , "double-array" , "doubles" , "down" , "drop" , "drop-last" , "drop-while" , "e" , "edit" , "element" , "emit" , "emit-element" , "empty" , "empty?" , "end?" , "ensure" , "enumeration-seq" , "eval" , "even?" , "every?" , "extend" , "extend-protocol" , "extend-type" , "extenders" , "extends?" , "false?" , "ffirst" , "file-position" , "file-seq" , "filter" , "finally" , "find" , "find-doc" , "find-ns" , "find-var" , "first" , "float" , "float-array" , "float?" , "floats" , "flush" , "fn" , "fn?" , "fnext" , "for" , "force" , "format" , "function?" , "future" , "future-call" , "future-cancel" , "future-cancelled?" , "future-done?" , "future?" , "gen-and-load-class" , "gen-and-save-class" , "gen-class" , "gen-interface" , "gensym" , "get" , "get-child" , "get-child-count" , "get-in" , "get-method" , "get-possibly-unbound-var" , "get-proxy-class" , "get-thread-bindings" , "get-validator" , "handle" , "handler-case" , "hash" , "hash-map" , "hash-set" , "identical?" , "identity" , "if" , "if-let" , "if-not" , "ifn?" , "import" , "in-ns" , "inc" , "inc-report-counter" , "index" , "init-proxy" , "insert-child" , "insert-left" , "insert-right" , "inspect" , "inspect-table" , "inspect-tree" , "instance?" , "int" , "int-array" , "integer?" , "interleave" , "intern" , "interpose" , "intersection" , "into" , "into-array" , "ints" , "io!" , "is" , "is-leaf" , "isa?" , "iterate" , "iterator-seq" , "join" , "join-fixtures" , "juxt" , "key" , "keys" , "keyword" , "keyword?" , "keywordize-keys" , "last" , "lazy-cat" , "lazy-seq" , "left" , "leftmost" , "lefts" , "let" , "letfn" , "line-seq" , "list" , "list*" , "list-model" , "list-provider" , "list?" , "load" , "load-file" , "load-reader" , "load-script" , "load-string" , "loaded-libs" , "locking" , "long" , "long-array" , "longs" , "loop" , "macroexpand" , "macroexpand-1" , "macroexpand-all" , "main" , "make-array" , "make-hierarchy" , "make-node" , "map" , "map-invert" , "map?" , "mapcat" , "max" , "max-key" , "memfn" , "memoize" , "merge" , "merge-with" , "meta" , "method-sig" , "methods" , "min" , "min-key" , "mod" , "name" , "namespace" , "neg?" , "newline" , "next" , "nfirst" , "nil?" , "nnext" , "node" , "not" , "not-any?" , "not-empty" , "not-every?" , "not=" , "ns" , "ns-aliases" , "ns-imports" , "ns-interns" , "ns-map" , "ns-name" , "ns-publics" , "ns-refers" , "ns-resolve" , "ns-unalias" , "ns-unmap" , "nth" , "nthnext" , "num" , "number?" , "odd?" , "or" , "parents" , "partial" , "partition" , "path" , "pcalls" , "peek" , "persistent!" , "pmap" , "pop" , "pop!" , "pop-thread-bindings" , "pos?" , "postwalk" , "postwalk-demo" , "postwalk-replace" , "pr" , "pr-str" , "prefer-method" , "prefers" , "prev" , "prewalk" , "prewalk-demo" , "prewalk-replace" , "primitives-classnames" , "print" , "print-cause-trace" , "print-ctor" , "print-doc" , "print-dup" , "print-method" , "print-namespace-doc" , "print-simple" , "print-special-doc" , "print-stack-trace" , "print-str" , "print-throwable" , "print-trace-element" , "printf" , "println" , "println-str" , "prn" , "prn-str" , "project" , "promise" , "proxy" , "proxy-call-with-super" , "proxy-mappings" , "proxy-name" , "proxy-super" , "push-thread-bindings" , "pvalues" , "quot" , "rand" , "rand-int" , "range" , "ratio?" , "rational?" , "rationalize" , "re-find" , "re-groups" , "re-matcher" , "re-matches" , "re-pattern" , "re-seq" , "read" , "read-line" , "read-string" , "recur" , "reduce" , "ref" , "ref-history-count" , "ref-max-history" , "ref-min-history" , "ref-set" , "refer" , "refer-clojure" , "reify" , "release-pending-sends" , "rem" , "remove" , "remove-method" , "remove-ns" , "remove-watcher" , "rename" , "rename-keys" , "repeat" , "repeatedly" , "repl" , "repl-caught" , "repl-exception" , "repl-prompt" , "repl-read" , "replace" , "replicate" , "report" , "require" , "reset!" , "reset-meta!" , "resolve" , "rest" , "resultset-seq" , "reverse" , "reversible?" , "right" , "rightmost" , "rights" , "root" , "rseq" , "rsubseq" , "run-all-tests" , "run-tests" , "satisfies?" , "second" , "select" , "select-keys" , "send" , "send-off" , "seq" , "seq-zip" , "seq?" , "seque" , "sequence" , "sequential?" , "set" , "set-test" , "set-validator!" , "set?" , "short" , "short-array" , "shorts" , "shutdown-agents" , "skip-if-eol" , "skip-whitespace" , "slurp" , "some" , "sort" , "sort-by" , "sorted-map" , "sorted-map-by" , "sorted-set" , "sorted-set-by" , "sorted?" , "special-form-anchor" , "special-symbol?" , "split-at" , "split-with" , "str" , "stream?" , "string?" , "stringify-keys" , "struct" , "struct-map" , "subs" , "subseq" , "subvec" , "successful?" , "supers" , "swap!" , "symbol" , "symbol?" , "sync" , "syntax-symbol-anchor" , "take" , "take-last" , "take-nth" , "take-while" , "test" , "test-all-vars" , "test-ns" , "test-var" , "testing" , "testing-contexts-str" , "testing-vars-str" , "the-ns" , "throw" , "time" , "to-array" , "to-array-2d" , "trampoline" , "transient" , "tree-seq" , "true?" , "try" , "try-expr" , "type" , "unchecked-add" , "unchecked-dec" , "unchecked-divide" , "unchecked-inc" , "unchecked-multiply" , "unchecked-negate" , "unchecked-remainder" , "unchecked-subtract" , "underive" , "unimport" , "union" , "unquote" , "unquote-splicing" , "up" , "update-in" , "update-proxy" , "use" , "use-fixtures" , "val" , "vals" , "var-get" , "var-set" , "var?" , "vary-meta" , "vec" , "vector" , "vector?" , "walk" , "when" , "when-first" , "when-let" , "when-not" , "while" , "with-bindings" , "with-bindings*" , "with-in-str" , "with-loading-context" , "with-local-vars" , "with-meta" , "with-open" , "with-out-str" , "with-precision" , "with-test" , "with-test-out" , "xml-seq" , "zero?" ]) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n %&(),.;[]^{|}~" } (makeWordSet True [ "*1" , "*2" , "*3" , "*agent*" , "*allow-unresolved-vars*" , "*assert*" , "*clojure-version*" , "*command-line-args*" , "*compile-files*" , "*compile-path*" , "*current*" , "*e" , "*err*" , "*file*" , "*flush-on-newline*" , "*in*" , "*initial-report-counters*" , "*load-tests*" , "*macro-meta*" , "*math-context*" , "*ns*" , "*out*" , "*print-dup*" , "*print-length*" , "*print-level*" , "*print-meta*" , "*print-readably*" , "*read-eval*" , "*report-counters*" , "*sb*" , "*source-path*" , "*stack*" , "*stack-trace-depth*" , "*state*" , "*test-out*" , "*testing-contexts*" , "*testing-vars*" , "*use-context-classloader*" , "*warn-on-reflection*" ]) , rAttribute = VariableTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n %&(),.;[]^{|}~" } (makeWordSet True [ "def" , "def-" , "defalias" , "defhinted" , "definline" , "defmacro" , "defmacro-" , "defmethod" , "defmulti" , "defn" , "defn-" , "defn-memo" , "defnk" , "defonce" , "defonce-" , "defprotocol" , "defrecord" , "defstruct" , "defstruct-" , "deftest" , "deftest-" , "deftype" , "defunbound" , "defunbound-" , "defvar" , "defvar-" ]) , rAttribute = BuiltInTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "function_decl" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\\\." , reCompiled = Just (compileRegex True "\\\\.") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars '#' '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "String" ) ] } , Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "String" ) ] } , 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 = DetectChar '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "Level1" ) ] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Level0" , Context { cName = "Level0" , cSyntax = "Clojure" , cRules = [ Rule { rMatcher = DetectChar '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "Level1" ) ] } , Rule { rMatcher = Detect2Chars '#' '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "Level1" ) ] } , Rule { rMatcher = IncludeRules ( "Clojure" , "Default" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Level1" , Context { cName = "Level1" , cSyntax = "Clojure" , cRules = [ Rule { rMatcher = DetectChar '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "Level2" ) ] } , Rule { rMatcher = Detect2Chars '#' '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "Level2" ) ] } , Rule { rMatcher = DetectChar ')' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "Clojure" , "Default" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Level2" , Context { cName = "Level2" , cSyntax = "Clojure" , cRules = [ Rule { rMatcher = DetectChar '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "Level3" ) ] } , Rule { rMatcher = Detect2Chars '#' '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "Level3" ) ] } , Rule { rMatcher = DetectChar ')' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "Clojure" , "Default" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Level3" , Context { cName = "Level3" , cSyntax = "Clojure" , cRules = [ Rule { rMatcher = DetectChar '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "Level4" ) ] } , Rule { rMatcher = Detect2Chars '#' '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "Level4" ) ] } , Rule { rMatcher = DetectChar ')' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "Clojure" , "Default" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Level4" , Context { cName = "Level4" , cSyntax = "Clojure" , cRules = [ Rule { rMatcher = DetectChar '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "Level5" ) ] } , Rule { rMatcher = Detect2Chars '#' '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "Level5" ) ] } , Rule { rMatcher = DetectChar ')' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "Clojure" , "Default" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Level5" , Context { cName = "Level5" , cSyntax = "Clojure" , cRules = [ Rule { rMatcher = DetectChar '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "Level6" ) ] } , Rule { rMatcher = Detect2Chars '#' '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "Level6" ) ] } , Rule { rMatcher = DetectChar ')' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "Clojure" , "Default" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Level6" , Context { cName = "Level6" , cSyntax = "Clojure" , cRules = [ Rule { rMatcher = DetectChar '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "Level1" ) ] } , Rule { rMatcher = Detect2Chars '#' '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Clojure" , "Level1" ) ] } , Rule { rMatcher = DetectChar ')' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "Clojure" , "Default" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "SpecialNumber" , Context { cName = "SpecialNumber" , cSyntax = "Clojure" , cRules = [ Rule { rMatcher = Float , rAttribute = FloatTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = Int , rAttribute = DecValTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = HlCOct , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = HlCHex , rAttribute = FloatTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "String" , Context { cName = "String" , cSyntax = "Clojure" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "#\\\\." , reCompiled = Just (compileRegex True "#\\\\.") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , 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 = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "function_decl" , Context { cName = "function_decl" , cSyntax = "Clojure" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "\\s*[A-Za-z0-9-+\\<\\>//\\*]*\\s*" , reCompiled = Just (compileRegex True "\\s*[A-Za-z0-9-+\\<\\>//\\*]*\\s*") , reCaseSensitive = True } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = FunctionTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) ] , sAuthor = "Dominik Haumann [lisp] modified for clojure by Caspar Hasenclever" , sVersion = "5" , sLicense = "LGPLv2+" , sExtensions = [ "*.clj" , "*.cljs" ] , sStartingContext = "Level0" }