1;; Copyright (c) Facebook, Inc. and its affiliates.
2;;
3;; Licensed under the Apache License, Version 2.0 (the "License");
4;; you may not use this file except in compliance with the License.
5;; You may obtain a copy of the License at
6;;
7;; http://www.apache.org/licenses/LICENSE-2.0
8;;
9;; Unless required by applicable law or agreed to in writing, software
10;; distributed under the License is distributed on an "AS IS" BASIS,
11;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12;; See the License for the specific language governing permissions and
13;; limitations under the License.
14;; ---------------------------------------------------------------------
15
16;; Based initially on the contents of https://github.com/WhatsApp/tree-sitter-erlang/issues/2 by @Wilfred
17;; and https://github.com/the-mikedavis/tree-sitter-erlang/blob/main/queries/highlights.scm
18;;
19;; The tests are also based on those in
20;; https://github.com/the-mikedavis/tree-sitter-erlang/tree/main/test/highlight
21;;
22
23
24;; First match wins in this file
25
26;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27
28;; Attributes
29
30;; module attribute
31(module_attribute
32 name: (atom) @module)
33
34;; behaviour
35(behaviour_attribute name: (atom) @module)
36
37;; export
38
39;; Import attribute
40(import_attribute
41 module: (atom) @module)
42
43;; export_type
44
45;; optional_callbacks
46
47;; compile
48(compile_options_attribute
49 options: (tuple
50 expr: (atom)
51 expr: (list
52 exprs: (binary_op_expr
53 lhs: (atom)
54 rhs: (integer)))))
55
56;; file attribute
57
58;; record
59(record_decl name: (atom) @type)
60(record_decl name: (macro_call_expr name: (var) @constant))
61(record_field name: (atom) @property)
62
63;; type alias
64
65;; opaque
66
67;; Spec attribute
68(spec fun: (atom) @function)
69(spec
70 module: (module name: (atom) @module)
71 fun: (atom) @function)
72
73;; callback
74(callback fun: (atom) @function)
75
76;; fun decl
77
78;; include/include_lib
79
80;; ifdef/ifndef
81(pp_ifdef name: (_) @keyword.directive)
82(pp_ifndef name: (_) @keyword.directive)
83
84;; define
85(pp_define
86 lhs: (macro_lhs
87 name: (_) @keyword.directive
88 args: (var_args args: (var))))
89(pp_define
90 lhs: (macro_lhs
91 name: (var) @constant))
92
93
94;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
95;; Functions
96(fa fun: (atom) @function)
97(type_name name: (atom) @function)
98(call expr: (atom) @function)
99(function_clause name: (atom) @function)
100(internal_fun fun: (atom) @function)
101
102;; This is a fudge, we should check that the operator is '/'
103;; But our grammar does not (currently) provide it
104(binary_op_expr lhs: (atom) @function rhs: (integer))
105
106;; Others
107(remote_module module: (atom) @module)
108(remote fun: (atom) @function)
109(macro_call_expr name: (var) @keyword.directive args: (_) )
110(macro_call_expr name: (var) @constant)
111(macro_call_expr name: (atom) @keyword.directive)
112(record_field_name name: (atom) @property)
113(record_name name: (atom) @type)
114
115;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
116;; Reserved words
117[ "after"
118 "and"
119 "band"
120 "begin"
121 "behavior"
122 "behaviour"
123 "bnot"
124 "bor"
125 "bsl"
126 "bsr"
127 "bxor"
128 "callback"
129 "case"
130 "catch"
131 "compile"
132 "define"
133 "deprecated"
134 "div"
135 "elif"
136 "else"
137 "end"
138 "endif"
139 "export"
140 "export_type"
141 "file"
142 "fun"
143 "if"
144 "ifdef"
145 "ifndef"
146 "import"
147 "include"
148 "include_lib"
149 "maybe"
150 "module"
151 "of"
152 "opaque"
153 "optional_callbacks"
154 "or"
155 "receive"
156 "record"
157 "spec"
158 "try"
159 "type"
160 "undef"
161 "unit"
162 "when"
163 "xor"] @keyword
164
165["andalso" "orelse"] @keyword.operator
166
167;; Punctuation
168["," "." ";"] @punctuation.delimiter
169["(" ")" "{" "}" "[" "]" "<<" ">>"] @punctuation.bracket
170
171;; Operators
172["!"
173 "->"
174 "<-"
175 "#"
176 "::"
177 "|"
178 ":"
179 "="
180 "||"
181
182 "+"
183 "-"
184 "bnot"
185 "not"
186
187 "/"
188 "*"
189 "div"
190 "rem"
191 "band"
192 "and"
193
194 "+"
195 "-"
196 "bor"
197 "bxor"
198 "bsl"
199 "bsr"
200 "or"
201 "xor"
202
203 "++"
204 "--"
205
206 "=="
207 "/="
208 "=<"
209 "<"
210 ">="
211 ">"
212 "=:="
213 "=/="
214 ] @operator
215
216;;; Comments
217((var) @comment.discard
218 (#match? @comment.discard "^_"))
219
220(dotdotdot) @comment.discard
221(comment) @comment
222
223;; Primitive types
224(string) @string
225(char) @constant
226(integer) @number
227(var) @variable
228(atom) @string.special.symbol
229
230;; wild attribute (Should take precedence over atoms, otherwise they are highlighted as atoms)
231(wild_attribute name: (attr_name name: (_) @keyword))